yabi 0.1.0.0 → 0.1.1.0
raw patch · 2 files changed
+70/−43 lines, 2 files
Files
- yabi.cabal +2/−2
- yabi.hs +68/−41
yabi.cabal view
@@ -1,7 +1,7 @@ name: yabi-version: 0.1.0.0+version: 0.1.1.0 synopsis: Yet Another Brainfuck Interpreter-description: Yet Another Brainfuck Interpreter+description: Yet Another Brainfuck Interpreter. Usage: yabi path homepage: https://github.com/fgaz/yabi license: MIT license-file: LICENSE
yabi.hs view
@@ -4,16 +4,19 @@ import System.IO (readFile, putChar, getChar, stdout, stdin, hSetBuffering, BufferMode (NoBuffering)) import System.Exit (exitFailure) ---the memory & program zippers-type Memory = ([Word8],[Word8]) -- the memory zipper: (left, pointer:right)-type Program = ([Char],[Char]) -- the instructions zipper: (todo,done)+--represents a bf instruction or a loop+data Instruction = Plus | Minus | Next | Prev | Input | Output | Loop [Instruction] | MDump | PDump deriving (Show, Eq)+type Program = [Instruction] +--the memory zipper: (left, pointer:right)+type Memory = ([Word8],[Word8])+ --the default memory, an infinite zipper filled with zeros-defaultMemory :: ([Word8],[Word8])+defaultMemory :: Memory defaultMemory = ((repeat 0),(repeat 0)) --breaks a string when the brackets are balanced--- an open bracket adds 1 to the balance, a closed one subtracts 1+--an open bracket adds 1 to the balance, a closed one subtracts 1 breakWhenBalanced :: Int -> String -> (String, String) breakWhenBalanced 0 str = ("",str) breakWhenBalanced balance (s:str) | s == '[' = let (first, second) = breakWhenBalanced (balance+1) str in (s:first, second)@@ -21,61 +24,85 @@ | otherwise = let (first, second) = breakWhenBalanced balance str in (s:first, second) breakWhenBalanced balance [] = error $ "malformed code, brackets balance off by " ++ (show balance) ++--parse a string to a Program+bfParse :: String -> Program -> Program+bfParse "" prog = prog --edge condition+--adds a Loop containing the code inside the brackets+bfParse ('[':str) prog = bfParse str' $ prog ++ [Loop loop]+ where loop = bfParse (init loopStr) []+ (loopStr, str') = breakWhenBalanced 1 str+--all other instructions+bfParse (char:str) prog = bfParse str $ prog ++ instruction+ where instruction = case char2instruction char of Just a -> [a]+ Nothing -> [] --comments++char2instruction :: Char -> Maybe Instruction+char2instruction '>' = Just Next+char2instruction '<' = Just Prev+char2instruction '+' = Just Plus+char2instruction '-' = Just Minus+char2instruction '.' = Just Output+char2instruction ',' = Just Input+char2instruction '#' = Just MDump+char2instruction '§' = Just PDump --i picked a random not-widely-used character for this+char2instruction _ = Nothing --comments+ --the actual interpreter-bf :: Program -> Memory -> IO ()-bf ([], _) _ = return () --end of program+bf :: Program -> Memory -> IO Memory+bf [] memory = return memory --end of (sub)program --move the pointer-bf ('>':commands, done) (ml, m:mr) = bf (commands, '>':done) (m:ml, mr)-bf ('<':commands, done) (m:ml, mr) = bf (commands, '<':done) (ml, m:mr)+bf (Next:commands) (ml, m:mr) = bf commands (m:ml, mr)+bf (Prev:commands) (m:ml, mr) = bf commands (ml, m:mr) --change the pointed byte-bf ('+':commands, done) (ml, m:mr) = bf (commands, '+':done) (ml, (m+1):mr)-bf ('-':commands, done) (ml, m:mr) = bf (commands, '-':done) (ml, (m-1):mr)+bf (Plus:commands) (ml, m:mr) = bf commands (ml, (m+1):mr)+bf (Minus:commands) (ml, m:mr) = bf commands (ml, (m-1):mr) --output of pointed byte-bf ('.':commands, done) (ml, m:mr) = do- putChar $ chr $ fromIntegral m- bf (commands, '.':done) (ml, m:mr)+bf (Output:commands) (ml, m:mr) = do+ putChar $ chr $ fromIntegral m+ bf commands (ml, m:mr) --input to pointed byte-bf (',':commands, done) (ml, _:mr) = do- char <- getChar- let m = fromIntegral $ ord char- bf (commands, ',':done) (ml, m:mr)---if pointed byte == 0 then jump forward to the corresponding ]-bf ('[':commands, done) (ml, m:mr) | m == 0 = bf (commands', done') (ml, m:mr)- | otherwise = bf (commands, '[':done) (ml, m:mr)- where (token, commands') = breakWhenBalanced 1 commands- done' = (reverse token) ++ '[':done---if pointed byte /= 0 then jump back to the corresponding [-bf (']':commands, done) (ml, m:mr) | m /= 0 = bf (commands', done') (ml, m:mr)- | otherwise = bf (commands, ']':done) (ml, m:mr) --the interpreter works even without this line and "| m /= 0" on the line above, but this way is faster- where (token, done') = breakWhenBalanced (-1) done- commands' = (reverse token) ++ ']':commands+bf (Input:commands) (ml, _:mr) = do+ char <- getChar+ let m = fromIntegral $ ord char+ bf commands (ml, m:mr)+--loop (brackets)+bf ((Loop loop):commands) (ml, m:mr) | m == 0 = bf commands (ml, m:mr) --skip the loop+ | otherwise = do+ memory' <- bf loop (ml, m:mr) --execute the loop one time+ bf ((Loop loop):commands) memory' --recurse --debug --memory dump ('#', according to Urban Müller's original interpreter)-bf ('#':commands, done) (ml,m:mr) = do- putStrLn "Memory dump:"- putStrLn $ " " ++ (show $ takeWhile (/=0) ml) ++ " >" ++ (show m) ++ "< " ++ (show $ takeWhile (/=0) mr)- bf (commands, '#':done) (ml,m:mr)---program dump (i picked a random not-widely-used character for this)-bf ('§':commands, done) (ml,mr) = do- putStrLn "Program dump:"- putStrLn $ " " ++ (reverse done) ++ "|" ++ commands- putStrLn $ (replicate (length done + 2) ' ') ++ "^"- bf (commands, '§':done) (ml,mr)+bf (MDump:commands) (ml,m:mr) = do+ putStrLn "Memory dump:"+ putStrLn $ " " ++ (show $ takeWhile (/=0) ml) ++ " >" ++ (show m) ++ "< " ++ (show $ takeWhile (/=0) mr)+ bf commands (ml,m:mr)+--program dump+bf (PDump:commands) memory = do+ putStrLn "Program dump:"+ putStrLn $ " " ++ (show commands)+ bf commands memory --catch-all pattern. I have yet to discover a way to fall down there-bf _ _ = error "malformed code"+--whitout the infinite zipper it would be out of memory+bf _ _ = error "wtf error." + main :: IO () main = do args <- getArgs if length args /= 1 then do- putStrLn "Usage: brainfuck path"+ putStrLn "Usage: yabi path" exitFailure else return () rawProgram <- readFile $ head args- let program = (filter (`elem` "><+-.,[]#§") rawProgram, [])+ putStrLn "[yabi] Parsing..."+ --parse the program string+ let program = bfParse rawProgram []+ putStrLn "[yabi] Parsed. Executing..." --disable buffering hSetBuffering stdout NoBuffering hSetBuffering stdin NoBuffering --start the interpreter bf program defaultMemory+ return ()