Another Brainfuck interpreter in Haskell

Question

I came up with the following Brainfuck interpreter in Haskell after thinking about how to represent the program and the memory functionally using zippers to represent current location. This works since in Brainfuck, there is no way to reference more than one memory location away from your present location at one time.

import Control.Monad
import System.Environment
data ZL a = EM | ZL [a] a [a]
fromList [] = EM
fromList (x:xs) = ZL [] x xs
zprv EM = EM
zprv (ZL [] x rs) = EM
zprv (ZL (l:ls) x rs) = ZL ls l (x:rs)
znxt EM = EM
znxt (ZL ls x []) = EM
znxt (ZL ls x (r:rs)) = ZL (x:ls) r rs
zmap (ZL ls x rs) f = ZL ls (f x) rs
run code = go (fromList (repeat 0)) (fromList code)
 where
 go m EM = return m
 go m i@(ZL _ '>' _) = go (znxt m) (znxt i)
 go m i@(ZL _ '<' _) = go (zprv m) (znxt i)
 go m i@(ZL _ '+' _) = go (zmap m (\x -> x + 1)) (znxt i)
 go m i@(ZL _ '-' _) = go (zmap m (\x -> x - 1)) (znxt i)
 go m@(ZL ml x mr) i@(ZL _ '[' _) = go m (if x /= 0 then znxt i else skip znxt 0 i)
 go m@(ZL ml x mr) i@(ZL _ ']' _) = go m (if x == 0 then znxt i else skip zprv 0 i)
 go m@(ZL _ x _) i@(ZL _ '.' _) = putChar (toEnum x) >> go m (znxt i)
 go m@(ZL ml _ mr) i@(ZL _ ',' _) = getChar >>= \x -> go (ZL ml (fromEnum x) mr) (znxt i)
 go m@(ZL ml x mr) i@(ZL _ _ _) = go m (znxt i) -- Ignore
 skip _ 1 i@(ZL _ ']' _) = znxt i
 skip _ (-1) i@(ZL _ '[' _) = znxt i
 skip d n i@(ZL l '[' r) = skip d (n+1) (d i)
 skip d n i@(ZL l ']' r) = skip d (n-1) (d i)
 skip d n i@(ZL l _ r) = skip d n (d i)
main = do
 getArgs >>= \args -> case args of
 [] -> putStrLn "Usage: bf <program.bf>"
 (x:_) -> readFile x >>= run >> return ()

• itsbruce: Is there any specific issue or part of your code you want to improve? Or are you just looking for general comments? (Do have some comments but what you specifically want should take priority)

Answer 1

I find this very difficult to read without any logical line breaks or function types given. I.e., you should leave a blank line between definitions for different functions, and every top-level definition should be given a type signature.

fromList :: [a] -> ZL a
fromList [] = EM
fromList (x:xs) = ZL [] x xs
zprv :: ZL a -> ZL a
zprv EM = EM
zprv (ZL [] x rs) = EM
zprv (ZL (l:ls) x rs) = ZL ls l (x:rs)
-- &c...

zmap is a partial function, and it isn't acting much like a mapping as it only modifies the current element in your given definition. Maybe zapp is a better name? (Or poke, or prod, or...)

zapp :: (a -> a) -> ZL a -> ZL a
zapp _ EM = EM -- Or, raise a descriptive `error`
zapp f (ZL ls x rs) = ZL ls (f x) rs

The definition of run is extremely long and not very semantic, rewrite it to be the composition of smaller, more compositional, more meaningful functions.

