summaryrefslogtreecommitdiff
path: root/Brainfuck
diff options
context:
space:
mode:
authorJed Barber <jjbarber@y7mail.com>2014-04-10 05:25:03 +1000
committerJed Barber <jjbarber@y7mail.com>2014-04-10 05:25:03 +1000
commit281425310c5db21f87981eeb9601a71d1974d98d (patch)
treebef4643d906c93622c311fef2cf758fe94f1f651 /Brainfuck
parente8695600977769008f285f9958eb043cca1b9b29 (diff)
Rearranging files
Diffstat (limited to 'Brainfuck')
-rw-r--r--Brainfuck/Interpreter.hs70
-rw-r--r--Brainfuck/Parser.hs62
-rw-r--r--Brainfuck/Tape.hs46
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)
-