pl/brainfuck.hs
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

minor modifications and added hanoi example (incredibly slow)

Browse Source
This commit is contained in:
hellerve
2015-06-23 16:15:24 +02:00
parent e0eabe4678
commit 58b44a43d7
3 changed files with 714 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
brainf*ck.hs
View File

@@ -4,6 +4,7 @@ import Data.Char
import Data.Sequence hiding (length, null, take, reverse, drop)
import System.Console.Haskeline
import System.Environment
import System.IO
name :: String
name = "brainfuck"
@@ -30,8 +31,6 @@ printCommands = putStrLn "Press Ctrl-C to exit interpreter"
program :: String -> String -> Seq Int -> Int -> IO ()
program _ "" _ _ = return ()
program i ('\n' : l) tape ptr = program i l tape ptr
program i (' ' : l) tape ptr = program i l tape ptr
program i ('>' : l) tape ptr = program i l tape (ptr+1)
program i ('<' : l) tape ptr = program i l tape (ptr-1)
program i ('+' : l) tape ptr = let newtape = update ptr ((index tape ptr) + 1) tape
@@ -39,6 +38,7 @@ program i ('+' : l) tape ptr = let newtape = update ptr ((index tape ptr) + 1) t
program i ('-' : l) tape ptr = let newtape = update ptr ((index tape ptr) - 1) tape
in program i l newtape ptr
program i ('.' : l) tape ptr = do putChar $ chr $ index tape ptr
hFlush stdout
program i l tape ptr
program i (',' : l) tape ptr = do x <- getChar
let newtape = update ptr (ord x) tape
@@ -63,7 +63,7 @@ program i (']' : l) tape ptr = if not ((index tape ptr) == 0)
findJump (']' : f) c = findJump f (c+1)
findJump (_ : f) c = findJump f c
findJump "" _ = error "Loop brackets mismatched: too many closing"
program _ (x : _) _ _ = putStrLn ("Unknown instruction: " ++ [x])
program i (_ : l) tape ptr = program i l tape ptr
main :: IO ()
main = do