zinc :: (Num a) => ZL a -> ZL a
zinc = zapp (+1)
zdec :: (Num a) => ZL a -> ZL a
zdec = zapp (subtract 1)
zjmp :: (ZL a -> ZL a) -> Int -> ZL a -> ZL a
zjmp _ 1 i@(ZL _ ']' _) = znxt i
zjmp _ (-1) i@(ZL _ '[' _) = znxt i
zjmp d n i@(ZL l '[' r) = zjmp d (n+1) (d i)
zjmp d n i@(ZL l ']' r) = zjmp d (n-1) (d i)
zjmp d n i@(ZL l _ r) = zjmp d n (d i)
interpret :: ZL Int -> ZL Char -> IO ()
interpret _ EM = return ()
interpret m i@(ZL _ '>' _) = interpret (znxt m) (znxt i)
interpret m i@(ZL _ '<' _) = interpret (zprv m) (znxt i)
interpret m i@(ZL _ '+' _) = interpret (zinc m) (znxt i)
interpret m i@(ZL _ '-' _) = interpret (zdec m) (znxt i)
interpret m@(ZL _ x _ ) i@(ZL _ '[' _) = interpret m (if x /= 0 then znxt i else zjmp znxt 0 i)
interpret m@(ZL _ x _ ) i@(ZL _ ']' _) = interpret m (if x == 0 then znxt i else zjmp zprv 0 i)
interpret m@(ZL _ x _ ) i@(ZL _ '.' _) = putChar (toEnum x) >> interpret m (znxt i)
interpret m@(ZL ml _ mr) i@(ZL _ ',' _) = getChar >>= \x -> interpret (ZL ml (fromEnum x) mr) (znxt i)
interpret m i@(ZL _ _ _) = interpret m (znxt i) -- Comment `Char`
run :: String -> IO ()
run program = interpret tape (fromList program)
 where
 tape :: ZL Int
 tape = fromList (repeat 0)

Your usage of do is redundant in main. You can either just drop the word do, or write it more idiomatically as—

main :: IO ()
main = do
 args <- getArgs
 case args of
 [x] -> do
 program <- readFile x
 run program
 _ -> usage
 where
 usage = putStrLn "Usage: bf FILE"

• ana: Thanks. Appreciate the comments. Perhaps a matter of opinion, but I've found writing type signatures to be redundant. The compiler can figure it out and tell you. Nevertheless, agree with you on all points.
• bisserlis: That's a very bad idea for very many reasons. 1) The compiler can't always figure it out. Try data ZL ... deriving Functor then zmap = fmap. Without a top-level type signature you may get a compiler error if you don't use zmap elsewhere within the module on something else with a concrete type. You could compile with -XNoMonomorphismRestriction in this case, but then zmap would just be an alias for fmap and not be restricted to working on ZLs.
• bisserlis: 2) Top-level types aren't just dressing for the compiler, they're important documentation for readers of your code (including your future self). Haddock documentation is applied to type signatures, so if you don't have any it all just ends up in the trash. And if your original zmap function had a type signature it would be much easier to see that it isn't a well-constructed mapping, f :: a -> a could be applied to any element of ZL a multiple (or no) times, whereas f :: a -> b has to be applied to all elements of ZL a exactly once.
• bisserlis: That was like two or three reasons on its own, suffice to say there are many others and I ran out of steam.

Answer 2

I am building on bisserlis' answer here. interpret uses a lot of repetition that can be reduced with case..of. That allows a where clause which factors out common code that modifies memory and simply advances the instruction pointer:

interpret m@(ZL _ x _) i@(ZL _ cmd _) =
 case cmd of
 '>' -> memory znxt
 '<' -> memory zprv
 '+' -> memory zinc
 '-' -> memory zdec
 '[' -> interpret m (if x /= 0 then znxt i else zjmp znxt 0 i)
 ']' -> interpret m (if x == 0 then znxt i else zjmp zprv 0 i)
 '.' -> putChar (toEnum x)>> memory id
 ',' -> getChar>>= memory . zapp . const . fromEnum
 _ -> memory id -- Comment `Char`
 where
 memory :: (ZL Int -> ZL Int) -> IO ()
 memory f = interpret (f m) (znxt i)

I would use longer names for znxt etc., then you might consider renaming zapp to underHead or atPtr and then your code might read like this (I am mixing styles here):

 '>' -> memory advancePtr
 '<' -> memory moveHeadLeft
 '+' -> memory (underHead (+1))
 '-' -> memory (atPtr (subtract 1))

Reads almost like the specification!