Предаване на трето домашно (brainfuck interpreter) (#42)

* Add brainfuck interpreter implementation

* Improve usage info

11 files changed, 196 insertions, 0 deletions

diff --git a/homework/81248/brainfsck/.gitignore b/homework/81248/brainfsck/.gitignore
new file mode 100644
index 0000000..0064636
--- /dev/null
+++ b/homework/81248/brainfsck/.gitignore
@@ -0,0 +1,3 @@
+.stack-work/
+brainfsck.cabal
+*~
diff --git a/homework/81248/brainfsck/README.md b/homework/81248/brainfsck/README.md
new file mode 100644
index 0000000..c6b1f9a
--- /dev/null
+++ b/homework/81248/brainfsck/README.md
@@ -0,0 +1,8 @@
+# brainfsck
+
+To run the interpreter, start `brainfsck` with one argument - the path to a brainfuck script.
+
+i.e.
+```
+stack run brainfsck -- asdf.bf
+```
diff --git a/homework/81248/brainfsck/Setup.hs b/homework/81248/brainfsck/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/homework/81248/brainfsck/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/homework/81248/brainfsck/app/Main.hs b/homework/81248/brainfsck/app/Main.hs
new file mode 100644
index 0000000..de56a4f
--- /dev/null
+++ b/homework/81248/brainfsck/app/Main.hs
@@ -0,0 +1,21 @@
+module Main 
+    ( main
+    ) where
+
+import qualified Data.ByteString as BS
+
+import           System.Environment
+
+import           Brainfsck.Eval  (eval)
+import           Brainfsck.Parse (parse)
+
+main :: IO ()
+main = do
+    xs <- getArgs
+    if length xs /= 1
+    then putStrLn usage
+    else either fail eval . parse =<< BS.readFile (head xs)
+
+usage :: String
+usage = "Usage: Start brainfsck with one argument - the path to a brainfuck script.\n\
+         \> stack run brainfsck -- asdf.bf"
diff --git a/homework/81248/brainfsck/asdf.bf b/homework/81248/brainfsck/asdf.bf
new file mode 100644
index 0000000..d71248a
--- /dev/null
+++ b/homework/81248/brainfsck/asdf.bf
@@ -0,0 +1,2 @@
+>++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.
diff --git a/homework/81248/brainfsck/package.yaml b/homework/81248/brainfsck/package.yaml
new file mode 100644
index 0000000..1db06fd
--- /dev/null
+++ b/homework/81248/brainfsck/package.yaml
@@ -0,0 +1,32 @@
+name:                brainfsck
+version:             0.0.0.1
+author:              "Georgi Lyubenov"
+maintainer:          "godzbanebane@gmail.com"
+
+extra-source-files:
+- README.md
+
+description:         brainfsck!
+
+dependencies:
+- base >= 4.7 && < 5
+- attoparsec
+- bytestring
+
+ghc-options:
+- -Werror
+- -Wall
+
+library:
+  source-dirs: src
+
+executables:
+  brainfsck:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - brainfsck
diff --git a/homework/81248/brainfsck/src/Brainfsck/Eval.hs b/homework/81248/brainfsck/src/Brainfsck/Eval.hs
new file mode 100644
index 0000000..10ffb75
--- /dev/null
+++ b/homework/81248/brainfsck/src/Brainfsck/Eval.hs
@@ -0,0 +1,35 @@
+{-# OPTIONS -fno-warn-incomplete-patterns #-}
+
+module Brainfsck.Eval
+    ( eval
+    ) where
+
+import           Control.Monad (void, foldM)
+
+import           Data.Char (chr, ord)
+
+import           Brainfsck.Types
+
+(?) :: (a -> b -> c) -> b -> a -> c
+(?) = flip
+
+-- We know we never reach [], because we only call this with infinite tapes.
+operTape :: Expr -> Tape -> IO Tape
+operTape GoRight   (Tape ls x (r:rs)) = pure $ Tape (x:ls) r rs
+operTape GoLeft    (Tape (l:ls) x rs) = pure $ Tape ls l (x:rs)
+operTape Incr      (Tape ls x rs)     = pure $ Tape ls (succ x) rs
+operTape Decr      (Tape ls x rs)     = pure $ Tape ls (pred x) rs
+operTape Out       t@(Tape _  x _)    = t <$ do putChar $ chr x
+operTape In        (Tape ls _ rs)     = (Tape ls ? rs) . ord <$> getChar
+operTape l@(Loop xs) t@(Tape _ x _)   =
+    if x == 0 then pure t
+              else do
+        tn@(Tape _ x' _) <- evalTape xs t
+        if x' /= 0 then operTape l tn
+                   else pure tn
+
+evalTape :: [Expr] -> Tape -> IO Tape
+evalTape xs t = foldM (flip operTape) t xs
+
+eval :: [Expr] -> IO ()
+eval xs = void $ evalTape xs initialTape
diff --git a/homework/81248/brainfsck/src/Brainfsck/Parse.hs b/homework/81248/brainfsck/src/Brainfsck/Parse.hs
new file mode 100644
index 0000000..1a9625d
--- /dev/null
+++ b/homework/81248/brainfsck/src/Brainfsck/Parse.hs
@@ -0,0 +1,60 @@
+module Brainfsck.Parse
+    ( parse
+    , ps
+    ) where
+
+import           Prelude hiding (takeWhile)
+
+import           Data.Functor  (($>))
+import           Data.Either   (fromRight)
+import           Data.Foldable (asum)
+
+import           Data.ByteString (ByteString)
+
+import           Data.Attoparsec.ByteString.Char8 hiding (parse)
+
+import           Brainfsck.Types
+expr :: Parser Expr
+expr = asum
+    [ goRight
+    , goLeft
+    , incr
+    , decr
+    , out
+    , inp
+    , loop
+    ]
+
+eatComments :: Parser ()
+eatComments = takeWhile (\x -> x `notElem` ("><+-,.[]" :: String)) $> ()
+
+comments :: Parser a -> Parser a
+comments p = eatComments *> p <* eatComments
+
+goRight :: Parser Expr
+goRight = comments $ char '>' $> GoRight
+
+goLeft :: Parser Expr
+goLeft = comments $ char '<' $> GoLeft
+
+incr :: Parser Expr
+incr = comments $ char '+' $> Incr
+
+decr :: Parser Expr
+decr = comments $ char '-' $> Decr
+
+out :: Parser Expr
+out = comments $ char '.' $> Out
+
+inp :: Parser Expr
+inp = comments $ char ',' $> In
+
+loop :: Parser Expr
+loop = comments $ Loop <$>
+    (char '[' *> comments (many' expr) <* char ']')
+
+parse :: ByteString -> Either String [Expr]
+parse = parseOnly (many' expr <* endOfInput)
+
+ps :: ByteString -> [Expr]
+ps = fromRight [] . parse
diff --git a/homework/81248/brainfsck/src/Brainfsck/Types.hs b/homework/81248/brainfsck/src/Brainfsck/Types.hs
new file mode 100644
index 0000000..6195a24
--- /dev/null
+++ b/homework/81248/brainfsck/src/Brainfsck/Types.hs
@@ -0,0 +1,28 @@
+module Brainfsck.Types
+    ( Expr(..)
+    , Tape(..)
+    , initialTape
+    ) where
+
+data Expr
+    = GoRight -- increment the data pointer (to point to the next cell to the right).
+    | GoLeft  -- decrement the data pointer (to point to the next cell to the left).
+    | Incr    -- increment (increase by one) the byte at the data pointer.
+    | Decr    -- decrement (decrease by one) the byte at the data pointer.
+    | Out     -- output the byte at the data pointer.
+    | In      -- accept one byte of input, storing its value in the byte at the data pointer.
+    | Loop [Expr]
+    deriving (Show, Eq)
+
+-- if the byte at the data pointer is zero, then instead of moving the instruction pointer forward to the next command, jump it forward to the command after the matching ] command.
+-- if the byte at the data pointer is nonzero, then instead of moving the instruction pointer forward to the next command, jump it back to the command after the matching [ command.
+
+data Tape = Tape
+    { left  :: [Int]
+    , head  :: Int
+    , right :: [Int]
+    }
+    deriving (Show, Eq)
+
+initialTape :: Tape
+initialTape = Tape (repeat 0) 0 $ repeat 0
diff --git a/homework/81248/brainfsck/stack.yaml b/homework/81248/brainfsck/stack.yaml
new file mode 100644
index 0000000..21f2284
--- /dev/null
+++ b/homework/81248/brainfsck/stack.yaml
@@ -0,0 +1,4 @@
+resolver: 12.13
+
+packages:
+- .
diff --git a/homework/81248/stack.yaml b/homework/81248/stack.yaml
index ed8960d..035a96b 100644
--- a/homework/81248/stack.yaml
+++ b/homework/81248/stack.yaml
@@ -3,6 +3,7 @@ resolver: lts-12.13
 packages:
 - ./clex
 - ./cToHtml
+- ./brainfsck
 
 extra-deps:
 - bytestring-arbitrary-0.1.2