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 Simport Data.Char (chr, ord)import Data.Array-- Current Index, Indentation Depth, Program Array -> Bracket IndexprevBracketIndex :: Int -> Int -> Array Int Char -> IntprevBracketIndex 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 csnextBracketIndex :: Int -> Int -> Array Int Char -> IntnextBracketIndex 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 csexecCode :: Int -> S.Seq Int -> Int -> Array Int Char -> IO ()execCode tapePos ts codePos cs    | codePos == (snd . bounds $ cs) = return ()    | cmd == '+' = execCode tapePos (S.update tapePos (value + 1) ts) nextPos cs    | cmd == '-' = execCode tapePos (S.update tapePos (value - 1) ts) nextPos cs    | cmd == '>' = execCode (tapePos + 1) ts nextPos cs    | cmd == '<' = execCode (tapePos - 1) ts nextPos cs    | cmd == '[' && value == 0 = execCode tapePos ts (nextBracketIndex codePos 0 cs + 1) cs    | cmd == ']' && value /= 0 = execCode tapePos ts (prevBracketIndex codePos 0 cs + 1) cs    | cmd == '.' = putStr [chr $ S.index ts tapePos] >> execCode tapePos ts nextPos cs    | cmd == ',' = do { c <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos cs }    | otherwise = execCode tapePos ts nextPos cs    where value = S.index ts tapePos          cmd = cs ! codePos          nextPos = codePos + 1tape = S.fromList $ replicate 30000 0main = do    file <- readFile example.bf    execCode 0 tape 0 (listArray (0, length file - 1) file)
Brainfuck interpreter in Haskell
beginner;haskell;recursion;interpreter;brainfuck
Use case instead of == and guards everywhere:prevBracketIndex :: Int -> Int -> Array Int Char -> IntprevBracketIndex 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 csUse 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 -> IntprevBracketIndex 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) depthFor 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 Simport Data.Char (chr, ord)import Data.Arrayimport Data.ListcachePrev 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 -> idxexecCode' :: 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 - 1) ts nextPos        | cmd == '[' && value == 0 = execCode tapePos ts (cache next codePos + 1)        | cmd == ']' && value /= 0 = execCode tapePos ts (cache prev codePos + 1)        | cmd == '.' = putStr [chr $ S.index ts tapePos] >> 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 + 1For tests I found csFromString to be a convenient helper:csFromString file = listArray (0, length file - 1) fileAnd it helps to write main in a more compact way:main = readFile example.bf >>= execCode' tape . csFromStringNow 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 <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos }    _ -> execNext    where        value = S.index ts tapePos        nextPos = codePos + 1        execNext = execCode tapePos ts nextPosNow 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 <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos }    _ -> 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 execNextNow 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 i = case arr ! i of    Nothing -> error oops!    Just idx -> idxexecCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = execCode 0 ts 0 where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    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 <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos }        _ -> 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 execNextHere is complete final source:import qualified Data.Sequence as Simport Data.Char (chr, ord)import Data.Arrayimport Data.ListmkCache 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 i = case arr ! i of    Nothing -> error oops!    Just idx -> idxexecCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = execCode 0 ts 0 where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    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 <- getChar; let newTape = S.update tapePos (ord c) ts in execCode tapePos newTape nextPos }        _ -> 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 execNexttape = S.fromList $ replicate 30000 0csFromString file = listArray (0, length file - 1) filemain = readFile example.bf >>= execCode' tape . csFromStringNote that my suggestions about monad-loops, lens and State are still to be applied.The first step is to declare a datatype for our future state. data M = M    { _tapePos :: Int    , _tape :: S.Seq Int     , _codePos :: Int    }and make inner execCode accept a single parameter.     execCode :: M -> IO ()          execCode (M _ _ codePos) | codePos == (snd . bounds $ cs) = return ()    execCode (M 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 <- getChar; let newTape = S.update tapePos (ord c) ts in execCode (M tapePos newTape nextPos) }        _ -> execNext        where            value = S.index ts tapePos            nextPos = codePos + 1            execNext = execCode (M tapePos ts nextPos)            updatePos f = execCode (M tapePos (S.update tapePos (f value) ts) nextPos)            updateVal f = execCode (M (f tapePos) ts nextPos)            branch cond dir = if cond value then execCode (M tapePos ts (cache dir codePos + 1)) else execNextM stands for machine state :) and underscores are signals to Data.Lens.TH template Haskell code we will start using a bit later.We will need a state monad transformer ran on top of IO monad. Let's declare the type of our monad stack:type ExecT a = StateT M IO aOur future execCode'' will be of type ExecT () instead of current M -> IO (). To execute it and discard the state (as we do now) we'll use evalStateT:execCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode'' (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode'' :: ExecT ()    execCode'' = do        s <- get         lift (execCode s)    execCode :: M -> IO ()    execCode = ... -- unchangedNow execCode'' is just a wrapper around our old inner execCode. And we fix execCode so it can be called directly. Note that we should do the following:lift all IOReplace recursive calls execCode (M ...) with put (M ...) >> execCodemove where statements around so M tapePos ts codePos is in scopereplace old termination guard with whenHere is the result:execCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode :: ExecT ()    execCode = do        M tapePos ts codePos <- get        let value = S.index ts tapePos        let nextPos = codePos + 1        let execNext = put (M tapePos ts nextPos) >> execCode        let updatePos f = put (M tapePos (S.update tapePos (f value) ts) nextPos) >> execCode         let updateVal f = put (M (f tapePos) ts nextPos) >> execCode        let branch cond dir = if cond value then put (M tapePos ts (cache dir codePos + 1)) >> execCode else execNext        when (codePos /= (snd . bounds $ cs)) $ case cs ! codePos of            '+' -> updatePos succ            '-' -> updatePos pred            '>' -> updateVal succ            '<' -> updateVal pred            '[' -> branch (== 0) next             ']' -> branch (/= 0) prev            '.' -> lift (putStr [chr $ S.index ts tapePos]) >> execNext            ',' -> do { c <- lift getChar; let newTape = S.update tapePos (ord c) ts in put (M tapePos newTape nextPos) >> execCode }             _ -> execNextNow note that all branches of case end in >> execCode. So it can be moved around to form a nice while control structure:execCode :: ExecT ()execCode = do    M tapePos ts codePos <- get    let value = S.index ts tapePos    let nextPos = codePos + 1    let execNext = put (M tapePos ts nextPos)    let updatePos f = put (M tapePos (S.update tapePos (f value) ts) nextPos)     let updateVal f = put (M (f tapePos) ts nextPos)    let branch cond dir = if cond value then put (M tapePos ts (cache dir codePos + 1)) else execNext    when (codePos /= (snd . bounds $ cs)) $ do        case cs ! codePos of            '+' -> updatePos succ            '-' -> updatePos pred            '>' -> updateVal succ            '<' -> updateVal pred            '[' -> branch (== 0) next             ']' -> branch (/= 0) prev            '.' -> lift (putStr [chr $ S.index ts tapePos]) >> execNext            ',' -> do { c <- lift getChar; let newTape = S.update tapePos (ord c) ts in put (M tapePos newTape nextPos) }             _ -> execNext        execCodeNow it's finally time for lens to shine.{-# LANGUAGE TemplateHaskell  #-}import Control.Lens.THimport Control.Lensimport Control.Applicative...data M = M    { _mTapePos :: Int    , _mTape :: S.Seq Int     , _mCodePos :: Int    }$(makeLenses ''M)type ExecT a = StateT M IO aexecCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode :: ExecT ()    execCode = do        M tapePos ts codePos <- get        let value = S.index ts tapePos        let nextPos = codePos + 1        let execNext = mCodePos += 1        let updatePos f = mTape %= S.update tapePos (f value) >> execNext         let updateVal f = mTapePos %= f >> execNext        let branch cond dir = if cond value then mCodePos %= succ . cache dir else execNext        when (codePos /= (snd . bounds $ cs)) $ do            case cs ! codePos of                '+' -> updatePos succ                '-' -> updatePos pred                '>' -> updateVal succ                '<' -> updateVal pred                '[' -> branch (== 0) next                 ']' -> branch (/= 0) prev                '.' -> lift (putStr [chr $ S.index ts tapePos]) >> execNext                ',' -> do { c <- lift getChar; mTape %= S.update tapePos (ord c) >> execNext }                 _ -> execNext            execCodeI did the following:Added imports and TemplateHaskell pragmaAdded a template Haskell call to generate definitions for mTapePos from _mTapePosreplaced all put calls with one or many lens-based state modifiers, joined by >>. E.g. if 2 fields of M are modified I chain 2 modifiers. If just 1 - no need to chain. Basically it's just >> execNext instead of nextPos.removed unused nextPosNow it turns out that branch has its own hidden execNext (note succ . in the code above):let branch cond dir = if cond value then mCodePos %= cache dir >> execNext else execNextSo we can transform it to when easily:let branch cond dir = when (cond value) (mCodePos %= cache dir) >> execNextAnd now it turns out that >> execNext is everywhere. We can move it after case and  inline:execCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode :: ExecT ()    execCode = do        M tapePos ts codePos <- get        let value = S.index ts tapePos        let updatePos f = mTape %= S.update tapePos (f value)         let updateVal f = mTapePos %= f        let branch cond dir = when (cond value) (mCodePos %= cache dir)        when (codePos /= (snd . bounds $ cs)) $ do            case cs ! codePos of                '+' -> updatePos succ                '-' -> updatePos pred                '>' -> updateVal succ                '<' -> updateVal pred                '[' -> branch (== 0) next                 ']' -> branch (/= 0) prev                '.' -> lift (putStr [chr $ S.index ts tapePos])                ',' -> do { c <- lift getChar; mTape %= S.update tapePos (ord c) }                 _ -> return ()            mCodePos += 1            execCodeAfter some more cleanup we get:{-# LANGUAGE TemplateHaskell  #-}import Control.Lens.THimport Control.Lensimport Control.Applicativeimport qualified Data.Sequence as Simport Data.Char (chr, ord)import Data.Arrayimport Data.Listimport Control.Monad.StatemkCache 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 i = case arr ! i of    Nothing -> error oops!    Just idx -> idxdata M = M    { _mTapePos :: Int    , _mTape :: S.Seq Int     , _mCodePos :: Int    }$(makeLenses ''M)type ExecT a = StateT M IO aexecCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode :: ExecT ()    execCode = do        M tapePos ts codePos <- get        let value = S.index ts tapePos        let tapeAtPos = mTape . ix tapePos        let branch cond dir = when (cond value) (mCodePos %= cache dir)        when (codePos /= (snd . bounds $ cs)) $ do            case cs ! codePos of                '+' -> tapeAtPos += 1                 '-' -> tapeAtPos -= 1                '>' -> mTapePos += 1                '<' -> mTapePos -= 1                '[' -> branch (== 0) next                 ']' -> branch (/= 0) prev                '.' -> lift (putChar $ chr value)                ',' -> do { c <- lift getChar; mTape %= S.update tapePos (ord c) }                 _ -> return ()            mCodePos += 1            execCodetape = S.fromList $ replicate 30000 0csFromString file = listArray (0, length file - 1) filemain = readFile example.bf >>= execCode' tape . csFromStringOne more iteration of tuning for execCode' to make code more uniform which is good for readability and maintenance:tapeAtPos is made a self-contained compound lens, without reliance on tapePos and tapeAtPos is moved out of execState' body to global scope, and renamed to mTapeAtPos uniformly with other lensesvalue is renamed tapeAtPos as it corresponds to mTapeAtPosmTapeAtPos is used uniformly for both getting and updating the value everywhere including the getChar branchunsafeUse helper is used to get tapeAtPos uniformly with codePos. It is called unsafe because tapeAtPos may fail if mTapePos is out of range!lens API is used to read code uniformly with reading tapeextra parenthesis/$ are removed from when conditionM ... <- get is removed as it is not used anymoreThe code:mTapeAtPos f m = (mTape . ix (m ^. mTapePos)) f munsafeUse traversal = (^?! traversal) <$> getexecCode' :: S.Seq Int -> Array Int Char -> IO ()execCode' ts cs = evalStateT execCode (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    execCode :: ExecT ()    execCode = do        tapeAtPos <- unsafeUse mTapeAtPos         codePos <- use mCodePos        let branch cond dir = when (cond tapeAtPos) (mCodePos %= cache dir)        when (codePos /= snd (bounds cs)) $ do            case cs ^?! ix codePos of                '+' -> mTapeAtPos += 1                 '-' -> mTapeAtPos -= 1                '>' -> mTapePos += 1                '<' -> mTapePos -= 1                '[' -> branch (== 0) next                 ']' -> branch (/= 0) prev                '.' -> lift (putChar $ chr tapeAtPos)                ',' -> do { c <- lift getChar; mTapeAtPos .= ord c }                 _ -> return ()            mCodePos += 1            execCodeIt can be made even more uniform:at this point tapePos is used only in branch it can be moved into branch branch then can be moved outside of execCode as it doesn't a closure any moreit seems inner execCode is better named loop, and ExecT is LoopStateTThe code:branch cond dir = do     tapeAtPos <- unsafeUse mTapeAtPos     when (cond tapeAtPos) (mCodePos %= cache dir)execCode :: S.Seq Int -> Array Int Char -> IO ()execCode ts cs = evalStateT loop (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    loop :: LoopStateT ()    loop = do        codePos <- use mCodePos        when (codePos /= snd (bounds cs)) $ do            case cs ^?! ix codePos of                '+' -> mTapeAtPos += 1                 '-' -> mTapeAtPos -= 1                '>' -> mTapePos += 1                '<' -> mTapePos -= 1                '[' -> branch (== 0) next                 ']' -> branch (/= 0) prev                '.' -> unsafeUse mTapePos >>= lift . putChar . chr                ',' -> lift (ord <$> getChar) >>= (mTapeAtPos .=)                _ -> return ()            mCodePos += 1            loopAt this point it seems branch and ./, symmetry aren't worth it, so I inlined branch, reverted getChar branch to use do-notation and moved tapeAtPos <- to the top of loop:    loop :: LoopStateT ()    loop = do        tapeAtPos <- unsafeUse mTapeAtPos        codePos <- use mCodePos        when (codePos /= snd (bounds cs)) $ do            case cs ^?! ix codePos of                '+' -> mTapeAtPos += 1                 '-' -> mTapeAtPos -= 1                '>' -> mTapePos += 1                '<' -> mTapePos -= 1                '[' -> when (tapeAtPos == 0) (mCodePos %= cache next)                ']' -> when (tapeAtPos /= 0) (mCodePos %= cache prev)                '.' -> lift $ putChar (chr tapeAtPos)                ',' -> do { c <- lift getChar; mTapeAtPos .= ord c }                _ -> return ()            mCodePos += 1            loopAnother improvement is better diagnostics of match failures in cache:cache arr i = case arr ! i of    Nothing -> error $ No matching bracket at offset  ++ show i    Just idx -> idxSo we get:{-# LANGUAGE TemplateHaskell  #-}import Control.Lens.THimport Control.Lensimport Control.Applicativeimport qualified Data.Sequence as Simport Data.Char (chr, ord)import Data.Arrayimport Data.List (mapAccumR, mapAccumL)import Control.Monad.State (lift, get, evalStateT, when, StateT(..))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 i = case arr ! i of    Nothing -> error $ No matching bracket at offset  ++ show i    Just idx -> idxdata M = M    { _mTapePos :: Int    , _mTape :: S.Seq Int     , _mCodePos :: Int    }$(makeLenses ''M)type LoopStateT a = StateT M IO amTapeAtPos f m = (mTape . ix (m ^. mTapePos)) f munsafeUse traversal = (^?! traversal) <$> getexecCode :: S.Seq Int -> Array Int Char -> IO ()execCode ts cs = evalStateT loop (M 0 ts 0) where    prev = mkCache cs mapAccumL '[' ']'    next = mkCache cs mapAccumR ']' '['    loop :: LoopStateT ()    loop = do        tapeAtPos <- unsafeUse mTapeAtPos        codePos <- use mCodePos        when (codePos /= snd (bounds cs)) $ do            case cs ^?! ix codePos of                '+' -> mTapeAtPos += 1                 '-' -> mTapeAtPos -= 1                '>' -> mTapePos += 1                '<' -> mTapePos -= 1                '[' -> when (tapeAtPos == 0) (mCodePos %= cache next)                ']' -> when (tapeAtPos /= 0) (mCodePos %= cache prev)                '.' -> lift $ putChar $ chr tapeAtPos                ',' -> do { c <- lift getChar; mTapeAtPos .= ord c }                _ -> return ()            mCodePos += 1            looptape = S.fromList $ replicate 30000 0csFromString file = listArray (0, length file - 1) filemain = readFile example.bf >>= execCode tape . csFromString