Execute Brain****/Haskell

Execute Brain****/Haskell is an implementation of Brainf***. Other implementations of Brainf***.

Execute Brain****/Haskell is part of RCBF. You may find other members of RCBF at Category:RCBF.

Quick implementation of a Brainfuck interpreter in Haskell.

Pairs of lists are used to implement both the two-side infinite band of cells, and the program storage. This means that it can also work on infinite Brainfuck programs (which could be generated lazily).

In functional style, run interprets a Brainfuck program as a function from an Integer list (inputs) to an Integer list (outputs). With help of unsafePerformIO, this can be easily turned into a real dialog with a user via stdin and stdout.

A more efficient implementation could for example only admit well-bracketed brainfuck programs, and parse bracket blocks first, to replace the matchLeft and matchRight which need linear time.

import System.IO.Unsafe

moveLeft  (x:l,r) = (l,x:r)
moveRight (l,x:r) = (x:l,r) 

matchLeft d@('[':_,_) = d
matchLeft d@(']':_,_) = matchLeft $ moveLeft $ matchLeft $ moveLeft $ d
matchLeft d           = matchLeft $ moveLeft $ d

matchRight d@(_,']':_) = moveRight $ d
matchRight d@(_,'[':_) = matchRight $ matchRight $ moveRight $ d
matchRight d           = matchRight $ moveRight  $ d

pad ([],[]) = ([0],[0])
pad ([],r)  = ([0],r)
pad (l,[])  = (l,[0])
pad d       = d

modify f (l,x:r) = (l,(f x):r)

dec :: Integer -> Integer
dec 0 = 0
dec x = x-1

exec :: (String, String) -> ([Integer], [Integer]) -> [Integer] -> [Integer]
exec   (_,[])    _         _  = []
exec p@(_,'>':_) d         cs = exec (moveRight p) (pad $ moveRight $ d) cs
exec p@(_,'<':_) d         cs = exec (moveRight p) (pad $ moveLeft  $ d) cs
exec p@(_,'+':_) d         cs = exec (moveRight p) (modify (+1)  d) cs
exec p@(_,'-':_) d         cs = exec (moveRight p) (modify (dec) d) cs
exec p@(_,',':_) d     (c:cs) = exec (moveRight p) (modify (const c) d) cs
exec p@(_,'.':_) d@(_,x:_) cs = x : exec (moveRight p) d cs
exec p@(_,'[':_) d@(_,0:_) cs = exec (matchRight $ moveRight $ p) d cs
exec p@(_,'[':_) d         cs = exec (moveRight p) d cs
exec p@(_,']':_) d@(_,0:_) cs = exec (moveRight p) d cs
exec p@(_,']':_) d         cs = exec (matchLeft $ moveLeft $ p) d cs

run :: String -> [Integer] -> [Integer]
run s = exec ([],s) ([0],[0])

dialog :: String -> IO ()
dialog s = mapM_ print $ run s $ repeat (unsafePerformIO readLn)

Example session:

*Main> dialog ",[>+<-].>."

5

0

5