HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Brainfuck Interpreter

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
brainfuckinterpreterstackoverflow

Problem

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 (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 (Int,[Int])
uncons [] = (0,[])
uncons (x:xs) = (x,xs)

printAsChar :: Int -> IO ()
printAsChar i = putStr $ [chr i]

main = do
t

Solution

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  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

Code Snippets

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
printAsChar i = putStr $ [chr i]
printAsChar i = putStr [chr i]
printAsChar i = putChar (chr i)
printAsChar =  putChar . chr

Context

StackExchange Code Review Q#11525, answer score: 7

Revisions (0)

No revisions yet.