I am very new to Haskell and come from languages like C++, although I do have some experience with Scheme. Here, I wrote a simple brainf*** interpreter, which so far is my largest project. I followed a tutorial for some of the code (such as the Tape data type), but did most of this on my own. I have one major concern with my approach, which is the way I handle the loops (which in brainf*** are written with [] and repeat until the current cell in the tape is zero. In my implementation, I used the loop as a parameter to the main recursive function, which is called if the current instruction is ] and the current cell is not 0. Since these loops modify the tape, I had to make them return an instance of Tape that would replace the current one. However, since the function also handles IO (and therefore must return an instance of IO), I made it return an IO (Tape Int) which is then unpacked in a do block. This all felt very messy and hacky, so I would really appreciate any help from more experienced Haskell developers.
import Data.Maybe
--The Tape data type and functions
data Tape a = Tape [a] a [a]
newTape :: a -> Tape a
newTape x = Tape r x r
where r = repeat x
moveLeft :: Tape a -> Tape a
moveLeft (Tape (l:ls) x rs) = Tape ls l (x:rs)
moveRight :: Tape a -> Tape a
moveRight (Tape ls x (r:rs)) = Tape (x:ls) r rs
--The Brainf*** instruction data types
data BfInstruction
= MovLeft
| MovRight
| Increment
| Decrement
| Output
| Input
| BeginLoop
| EndLoop
deriving (Show, Eq)
type BfProgram = [BfInstruction]
--Convert string to BfProgram
parseBf :: String -> BfProgram
parseBf = mapMaybe parse
where
parse :: Char -> Maybe BfInstruction
parse x = case x of
'<' -> Just MovLeft
'>' -> Just MovRight
'+' -> Just Increment
'-' -> Just Decrement
',' -> Just Input
'.' -> Just Output
'[' -> Just BeginLoop
']' -> Just EndLoop
x -> Nothing --anything but the above chars is a comment
--Main running function
runBf :: String -> IO ()
runBf p = runBf' (parseBf p) (newTape 0) [] >> return ()
where
runBf' :: BfProgram -> Tape Int -> BfProgram -> IO (Tape Int)
runBf' [] tape _ = return tape
runBf' prog@(p:ps) tape@(Tape ls x rs) loop = case p of
MovLeft -> advance prog (moveLeft tape)
MovRight -> advance prog (moveRight tape)
Increment -> advance prog (Tape ls (x+1) rs)
Decrement -> advance prog (Tape ls (x-1) rs)
Input -> do
char <- getChar
advance prog (Tape ls (fromEnum char) rs)
Output -> putChar (toEnum x) >> advance prog tape
BeginLoop ->
let lp = getLoop 1 ps
in runBf' (length lp `drop` ps) tape lp --Drop so that we are at the ] now
EndLoop ->
if x /= 0
then do
lt <- runBf' loop tape []
runBf' prog lt loop --Copy the tape from the result of the loop into next iteration
else advance prog tape
advance :: BfProgram -> Tape Int -> IO (Tape Int)
advance (p:ps) tape = runBf' ps tape []
getLoop :: Int -> BfProgram -> BfProgram
getLoop _ [] = error "Mismatched brackets in BF program"
getLoop 1 (EndLoop:ps) = []
getLoop n (p:ps) = p:case p of
BeginLoop -> getLoop (n + 1) ps
EndLoop -> getLoop (n - 1) ps
_ -> getLoop n ps
--Simple IO
main = do
program <- readFile "program.bf"
runBf program