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

Added loops etc

Browse Source
This commit is contained in:
hellerve
2015-06-23 15:57:03 +02:00
parent 75e4f2fc99
commit e0eabe4678
4 changed files with 57 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@@ -1,3 +1,6 @@
# brainfuck # brainfuck
A Brainfuck interpreter and REPL in Haskell. A Brainfuck interpreter and REPL in Haskell.
There seems to be a bug somewhere (as the quine example does not work),
but I am not exactly sure where. Give me some time.

67
brainf*ck.hs
View File

@@ -1,7 +1,7 @@
module Main where module Main where
import Data.Char import Data.Char
import Data.Sequence hiding (null) import Data.Sequence hiding (length, null, take, reverse, drop)
import System.Console.Haskeline import System.Console.Haskeline
import System.Environment import System.Environment
@@ -20,7 +20,7 @@ printUsage = do printVersion
"\n\twithout arguments - runs REPL" ++ "\n\twithout arguments - runs REPL" ++
"\n\t-h/--help - display this help message" ++ "\n\t-h/--help - display this help message" ++
"\n\nMore information can be found on " ++ "\n\nMore information can be found on " ++
"https://github.com/hellerve/unlambda") "https://github.com/hellerve/brainfuck")
printVersion :: IO () printVersion :: IO ()
printVersion = putStrLn (name ++ " Version " ++ version) printVersion = putStrLn (name ++ " Version " ++ version)
@@ -28,20 +28,42 @@ printVersion = putStrLn (name ++ " Version " ++ version)
printCommands :: IO () printCommands :: IO ()
printCommands = putStrLn "Press Ctrl-C to exit interpreter" printCommands = putStrLn "Press Ctrl-C to exit interpreter"
program :: String -> Seq Int -> Int -> IO () program :: String -> String -> Seq Int -> Int -> IO ()
program "" _ _ = return () program _ "" _ _ = return ()
program ('>' : l) tape ptr = program l tape (ptr+1) program i ('\n' : l) tape ptr = program i l tape ptr
program ('<' : l) tape ptr = program l tape (ptr-1) program i (' ' : l) tape ptr = program i l tape ptr
program ('+' : l) tape ptr = let newtape = update ptr ((index tape ptr) + 1) tape program i ('>' : l) tape ptr = program i l tape (ptr+1)
in program l newtape ptr program i ('<' : l) tape ptr = program i l tape (ptr-1)
program ('-' : l) tape ptr = let newtape = update ptr ((index tape ptr) - 1) tape program i ('+' : l) tape ptr = let newtape = update ptr ((index tape ptr) + 1) tape
in program l newtape ptr in program i l newtape ptr
program ('.' : l) tape ptr = do putChar $ chr $ index tape ptr program i ('-' : l) tape ptr = let newtape = update ptr ((index tape ptr) - 1) tape
program l tape ptr in program i l newtape ptr
program (',' : l) tape ptr = do x <- getChar program i ('.' : l) tape ptr = do putChar $ chr $ index tape ptr
let newtape = update ptr (ord x) tape program i l tape ptr
program l newtape ptr program i (',' : l) tape ptr = do x <- getChar
program (x : _) _ _ = putStrLn ("Unknown instruction: " ++ [x]) let newtape = update ptr (ord x) tape
program i l newtape ptr
program i ('[' : l) tape ptr = if (index tape ptr) == 0
then let x = findJump l 1
in program i x tape ptr
else program i l tape ptr
where findJump :: String -> Integer -> String
findJump f 0 = f
findJump ('[' : f) c = findJump f (c+1)
findJump (']' : f) c = findJump f (c-1)
findJump (_ : f) c = findJump f c
findJump "" _ = error "Loop brackets mismatched: too few closing"
program i (']' : l) tape ptr = if not ((index tape ptr) == 0)
then let x = findJump (reverse (take (length i - length l - 1) i)) 1
in program i (drop (length x) i) tape ptr
else program i l tape ptr
where findJump :: String -> Integer -> String
findJump f 0 = f
findJump ('[' : f) c = findJump f (c-1)
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])
main :: IO () main :: IO ()
main = do main = do
@@ -57,7 +79,9 @@ main = do
else exec args else exec args
exec :: [String] -> IO () exec :: [String] -> IO ()
exec _ = undefined exec a = do x <- readFile (head a)
let s = take (length x - 1) x
program s s (zeroes 30000 empty) 0
getInput :: IO String getInput :: IO String
getInput = runInputT defaultSettings repl_ getInput = runInputT defaultSettings repl_
@@ -72,9 +96,10 @@ repl = do input <- getInput
case input of case input of
"" -> repl "" -> repl
"quit" -> putStrLn "Bye" "quit" -> putStrLn "Bye"
x -> do program x (zeroes 30000 empty) 0 x -> do program x x (zeroes 30000 empty) 0
putStrLn "" putStrLn ""
repl repl
where zeroes :: Int -> Seq Int -> Seq Int
zeroes 0 l = l zeroes :: Int -> Seq Int -> Seq Int
zeroes n l = zeroes (n-1) (l |> 0) zeroes 0 l = l
zeroes n l = zeroes (n-1) (l |> 0)

1
examples/hello_world.bf Normal file
View File

@@ -0,0 +1 @@
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.

7
examples/quine.bf Normal file
View File

@@ -0,0 +1,7 @@
>---->-->+>++++>++>+>+>+>+>-->->->>>>->-->-->-->-->->>+>-->->>>>>>+>--->++>>>>>>
++>->>>>>>>>>>>>>>>+>>>>++>->>>>+>--->++>--->--->--->++>+>+>-->->->->++++>+>>+>+
>>++>->->-->->>>>>+>>++>>>>>>-->-->+>+>>->->>++>->>>+>++>->>++++>>>+>+>-->->->>>
>>>>>>>>+>+>--->++>>>>>>>->->-->+>++>+>+>-->->-->->++>--->+>+>>++>>++>--->->->>>
>>->-->>>>>+>-->+>+>+>>->->->>++>++>>>>++++[[+>>>+<<<]<++++]>++++>>-[+[+<<-[>]>]
<<[<]>>++++++[-<<++++++++++>>]<<++.+>[<++>[+>>+<<]]+++++[+<++++>]>>[+<<+<.>>>]<<
[---[-<+++>[+++<++++++++++++++>[+++++[-<+++++>]<+>]]]]>+++>>]<<<<[.<]