diff options
Diffstat (limited to 'Brainfuck')
| -rw-r--r-- | Brainfuck/Interpreter.hs | 70 | ||||
| -rw-r--r-- | Brainfuck/Parser.hs | 62 | ||||
| -rw-r--r-- | Brainfuck/Tape.hs | 46 |
3 files changed, 0 insertions, 178 deletions
diff --git a/Brainfuck/Interpreter.hs b/Brainfuck/Interpreter.hs deleted file mode 100644 index 1085a30..0000000 --- a/Brainfuck/Interpreter.hs +++ /dev/null @@ -1,70 +0,0 @@ -module Brainfuck.Interpreter ( - brainfuck - ) where - - -import Data.Char -import Data.Maybe -import Brainfuck.Parser -import Brainfuck.Tape - - - - -brainfuck :: BrainfuckProgram -> IO (Tape Int) -brainfuck program = - let dataTape = (repeat 0, Just 0, repeat 0) - commandTape = shiftRight ([], Nothing, program) - in process commandTape dataTape - - - -endLoop :: Tape BrainCom -> Tape BrainCom -endLoop tape = - let f t c = case (currentCell t, c) of - (Just CloseLoop, 0) -> shiftRight t - (Just OpenLoop, x) -> f (shiftRight t) (x + 1) - (Just CloseLoop, x) -> f (shiftRight t) (x - 1) - (Just com, x) -> f (shiftRight t) x - in f (shiftRight tape) 0 - - - -doLoop :: Tape BrainCom -> Tape BrainCom -doLoop tape = - let f t c = case (currentCell t, c) of - (Just OpenLoop, 0) -> shiftRight t - (Just OpenLoop, x) -> f (shiftLeft t) (x - 1) - (Just CloseLoop, x) -> f (shiftLeft t) (x + 1) - (Just com, x) -> f (shiftLeft t) x - in f (shiftLeft tape) 0 - - - -process :: Tape BrainCom -> Tape Int -> IO (Tape Int) -process commandTape dataTape = - case (currentCell commandTape) of - Nothing -> return dataTape - - Just R -> process (shiftRight commandTape) (shiftRight dataTape) - - Just L -> process (shiftRight commandTape) (shiftLeft dataTape) - - Just Inc -> process (shiftRight commandTape) (applyToCurrentCell ((`mod` 256) . (+1)) dataTape) - - Just Dec -> process (shiftRight commandTape) (applyToCurrentCell ((`mod` 256) . (subtract 1)) dataTape) - - Just Out -> (putChar . chr . fromJust . currentCell $ dataTape) >> process (shiftRight commandTape) dataTape - - Just In -> do { c <- getChar; process (shiftRight commandTape) (applyToCurrentCell (\_ -> ord c) dataTape) } - - Just OpenLoop -> - if (currentCell dataTape == Just 0) - then process (endLoop commandTape) dataTape - else process (shiftRight commandTape) dataTape - - Just CloseLoop -> - if (currentCell dataTape /= Just 0) - then process (doLoop commandTape) dataTape - else process (shiftRight commandTape) dataTape - diff --git a/Brainfuck/Parser.hs b/Brainfuck/Parser.hs deleted file mode 100644 index 1ea046a..0000000 --- a/Brainfuck/Parser.hs +++ /dev/null @@ -1,62 +0,0 @@ -module Brainfuck.Parser ( - BrainfuckProgram, - BrainCom(..), - - parseBrainfuck - ) where - -import Control.Applicative( some ) -import Text.ParserCombinators.Parsec - - - -type BrainfuckProgram = [BrainCom] - - -data BrainCom = R | L | Inc | Dec | Out | In | OpenLoop | CloseLoop - deriving (Show, Eq) - - - - -parseBrainfuck :: String -> Either ParseError BrainfuckProgram -parseBrainfuck = parse brainfuck "error" - - - - -brainfuck = do - many commentChar - bs <- many fuck - eof - return . concat $ bs - - -fuck = (brainCommand >>= return . (:[])) - <|> loop - <?> "brainfuck command" - - -loop = do - char '[' - many commentChar - bs <- many brainCommand - char ']' - many commentChar - return . concat $ [[OpenLoop],bs,[CloseLoop]] - - -brainCommand = do { b <- brainCom; many commentChar; return b } - - -brainCom = (char '>' >> return R) - <|> (char '<' >> return L) - <|> (char '+' >> return Inc) - <|> (char '-' >> return Dec) - <|> (char '.' >> return Out) - <|> (char ',' >> return In) - <?> "brainfuck command" - - -commentChar = noneOf "><+-.,[]" - diff --git a/Brainfuck/Tape.hs b/Brainfuck/Tape.hs deleted file mode 100644 index 8da4352..0000000 --- a/Brainfuck/Tape.hs +++ /dev/null @@ -1,46 +0,0 @@ -module Brainfuck.Tape ( - Tape, - - shiftLeft, - shiftRight, - currentCell, - applyToCurrentCell - ) where - - -import Control.Monad -import Data.Maybe - - - -type Tape a = ([a], Maybe a, [a]) - - - - -shiftLeft :: Eq a => Tape a -> Tape a -shiftLeft (x,y,z) = - let x' = if (x /= []) then tail x else x - y' = if (x /= []) then Just (head x) else Nothing - z' = if (isJust y) then (fromJust y):z else z - in (x', y', z') - - - -shiftRight :: Eq a => Tape a -> Tape a -shiftRight (x,y,z) = - let x' = if (isJust y) then (fromJust y):x else x - y' = if (z /= []) then Just (head z) else Nothing - z' = if (z /= []) then tail z else z - in (x', y', z') - - - -currentCell :: Tape a -> Maybe a -currentCell (_,c,_) = c - - - -applyToCurrentCell :: (a -> a) -> Tape a -> Tape a -applyToCurrentCell f (x,y,z) = (x, (liftM f) y, z) - |