Execute Brain****/Haskell: Difference between revisions

m
Fixed syntax highlighting.
m (RCBF (Haskell) moved to RCBF/Haskell: MW has page hierarchy support.)
m (Fixed syntax highlighting.)
 
(10 intermediate revisions by 8 users not shown)
Line 1:
{{implementation|Brainf***}}{{collection|RCBF}}[[Category:Haskell]]
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'', thisThis 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.
 
<syntaxhighlight lang="haskell">module BF where
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)
 
decexec :: (String, String) -> ([Integer], [Integer]) -> [Integer] -> [Integer]
exec p@ (_,'[':_]) d _ cs = exec (moveRight_ p) d= cs[]
dec 0 = 0
exec p@(_,'[>':_) d@(_,0:_) cs = exec (matchRightmoveRight p) (pad $ moveRight $ pd) d cs
dec x = x-1
exec p@(_,']<':_) d cs = exec (matchLeftmoveRight p) (pad $ moveLeft $ p) d) cs
exec p@(_,']+':_) d@(_,0:_) cs = exec (moveRight p) (modify (+ 1) d) cs
exec :: (String, String) -> ([Integer], [Integer]) -> [Integer] -> [Integer]
exec p@(_,[]'-':_) d _ cs = exec _(moveRight p) =(modify (subtract 1) d) []cs
exec p@(_,'>,':_) d (c:cs) = exec (moveRight p) (padmodify $(const moveRight $c) d) cs
exec p@(_,'<.':_) d@(_,x:_) cs = x cs =: exec (moveRight p) (pad $ moveLeft $ d) cs
exec p@(_,'+[':_) d @(_,0:_) cs = exec (matchRight $ moveRight $ p) (modify (+1) d) cs
exec p@(_,'-[':_) d cs = exec (moveRight p) (modify (dec) d) cs
exec p@(_,',]':_) d @(c_,0:cs_) cs = exec (moveRight p) (modify (const c) d) cs
exec p@(_,'.]':_) d@(_,x:_) cs = x : cs = exec (moveRightmatchLeft $ moveLeft $ p) d cs
 
exec p@(_,'[':_) d@(_,0:_) cs = exec (matchRight $ moveRight $ p) d cs
execrun :: (String, String) -> ([Integer], [Integer]) -> [Integer] -> [Integer]
exec p@(_,'[':_) d cs = exec (moveRight p) d cs
run s = exec ([],s) ([0],[0])
exec p@(_,']':_) d@(_,0:_) cs = exec (moveRight p) d cs
 
exec p@(_,']':_) d cs = exec (matchLeft $ moveLeft $ p) d cs
dialog :: String -> IO ()
dialog s = mapM_ print $. run s $. repeatmap (unsafePerformIOread readLn). lines =<< getContents
run :: String -> [Integer] -> [Integer]
</syntaxhighlight>(This version compiles with GHC and will run if loaded into ghci using ':load BF')
run s = exec ([],s) ([0],[0])
dialog :: String -> IO ()
dialog s = mapM_ print $ run s $ repeat (unsafePerformIO readLn)
 
Example session:
 
<pre>
: *Main> dialog ",[>+<-].>."
: ''5''
: 0
: 5
</pre>
9,476

edits