Brainfuck interpreter.

brainfuck_interpreter.hs

import Data.Char

data VM = VM {
  mem :: [Int],
  ptr :: Int
}

tPlus = '+'
tMinus = '-'
tDot = '.'
tComma = ','
tLeft = '<'
tRight = '>'
tBracketOpen = '['
tBracketClose = ']'

--         Source    VM    Source PTR    Skipper    Jumplist
execute :: String -> VM -> Int        -> Int     -> [Int]    -> IO ()
execute s (vm @ VM {mem=vm_mem, ptr=vm_ptr}) n skip jumplist
  | readComplete s n = return ()

  | readOf s n tBracketOpen && skip > 0 = execute s vm (n + 1) (skip + 1) jumplist
  | readOf s n tBracketClose && skip > 0 = execute s vm (n + 1) (skip - 1) jumplist
  | skip > 0 = execute s vm (n + 1) skip jumplist

  | readOf s n tPlus = execute s VM {mem=memUpdate vm_mem vm_ptr ((vm_mem !! vm_ptr) + 1), ptr=vm_ptr} (n + 1) skip jumplist
  | readOf s n tMinus = execute s VM {mem=memUpdate vm_mem vm_ptr ((vm_mem !! vm_ptr) - 1), ptr=vm_ptr} (n + 1) skip jumplist

  | readOf s n tDot = do
    putStr [chr (vm_mem !! vm_ptr)]
    execute s vm (n + 1) skip jumplist
  | readOf s n tComma = do
    readval <- getLine
    execute s VM {mem=memUpdate vm_mem vm_ptr (read readval :: Int), ptr=vm_ptr} (n + 1) skip jumplist

  | readOf s n tRight = execute s VM {mem=extendMem vm_mem (vm_ptr + 1), ptr=vm_ptr + 1} (n + 1) skip jumplist
  | readOf s n tLeft = execute s VM {mem=vm_mem, ptr=vm_ptr - 1} (n + 1) skip jumplist

  | readOf s n tBracketOpen && vmOnZero vm = execute s vm (n + 1) 1 jumplist
  | readOf s n tBracketOpen = execute s vm (n + 1) skip (n + 1 : jumplist)
  | readOf s n tBracketClose && vmOnZero vm = execute s vm (n + 1) skip (drop 1 jumplist)
  | readOf s n tBracketClose = execute s vm (head jumplist) skip jumplist
  | otherwise = execute s vm (n + 1) skip jumplist

readComplete :: String -> Int -> Bool
readComplete s n
  | length s <= n = True
  | otherwise = False

readOf :: String -> Int -> Char -> Bool
readOf s n c = s !! n == c

memUpdate :: [Int] -> Int -> Int -> [Int]
memUpdate l idx newval = take idx l ++ [newval] ++ drop (idx + 1) l

extendMem :: [Int] -> Int -> [Int]
extendMem l n
  | length l <= n = l ++ [0]
  | otherwise = l

vmOnZero :: VM -> Bool
vmOnZero VM {mem=vm_mem, ptr=vm_ptr} = (vm_mem !! vm_ptr) == 0

main = do
  source <- getContents
  execute source VM {mem=[0], ptr=0} 0 0 []