Brainfuck Interpreter

Question

I want to write an example for a language similar to Haskell called Frege. While the interpreter is conceptually easy, it is lengthy and looks still quite messy. Note that I don't want to use Parsec etc, as it isn't available yet in Frege. Please help me to improve the Haskell version.

import Data.Char
data Tape = Tape { left :: [Int], cell :: Int, right :: [Int] }
instance Show Tape where
 show (Tape ls c rs) = show [reverse ls,[c],rs]
data Op = Plus | Minus | GoLeft | GoRight | Output | Input | Loop [Op] deriving (Eq, Show)
removeComments :: [Char] -> [Char]
removeComments xs = filter (`elem` "+-<>.,[]") xs
parseOp :: [Char] -> Maybe (Op, [Char])
parseOp ('+':cs) = Just (Plus, cs)
parseOp ('-':cs) = Just (Minus, cs)
parseOp ('<':cs) = Just (GoLeft, cs)
parseOp ('>':cs) = Just (GoRight, cs)
parseOp ('.':cs) = Just (Output, cs)
parseOp (',':cs) = Just (Input, cs)
parseOp ('[':cs) = case parseOps cs of
 (prog, (']':cs')) -> Just (Loop prog, cs')
 _ -> Nothing
parseOp _ = Nothing
parseOps :: [Char] -> ([Op],[Char])
parseOps cs = go cs [] where
 go cs acc = case parseOp cs of
 Nothing -> (reverse acc, cs)
 Just (op, cs') -> go cs' (op:acc)
parse :: String -> [Op]
parse prog = case parseOps $ removeComments $ prog of
 (ops, []) -> ops
 (ops, rest) -> error $ "Parsed: " ++ show ops ++ ", Rest: " ++ rest
execute :: [Op] -> IO Tape
execute prog = exec prog (Tape [] 0 [])
exec :: [Op] -> Tape -> IO Tape
exec [] tape = return tape
exec (Plus:prog) (Tape ls c rs) = exec prog (Tape ls (c+1) rs)
exec (Minus:prog) (Tape ls c rs) = exec prog (Tape ls (c-1) rs)
exec (GoLeft:prog) (Tape ls c rs) =
 let (hd,tl) = uncons ls in exec prog (Tape tl hd (c:rs))
exec (GoRight:prog) (Tape ls c rs) =
 let (hd,tl) = uncons rs in exec prog (Tape (c:ls) hd tl)
exec (Output:prog) tape = do
 printAsChar (cell tape)
 exec prog tape
exec (Input:prog) (Tape ls _ rs) = do
 n <- getChar
 exec prog (Tape ls (digitToInt n) rs)
exec (Loop loop:prog) tape @ (Tape ls 0 rs) = exec prog tape
exec again@(Loop loop:prog) tape = do
 tape' <- exec loop tape
 exec (if (cell tape') == 0 then prog else again) tape'
uncons :: [Int] -> (Int,[Int])
uncons [] = (0,[])
uncons (x:xs) = (x,xs)
printAsChar :: Int -> IO ()
printAsChar i = putStr $ [chr i]
main = do
 tape <- execute $ parse helloWorld
 putStrLn $ "\n" ++ show tape ++ "\n"
helloWorld =
 ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++" ++
 "[<++++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------." ++
 "[-]>++++++++[<++++>-]<+.[-]++++++++++."

[Edit]

parseOp can be simplified to:

ops = [('+', Plus),('-', Minus),('<',GoLeft),('>',GoRight),('.',Output),(',',Input)]
parseOp :: [Char] -> Maybe (Op, [Char])
parseOp ('[':cs) = case parseOps cs of
 (prog, (']':cs')) -> Just (Loop prog, cs')
 _ -> Nothing
parseOp (c:cs) = fmap (flip (,) cs) $ lookup c ops
parseOp [] = Nothing

• Dan Burton: This is about as straightforward as it gets. You could line some things up with whitespace, and perhaps use where instead of let/in, but other than that, there's really not much I can see that could be simplified.

Answer 1

Disclaimer: I know nothing about Frege, all comments apply to Haskell only.

1)

Running hlint on your code shows places where you can remove $ and brackets. Please do it!

2)

In exec, you always do exec prog tape after finishing current instruction. So you are iterating the list in some sense. This is a fold.

exec :: [Op] -> Tape -> IO Tape
exec prog tape = foldM f tape prog
 where f (Tape ls c rs) Plus = return $ Tape ls (c+1) rs
 f (Tape ls c rs) Minus = return $ Tape ls (c-1) rs
 f (Tape ls c rs) GoLeft = let (hd, tl) = uncons ls in return $ Tape tl hd (c:rs)
 f (Tape ls c rs) GoRight = let (hd, tl) = uncons rs in return $ Tape (c:ls) hd tl
 f tape Output = printAsChar (cell tape) >> return tape
 f (Tape ls _ rs) Input = do n <- getChar
 return $ Tape ls (digitToInt n) rs
 f tape again@(Loop loop) | cell tape == 0 -> return tape
 | otherwise -> do tape' <- exec loop tape
 f tape' again

3)

printAsChar i = putStr $ [chr i]

hlint will tell you the $ is redundant:

printAsChar i = putStr [chr i]

You can use putChar:

printAsChar i = putChar (chr i)

and finally get:

printAsChar = putChar . chr

You have a strange asymmetry - output uses chr, and input digitToInt. These are not inverses! digitToInt '0' is 0, but chr 0 is '\NUL', not '0'.

If you want to output numbers longer than 1 character, use

printAsString = putStr . show

4)

I would merge execute and exec:

 execute :: [Op] -> IO Tape
 execute = foldM f (Tape [] 0 [])
 where f = ...

5)

 putStrLn $ "\n" ++ show tape ++ "\n" 

putStrLn already adds '\n" to the end, you might remove it.

6)

If you remove the requirement to print the tape (is it needed for debugging only?), you can use an infinite list:

 execute = foldM f (Tape (repeat 0) 0 (repeat 0))

and get rid of uncons:

 f (Tape (hd:tl) c rs) GoLeft = return $ Tape tl hd (c:rs)
 f (Tape ls c (hd:tl)) GoRight = return $ Tape (c:ls) hd tl

• Landei: Excellent answer. Regarding 6), I considered it, but reverted it exactly because of the debugging problem.
• sdcvvc: You could put show (Tape ls c rs) = show [reverse (take 10 ls),[c],take 10 rs] but I understand it might hinder debugging.