Another Brainfuck interpreter in Haskell

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 _ ' 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 "
    (x:_) -> readFile x >>= run >> return ()

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 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  do
                        program  usage
    where
        usage = putStrLn "Usage: bf FILE"

StackExchange Code Review Q#84146, answer score: 5