A simple brainf*** interpreter in Haskell

Question

I am very new to Haskell and come from languages like C++, although I do have some experience with Scheme. Here, I wrote a simple brainf*** interpreter, which so far is my largest project. I followed a tutorial for some of the code (such as the Tape data type), but did most of this on my own. I have one major concern with my approach, which is the way I handle the loops (which in brainf*** are written with [] and repeat until the current cell in the tape is zero. In my implementation, I used the loop as a parameter to the main recursive function, which is called if the current instruction is ] and the current cell is not 0. Since these loops modify the tape, I had to make them return an instance of Tape that would replace the current one. However, since the function also handles IO (and therefore must return an instance of IO), I made it return an IO (Tape Int) which is then unpacked in a do block. This all felt very messy and hacky, so I would really appreciate any help from more experienced Haskell developers.

import Data.Maybe

--The Tape data type and functions

data Tape a = Tape [a] a [a] 

newTape :: a -> Tape a 
newTape x = Tape r x r 
    where r = repeat x

moveLeft :: Tape a -> Tape a 
moveLeft (Tape (l:ls) x rs) = Tape ls l (x:rs)  

moveRight :: Tape a -> Tape a
moveRight (Tape ls x (r:rs)) = Tape (x:ls) r rs 

--The Brainf*** instruction data types

data BfInstruction 
    = MovLeft
    | MovRight
    | Increment
    | Decrement
    | Output
    | Input 
    | BeginLoop
    | EndLoop    
    deriving (Show, Eq)  

type BfProgram = [BfInstruction]

--Convert string to BfProgram

parseBf :: String -> BfProgram
parseBf = mapMaybe parse
    where 
        parse :: Char -> Maybe BfInstruction
        parse x = case x of
            '<' -> Just MovLeft
            '>' -> Just MovRight 
            '+' -> Just Increment
            '-' -> Just Decrement
            ',' -> Just Input
            '.' -> Just Output
            '[' -> Just BeginLoop
            ']' -> Just EndLoop
            x   -> Nothing         --anything but the above chars is a comment

--Main running function

runBf :: String -> IO () 
runBf p = runBf' (parseBf p) (newTape 0) [] >> return ()
    where 
        runBf' :: BfProgram -> Tape Int -> BfProgram -> IO (Tape Int) 
        runBf' [] tape _ = return tape 
        runBf' prog@(p:ps) tape@(Tape ls x rs) loop = case p of
            MovLeft   -> advance prog (moveLeft tape)
            MovRight  -> advance prog (moveRight tape)
            Increment -> advance prog (Tape ls (x+1) rs)
            Decrement -> advance prog (Tape ls (x-1) rs)
            Input     -> do 
                char <- getChar 
                advance prog (Tape ls (fromEnum char) rs)  
            Output    -> putChar (toEnum x) >> advance prog tape 
            BeginLoop -> 
                let lp = getLoop 1 ps
                in runBf' (length lp `drop` ps) tape lp  --Drop so that we are at the ] now
            EndLoop   -> 
                if x /= 0 
                then do 
                    lt <- runBf' loop tape [] 
                    runBf' prog lt loop       --Copy the tape from the result of the loop into next iteration
                else advance prog tape 

        advance :: BfProgram -> Tape Int -> IO (Tape Int) 
        advance (p:ps) tape = runBf' ps tape []  

        getLoop :: Int -> BfProgram -> BfProgram
        getLoop _ [] = error "Mismatched brackets in BF program"
        getLoop 1 (EndLoop:ps) = [] 
        getLoop n (p:ps) = p:case p of 
            BeginLoop -> getLoop (n + 1) ps 
            EndLoop   -> getLoop (n - 1) ps 
            _         -> getLoop n ps

--Simple IO

main = do 
    program <- readFile "program.bf"
    runBf program 

Answer 1

Well done. Overall, there are no big flaws, just some minor issues.

Type annotations

While it's great that all top-level functions have proper type signatures, the local bindings inside those functions usually don't. After all, their types should get inferred, e.g.

example :: [Int] -> [Int]
example = map inc
  where
    inc x = 1 + x

doesn't need a type signature since x's type is already fixed to Int. It makes refactoring also a lot easier if we change the type later. If we started with

example :: [Int] -> [Int]
example = map inc
  where
    inc :: Int -> Int
    inc x = 1 + x

