After reading this article on writing a Brainfuck interpreter in Haskell and achieving awful performance with it (for example, mandelbrot generating 37.5 minutes on an old Intel Atom powered laptop) I've decided to write a compiler for it.
I picked NASM for my output language, because that is the only assembly language I somewhat understand, and after some problems (resolved in this StackOverflow question) I've finally arrived with a working compiler!
I would like get more feedback about good coding practices in Haskell more than optimal Assembly generation, because I am interested more in the former language (and also because programs generated by my compiler are quite fast, the same mandelbrot set generator took only 7s 24ms to execute on the same old laptop, so I feel like it is good enough, although there is a lot of room for improvement).
Also, please note that I have a very hard time understanding monads.
Starting with the data types, the most important one is
data BfCommand = GoLeft Int -- < | GoRight Int -- > | Add Int -- + | Sub Int -- - | LoopL Int -- [ | LoopR Int -- ] | WriteChar -- . | ReadChar -- , | BfConst Int -- ??? deriving (Eq, Show)
The only thing I do not like about this type, is the
BfConst constructor. It just does not feel like it belongs to this data type, because it was added later (to properly represent
[+], which sets selected cell's value to
0). It is just awkward.
What would be the correct and elegant way of doing something like this?
Parsing text into instructions
newtype BfSource = BfSource [BfCommand] deriving (Show) parseBf :: String -> BfSource parseBf = optimiseBf . BfSource . pairLoops   . countLoopLs 0 . reduceConsts . mapMaybe char2bfc where char2bfc :: Char -> Maybe BfCommand char2bfc '<' = Just $ GoLeft 1 char2bfc '>' = Just $ GoRight 1 char2bfc '+' = Just $ Add 1 char2bfc '-' = Just $ Sub 1 char2bfc '[' = Just $ LoopL 0 char2bfc ']' = Just $ LoopR 0 char2bfc '.' = Just WriteChar char2bfc ',' = Just ReadChar char2bfc _ = Nothing countLoopLs :: Int -> [BfCommand] -> [BfCommand] countLoopLs _  =  countLoopLs n (LoopL _:bs) = LoopL n : countLoopLs (n + 1) bs countLoopLs n (b:bs) = b : countLoopLs n bs reduceConsts :: [BfCommand] -> [BfCommand] reduceConsts  =  reduceConsts (LoopL _:Sub 1:LoopR _:bs) = BfConst 0 : reduceConsts bs reduceConsts (LoopL _:Add 1:LoopR _:bs) = BfConst 0 : reduceConsts bs reduceConsts (b:bs) = b : reduceConsts bs
How to rewrite
reduceConsts in a more elegant way? If not for the pattern matching, I would have done it with a
Controlling the flow of the program
To pair the loops correctly I used a stack approach:
pairLoops :: [Int] -> [BfCommand] -> [BfCommand] -> [BfCommand] pairLoops _ q  = reverse q pairLoops st q (LoopL x:bs) = pairLoops (x:st) (LoopL x : q) bs pairLoops (s:st) q (LoopR _:bs) = pairLoops st (LoopR s : q) bs pairLoops st q (b:bs) = pairLoops st (b : q) bs
The main flaw here is the lack of syntax error checking, but I did not really know how to add it.
This compiler makes very simple optimisations:
- Grouping equal elements (
+++is represented as
- Reducing excluding operators (
+++--is represented as
optimiseBf does exactly that (excluding the last point, this is done by
optimiseBf :: BfSource -> BfSource optimiseBf (BfSource bs) = if bs /= obs then optimiseBf (BfSource obs) else BfSource obs where obs = opthelper bs opthelper :: [BfCommand] -> [BfCommand] opthelper  =  opthelper [x] = [x] opthelper (x:y:xs) = let r = reduceBf x y single = fromOne r (s1, s2) = fromTwo r in case r of Zero -> opthelper xs (One _) -> single : opthelper xs (Two _ _) -> s1 : opthelper (s2 : xs)
This function groups and throws out excluding instructions. Doing it with this
if bs /= obs then optimiseBf (BfSource obs) else BfSource obs
is probably a horrible way to do it, but I could not think of another one.
Reducing individual instructions is done using
reduceBf :: BfCommand -> BfCommand -> TwoOrLess BfCommand data TwoOrLess a = Zero | One a | Two a a deriving (Show, Eq)
There is not much to talk about
reduceBf because it is just hardcoded rules.
The final stage. This one was surprisingly easy to do (except the loops part).
bf2asm :: Handle -> BfCommand -> IO () bf2asm handle (GoLeft x) = hPutStrLn handle $ " " ++ if x == 1 then "dec rcx" else "sub rcx, " ++ show x bf2asm handle (GoRight x) = hPutStrLn handle $ " " ++ if x == 1 then "inc rcx" else "add rcx, " ++ show x bf2asm handle (Add x) = mapM_ (hPutStrLn handle) [ " mov al, [rcx]" , " " ++ if x == 1 then "inc al" else "add al, " ++ show x , " mov [rcx], al" ] bf2asm handle (Sub x) = mapM_ (hPutStrLn handle) [ " mov al, [rcx]" , " " ++ if x == 1 then "dec al" else "sub al, " ++ show x , " mov [rcx], al" ] bf2asm handle (LoopL x) = mapM_ (hPutStrLn handle) [ "_LS" ++ show x ++ ":" , " mov al, [rcx]" , " test al, al" , " jz _LE" ++ show x ] bf2asm handle (LoopR x) = mapM_ (hPutStrLn handle) [ " jmp _LS" ++ show x , "_LE" ++ show x ++ ":" ] bf2asm handle WriteChar = hPutStrLn handle " call _printChar" bf2asm handle ReadChar = hPutStrLn handle " call _readChar" bf2asm handle (BfConst x) = mapM_ (hPutStrLn handle) [ " " ++ if x == 0 then "xor al, al" else "mov al, " ++ show x , " mov [rcx], al" ]
Is it better to provide a
Handle and write to it like I did, or maybe this function should just create
If the need arises, feel free to look at the code as a whole here.