Brainfuck interpreter in Haskell

Okay, so I just started learning Haskell around a week ago and this is my first real program that I worked on all of yesterday with a lot of help from IRC. I know that using indicies and arrays is not very "Haskellish" but I found constantly manipulating lists and traversing them was extremely slow and sometimes the program took over 10 minutes to execute while this version is instant.

Afterwards I found you can do it with some Zipper package in 10 lines of code trivially but I didn't want to use anything too fancy.

I find that when I'm writing Haskell because there is no state I find myself simulating state with function parameters (saving variables and mutating them in a recursive call). I'm pretty sure I took it too far because most of these functions take four parameters and rarely change them but I'm not sure about many alternatives.

I haven't gotten to monads, functors, or applicatives yet, so while I'm sure they could solve this quite elegantly, they're still just magic to me. Unless the explanation is quite simple, I'd prefer if replies didn't mention them. I'm mostly looking for refactorings, style-advice, and better ways of implementing some things.

```
import qualified Data.Sequence as S
import Data.Char (chr, ord)
import Data.Array

-- Current Index, Indentation Depth, Program Array -> Bracket Index
prevBracketIndex :: Int -> Int -> Array Int Char -> Int
prevBracketIndex i depth cs
| cs ! i == '[' = if (depth - 1) == 0 then i else prevBracketIndex (i - 1) (depth - 1) cs
| cs ! i == ']' = prevBracketIndex (i - 1) (depth + 1) cs
| otherwise = prevBracketIndex (i - 1) depth cs

nextBracketIndex :: Int -> Int -> Array Int Char -> Int
nextBracketIndex i depth cs
| cs ! i == '[' = nextBracketIndex (i + 1) (depth + 1) cs
| cs ! i == ']' = if (depth - 1) == 0 then i else nextBracketIndex (i + 1) (depth - 1) cs
| otherwise = nextBracketIndex (i + 1) depth cs

execCode :: Int -> S.Seq Int -> Int -> Array Int Char -> IO ()
execCode tapeP

Use case instead of == and guards everywhere:

prevBracketIndex :: Int -> Int -> Array Int Char -> Int
prevBracketIndex i depth cs = case cs ! i of
    '[' -> if (depth - 1) == 0 then i else prevBracketIndex (i - 1) (depth - 1) cs
    ']' -> prevBracketIndex (i - 1) (depth + 1) cs
    _ -> prevBracketIndex (i - 1) depth cs

Use State and lens to carry state around instead of manual threading.

Use monad-loops to spin the loop instead of manual tail calls.

prevBracketIndex should avoid recursion too by using lists of indices.

Initial depth is always 0 in prevBracketIndex so it should be made local to improve readability. Also, cs is not changed across recursive calls so there is no need to pass it across. Applying both ideas:

prevBracketIndex :: Int -> Array Int Char -> Int
prevBracketIndex i cs = pbi i 0 where
    pbi i depth = case cs ! i of
        '[' -> if (depth - 1) == 0 then i else pbi (i - 1) (depth - 1)
        ']' -> pbi (i - 1) (depth + 1)
        _ -> pbi (i - 1) depth

For execCode we can do the same transformation: cs is invariant across loops, and initial positions are always 0.

Note also that prevBracketIndex can be completely precalculated (replaced by a single array lookup), as cs doesn't change.

Applying everything above but case we get:

import qualified Data.Sequence as S
import Data.Char (chr, ord)
import Data.Array
import Data.List

cachePrev cs = listArray (bounds cs) $ snd $ mapAccumL f [] $ assocs cs where
    f l (i, c) = case c of
        '[' -> (i : l, Nothing)
        ']' -> (tail l, Just $ head l)
        _ -> (l, Nothing)

cacheNext cs = listArray (bounds cs) $ snd $ mapAccumR f [] $ assocs cs where
    f l (i, c) = case c of
        ']' -> (i : l, Nothing)
        '[' -> (tail l, Just $ head l)
        _ -> (l, Just i)

cache arr i = case arr ! i of
    Nothing -> error "oops!"
    Just idx -> idx

execCode' :: S.Seq Int -> Array Int Char -> IO ()
execCode' ts cs = execCode 0 ts 0 where
    prev = cachePrev cs
    next = cacheNext cs

    execCode tapePos ts codePos
        | codePos == (snd . bounds $ cs) = return ()
        | cmd == '+' = execCode tapePos (S.update tapePos (value + 1) ts) nextPos
        | cmd == '-' = execCode tapePos (S.update tapePos (value - 1) ts) nextPos
        | cmd == '>' = execCode (tapePos + 1) ts nextPos
        | cmd == '> execCode tapePos ts nextPos
        | cmd == ',' = do { c <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos }
        | otherwise = execCode tapePos ts nextPos
        where
            value = S.index ts tapePos
            cmd = cs ! codePos
            nextPos = codePos + 1

For tests I found csFromString to be a convenient helper:

csFromString file = listArray (0, length file - 1) file

And it helps to write main in a more compact way:

main = readFile "example.bf" >>= execCode' tape . csFromString

Now let's apply the case proposal:

execCode _ _ codePos | codePos == (snd . bounds $ cs) = return ()
execCode tapePos ts codePos = case cs ! codePos of
    '+' -> execCode tapePos (S.update tapePos (value + 1) ts) nextPos
    '-' -> execCode tapePos (S.update tapePos (value - 1) ts) nextPos
    '>' -> execCode (tapePos + 1) ts nextPos
    ' execCode (tapePos - 1) ts nextPos
    '[' -> if value == 0 then execCode tapePos ts (cache next codePos + 1) else execNext 
    ']' -> if value /= 0 then execCode tapePos ts (cache prev codePos + 1) else execNext
    '.' -> putStr [chr $ S.index ts tapePos] >> execNext
    ',' -> do { c  execNext
    where
        value = S.index ts tapePos
        nextPos = codePos + 1
        execNext = execCode tapePos ts nextPos

Now cmd is not needed anymore, and [ and ] required some additional plumbing.

Now let's remove duplication in 3 symmetrical pairs of instructions - updatePos, updateVal and branch:

execCode _ _ codePos | codePos == (snd . bounds $ cs) = return ()
execCode tapePos ts codePos = case cs ! codePos of
    '+' -> updatePos succ
    '-' -> updatePos pred
    '>' -> updateVal succ
    ' updateVal pred
    '[' -> branch (== 0) next 
    ']' -> branch (/= 0) prev
    '.' -> putStr [chr $ S.index ts tapePos] >> execNext
    ',' -> do { c  execNext
    where
        value = S.index ts tapePos
        nextPos = codePos + 1
        execNext = execCode tapePos ts nextPos

        updatePos f = execCode tapePos (S.update tapePos (f value) ts) nextPos
        updateVal f = execCode (f tapePos) ts nextPos
        branch cond dir = if cond value then execCode tapePos ts (cache dir codePos + 1) else execNext

Now it's time to remove duplication between cachePrev and cacheNext:

```
mkCache cs mapAccumX bracketPush bracketPop = listArray (bounds cs) $ snd $ mapAccumX f [] $ assocs cs where
f l (i, c)
| c == bracketPush = (i : l, Nothing)
| c == bracketPop = (tail l, Just $ head l)
| otherwise = (l, Nothing)

cache arr

StackExchange Code Review Q#70674, answer score: 10