and later want to generalize, we might forget the second type signature and end up with an error message:

example :: Num a => [a] -> [a]
example = map inc
  where
    inc :: Int -> Int -- whoops, GHC will yell about that
    inc x = 1 + x

Therefore, type signatures for local functions are usually not written out. There are some instances where they're necessary, but that's usually with RankNTypes or other extensions.

The tape

The tape works well, and is pretty much how you would expect it.

Infinite tapes and debugging

That being said, an infinite tape has the slight inconvenience that you can never inspect it for debugging purposes.

Also, if you ever create a module from your code, you must not export the Tape data constructor, as it would enable Tape [] 0 [] and therefore break assertions.

A finite tape circumvents those issues, but needs slightly more effort in the movements.

Working on the current value

In runBf we can find several spots where we advance the program after we worked on the current value, e.g.:

        Increment -> advance prog (Tape ls (x+1) rs)
        Decrement -> advance prog (Tape ls (x-1) rs)

That's now a possible source of errors, since we could have used

        Increment -> advance prog (Tape ls (x+1) ls)
        Decrement -> advance prog (Tape ls (x-1) ls)

by accident. A small helper can prevent that issue:

onCurrent :: (a -> a) -> Tape a -> Tape a
onCurrent f (Tape ls x rs) = Tape ls (f x) rs

current   :: Tape a -> a
current (Tape _ x _ ) = x

Then we end up with

        MovLeft   -> advance prog (moveLeft tape)
        MovRight  -> advance prog (moveRight tape)
        Increment -> advance prog (onCurrent (+1) tape)
        Decrement -> advance prog (onCurrent (subtract 1) tape)
        Input     -> do 
            char <- getChar 
            advance prog (onCurrent (const (fromEnum char)) tape)

Naming and scope

As neither advance nor getLoop use any of the bindings in their scope, they're candidates for top-level functions.

runBf' can be called go or another short name. Calling the inner worker just go is really common and won't alienate other readers.

Make interfaces hard to use wrong

getLoop uses an Int as first argument that's not properly documented. Types only go so far as documentation, and we could accidentally use getLoop 0 in BeginLoop.

Instead, we should make it impossible to misuse getLoop:

getLoop :: BfProgram -> BfProgram
getLoop = go 1
  where
    go _ [] = error "Mismatched brackets in BF program"
    go 1 (EndLoop:ps) = [] 
    go n (p:ps) = p:case p of 
        BeginLoop -> go (n + 1) ps 
        EndLoop   -> go (n - 1) ps 
        _         -> go n ps

Similarly, runBf should probably take a BfProgram, not an arbitrary String, as this doesn't decrease the strength of your program, we can recreate the previous behaviour with

runBf . parseBf

However, speaking of parsing…

Loop validation

A drawback with our current BfProgram is that we might end up with mismatched brackets, e.g.

parseBf "]["

parses fine and leads to a runtime error. However, we could easily detect that during parsing. Our parseBf needs a way to report errors:

type ParserError = String

parseBf :: String -> Either ParserError BfProgram
parseBf = go
  where 
    go []     = Right []
    go (x:xs) = case x of
        '<' -> MovLeft <$:> go xs
        '>' -> MovRight <$:> go xs
        '+' -> Increment <$:> go xs
        '-' -> Decrement <$:> go xs
        ',' -> Input <$:> go xs
        '.' -> Output <$:> go xs
        '[' -> -- exercise ; use `getLoop`-like function
        ']' -> -- exercise ; easier if previous one done correctly.
        x   -> go xs
   x <$:> xs = fmap (x:) xs

but afterwards, we can be sure that parseBf only returns BfPrograms with valid brackets.

Unfortunately, we still need to use getLoop, as BeginLoop and EndLoop are still in our instruction set. If we change the instruction set, we can get rid of that too:

data BfInstruction 
    = MovLeft
    | MovRight
    | Increment
    | Decrement
    | Output
    | Input 
    | Loop BfProgram
    deriving (Show, Eq)  

I go into more details in some of my previous Bf reviews, feel free to read them if you get stuck on Loop.

Final remarks

Other than the usual re-evaluation of loops (which is a common scenario in Haskell Bf interpreters), your code was fine, so all the issues are really minor. Again: well done.