106 lines
3.8 KiB
Haskell
106 lines
3.8 KiB
Haskell
module Main where
|
|
|
|
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"
|
|
|
|
version :: String
|
|
version = "0.1.0"
|
|
|
|
prompt :: String
|
|
prompt = name ++ "> "
|
|
|
|
printUsage :: IO ()
|
|
printUsage = do printVersion
|
|
putStrLn("\nUsage: " ++
|
|
"\n\twithout arguments - runs REPL" ++
|
|
"\n\t-h/--help - display this help message" ++
|
|
"\n\nMore information can be found on " ++
|
|
"https://github.com/hellerve/brainfuck")
|
|
|
|
printVersion :: IO ()
|
|
printVersion = putStrLn (name ++ " Version " ++ version)
|
|
|
|
printCommands :: IO ()
|
|
printCommands = putStrLn "Press Ctrl-C to exit interpreter"
|
|
|
|
program :: String -> String -> Seq Int -> Int -> IO ()
|
|
program _ "" _ _ = return ()
|
|
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
|
|
in program i l newtape ptr
|
|
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
|
|
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 i (_ : l) tape ptr = program i l tape ptr
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
if null args
|
|
then do printVersion
|
|
printCommands
|
|
putStrLn ""
|
|
repl
|
|
else
|
|
if(head args == "-h") || (head args == "--help")
|
|
then printUsage
|
|
else exec args
|
|
|
|
exec :: [String] -> IO ()
|
|
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 = runInputT defaultSettings repl_
|
|
where repl_ = do
|
|
x <- getInputLine "> "
|
|
case x of
|
|
Nothing -> return ""
|
|
Just i -> return i
|
|
|
|
repl :: IO ()
|
|
repl = do input <- getInput
|
|
case input of
|
|
"" -> repl
|
|
"quit" -> putStrLn "Bye"
|
|
x -> do program x x (zeroes 30000 empty) 0
|
|
putStrLn ""
|
|
repl
|
|
|
|
zeroes :: Int -> Seq Int -> Seq Int
|
|
zeroes 0 l = l
|
|
zeroes n l = zeroes (n-1) (l |> 0)
|