5
\$\begingroup\$

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 ()
\$\endgroup\$
1
  • \$\begingroup\$ 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) \$\endgroup\$
    – itsbruce
    Mar 15, 2015 at 21:01

2 Answers 2

5
\$\begingroup\$

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"
\$\endgroup\$
4
  • \$\begingroup\$ 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. \$\endgroup\$
    – ana
    Mar 16, 2015 at 6:26
  • \$\begingroup\$ 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. \$\endgroup\$
    – bisserlis
    Mar 17, 2015 at 7:29
  • \$\begingroup\$ 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. \$\endgroup\$
    – bisserlis
    Mar 17, 2015 at 7:39
  • \$\begingroup\$ That was like two or three reasons on its own, suffice to say there are many others and I ran out of steam. \$\endgroup\$
    – bisserlis
    Mar 17, 2015 at 10:09
2
\$\begingroup\$

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!

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.