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

From Rosetta Code
Content added Content deleted
(i don't think minus stops at 0)
m (Fixed syntax highlighting.)
 
(9 intermediate revisions by 8 users not shown)
Line 1: Line 1:
{{implementation|Brainf***}}{{collection|RCBF}}[[Category:Haskell]]
{{implementation|Brainf***}}{{collection|RCBF}}
Quick implementation of a [[Brainfuck]] interpreter in 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).
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''.
In functional style, ''run'' interprets a Brainfuck program as a function from an Integer list (inputs) to an Integer list (outputs). 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.
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)
moveLeft (x:l,r) = (l,x:r)
moveRight (l,x:r) = (x:l,r)
moveRight (l,x:r) = (x:l,r)

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

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

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

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

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

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

dialog :: String -> IO ()
dialog :: String -> IO ()
dialog s = mapM_ print $ run s $ repeat (unsafePerformIO readLn)
dialog s = mapM_ print . run s . map read . lines =<< getContents
</syntaxhighlight>(This version compiles with GHC and will run if loaded into ghci using ':load BF')


Example session:
Example session:


<pre>
: *Main> dialog ",[>+<-].>."
: *Main> dialog ",[>+<-].>."
: ''5''
: ''5''
: 0
: 0
: 5
: 5
</pre>

Latest revision as of 11:24, 1 September 2022

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). 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.

module BF where

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)

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 (subtract 1) 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 . map read . lines =<< getContents

(This version compiles with GHC and will run if loaded into ghci using ':load BF')

Example session:

: *Main> dialog ",[>+<-].>."
: ''5''
: 0
: 5