haskell-brainfuck (empty) → 0.1.0.0

raw patch · 9 files changed

+628/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, haskell-brainfuck, mtl, parsec, tasty, tasty-quickcheck

Files

• LICENSE +21/−0
• README.md +43/−0
• Setup.hs +2/−0
• haskell-brainfuck.cabal +62/−0
• src/HaskBF/Eval.hs +193/−0
• src/HaskBF/Parser.hs +85/−0
• src/HaskBF/Tape.hs +115/−0
• src/Main.hs +76/−0
• tests/test.hs +31/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) <year> <copyright holders>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,43 @@+# haskell-brainfuck++Interpreter for the+[brainfuck programming language](http://www.muppetlabs.com/~breadbox/bf/)++[![Build Status](https://api.travis-ci.org/paraseba/haskell-brainfuck.svg?branch=master)](https://travis-ci.org/paraseba/haskell-brainfuck)++haskel-brainfuck is distributed as a library, but it also includes an executable+to run brainfuck programs. You can find haskell-brainfuck in+[Hackage](https://hackage.haskell.org/package/haskell-brainfuck-0.1.0.0)++## Usage+### Library+```haskell+import HaskBF.Eval+import qualified Data.ByteString.Lazy as BS+import Control.Monad.State++main = do+  -- The following will evaluate the file using stdin and stdout for I/O.+  -- Evaluation results in an EvalResult++  file <- BS.readFile "/path/to/file.bf"+  (EvalSuccess _) <- evalBS defaultIOMachine file+  print "ok"+++  -- The following will evaluate the file using the State monad and input+  -- provided by input++  let input  = []+      output = []+      result = execState (evalStr simulatorMachine "+.>-.") (SimState input output)+  print $ simStateOutput result == [1, -1]+```++### Executable+```bash+brainfuck fib.bf+```++## Documentation+http://paraseba.github.io/haskell-brainfuck/

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,62 @@+name:                haskell-brainfuck+version:             0.1.0.0++synopsis: BrainFuck interpreter++description: BrainFuck language interpreter.+             Provides a library for evaluation and an executable to evaluate+             brainfuck files. Evaluation happens under an arbitrary monad so+             programn can be evaluated doing I/O to stdin/stdout or in memory+             using the State monad.++license:             MIT+license-file:        LICENSE++author:              Sebastian Galkin <paraseba@gmail.com>+maintainer:          Sebastian Galkin <paraseba@gmail.com>++copyright: (c) 2014 Sebastian Galkin++category:            Language+build-type:          Simple+extra-source-files: README.md++cabal-version:       >=1.10++source-repository head+  type: git+  location: https://github.com/paraseba/haskell-brainfuck++library+    exposed-modules:+      HaskBF.Parser, HaskBF.Tape, HaskBF.Eval+    hs-source-dirs: src/+    build-depends:        base >=4.7 && <4.8+                         ,bytestring==0.10.4.0+                         ,parsec==3.1.5+                         ,mtl==2.1.3.1+    default-extensions: TupleSections+    default-language: Haskell2010+    ghc-options: -Wall -fwarn-tabs -fno-warn-unused-do-bind -fno-warn-deprecated-flags+                 -funbox-strict-fields++executable brainfuck+  main-is: src/Main.hs+  build-depends:         base >=4.7 && <4.8+                       , bytestring==0.10.4.0+                       , haskell-brainfuck+  default-language:    Haskell2010+++Test-Suite test+  type: exitcode-stdio-1.0+  main-is: test.hs+  default-language: Haskell2010+  hs-source-dirs: tests+  build-depends:   base >=4.7 && <4.8+                 , haskell-brainfuck+                 , bytestring==0.10.4.0+                 , mtl==2.1.3.1+                 , tasty==0.8.1.3+                 , tasty-quickcheck==0.8.1+                 , QuickCheck==2.7.5

@@ -0,0 +1,193 @@+{- |+Module      : HaskBF.Eval+Description : Evaluate a BrainFuck program+Copyright   : (c) Sebastian Galkin, 2014+License     : MIT+Maintainer  : paraseba@gmail.com+Stability   : experimental++This module exports functions that allow to evaluate a BrainFuck program.+Evaluation supports two types of error, parsing and execution, by returning+instances of 'EvalResult'++This module should be all library users need to import.+-}++module HaskBF.Eval (+    eval, evalBS, evalStr+  , EvalResult (..)+  , Machine (..)+  , defaultIOMachine+  , simulatorMachine, SimState (SimState), simStateOutput+  , emptyState++  , module HaskBF.Tape+  , module HaskBF.Parser+) where++import Data.Int+  ( Int8 )++import Control.Monad+  ( liftM, when )++import Control.Monad.State+  ( State, modify, state, StateT ( StateT ), execStateT, get)++import Control.Monad.Error+  ( ErrorT ( ErrorT ), runErrorT )++import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString.Lazy.Char8 as BSC++import qualified HaskBF.Parser as P++import HaskBF.Parser+  ( ParseError )++import HaskBF.Tape+  ( Tape ( Tape ), blankTape, BFTape, BFExError, errMsg+  , errTape, rTape, wTape, left, right, inc, dec)++type ExecutionState m = StateT BFTape (ErrorT BFExError m)++{- | Underlying input output for the evaluation machine. Changing the monad 'm'+ - achives different results. For instance using the 'IO' monad an evaluator can+ - be created that does input/output to stdin/stdout. If the monad is 'State',+ - for instance, input/output can happen in memory.+ -+ - We offer two implementations of 'Machine':+ -+ -   * 'defaultIOMachine': under the 'IO' monad, does input/output using the+ -   standard streams+ -   * 'simulatorMachine': under the 'State' monad, does input/output on lists+ -+ - It's easy to create other 'Machine's by using different monads and+ - functions. -}+data Machine m =+  Machine { putByte :: Int8 -> m () -- ^ Write a byte to the output, under+                                    -- monad 'm'+          , getByte :: m Int8       -- ^ Get a byte under the 'm' monad+          }++evalTape :: Monad m+         => Machine m+         -> P.Program+         -> ExecutionState m ()+evalTape m = mapM_ (evalOp m)+++{- | Evaluate a parsed BrainFuck program using I/O provided by the given+ - 'Machine'+ -+ - The result is either an execution error or the 'BFTape' representing the+ - resulting state of the tape after the last instruction was executed. -}+eval :: Monad m+     => Machine m                    -- ^ The machine used to do I/O+     -> P.Program                    -- ^ The program to evaluate+     -> m (Either BFExError BFTape)  -- ^ Resulting tape after evaluation or+                                     -- execution error+eval m p = runErrorT $ execStateT (evalTape m p) blankTape++-- | Evaluation result of an unparsed BrainFuck program+data EvalResult = EvalSuccess BFTape+                  {- ^ Parsing and evaluation were successful. The resulting+                   - state of the tape after the last instruction+                   - was executed. -}++                | EvalExecError BFExError+                  {- ^ The program was parsed successfully but evaluation+                   - failed.+                   - The reason for failure is overflowing a limit of the tape.+                   - The state of the tape before the error is included -}++                | EvalParseError ParseError+                  {- ^ The program can not be parsed. Parsing error message is+                   - included -}++{- | Evaluate an unparsed BrainFuck program using I/O provided by the given+ - 'Machine'+ -+ - The result is returned as an 'EvalResult' -}+evalBS :: Monad m+       => Machine m     -- ^ The machine used to do I/O+       -> BS.ByteString -- ^ The code to evaluate+       -> m EvalResult  -- ^ Parsing/evaluation result+evalBS machine program =+  either parseError evaluate . P.parseProgram $ program+  where parseError = return . EvalParseError+        evaluate = liftM (either EvalExecError EvalSuccess) . eval machine++{- | Evaluate an unparsed BrainFuck program using I/O provided by the given+ - 'Machine'+ -+ - The result is returned as an 'EvalResult' -}+evalStr :: Monad m+        => Machine m    -- ^ The machine used to do I/O+        -> String       -- ^ The code to evaluate+        -> m EvalResult -- ^ Parsing/evaluation result+evalStr m = evalBS m . BSC.pack++evolve :: Monad m+          => (BFTape -> m (Either BFExError BFTape))+          -> ExecutionState m ()+evolve g = StateT $ ErrorT . (>>= return . liftM ((),)) . g++evalOp :: Monad m+       => Machine m+       -> P.Op+       -> ExecutionState m ()++evalOp _ P.IncP = evolve $ return . right+evalOp _ P.DecP = evolve $ return . left+evalOp _ P.Inc  = evolve $ return . Right . inc+evalOp _ P.Dec  = evolve $ return . Right . dec++evalOp ( Machine { putByte = putB } ) P.PutByte =+  evolve $ \ tape -> liftM ( const ( Right tape ) ) $ ( putB . rTape ) tape++evalOp ( Machine {getByte = getB } ) P.GetByte =+  evolve $ \ tape -> liftM ( Right . flip wTape tape ) getB++evalOp machine (P.Loop ops) = do+  tape <- get+  when (rTape tape /= 0) $+    evalTape machine ops >> evalOp machine (P.Loop ops)+++{- | A 'Machine' that can evaluate code under the 'IO' monad by doing I/O+ - to stdin/stout.+ -+ - Bytes are read by comnverting them from the ASCII code -}+defaultIOMachine :: Machine IO+defaultIOMachine = Machine (putChar . toEnum . fromIntegral)+                           (fmap (fromIntegral . fromEnum) getChar)++{- | State used by 'simulatorMachine' to evaluate code under the 'State' monad+ -+ - It maintains input and output bytes inside lists -}+data SimState =+  SimState {input :: [Int8], -- ^ Input bytes to use when the program+                             -- does @ "," @+            output :: [Int8] -- ^ Store for the program outputs done with+                             -- @ "." @+           }++-- | Extract the output stream from a 'simulatorMachine' state+simStateOutput :: SimState -> [Int8]+simStateOutput = reverse . output++-- | Initial 'simulatorMachine' state+emptyState :: SimState+emptyState = SimState [] []++{- | A 'Machine' that can evaluate program doing in-memory I/O under the 'State'+ - monad. It stores state as 'SimState' -}+simulatorMachine :: Machine (State SimState)+simulatorMachine =+  Machine (modify . writeByte)+          (state readByte)+  where writeByte byte s@(SimState {output = o} ) = s {output = byte : o}+        readByte s@(SimState {input = (byte : rest)}) = (byte, s {input = rest})+        readByte _ = error "Not enough input available"+

@@ -0,0 +1,85 @@+{-# OPTIONS_HADDOCK show-extensions #-}++{- |+Module      : HaskBF.Parser+Description : Parse brainfuck program into a Program abstract datatype+Copyright   : (c) Sebastian Galkin, 2014+License     : MIT+Maintainer  : paraseba@gmail.com+Stability   : experimental++-}++module HaskBF.Parser (+       Program+     , Op (..)+     , parseProgram+     , module Text.Parsec.Error+     ) where++import Text.Parsec.Prim+  ( (<|>), runP, skipMany )++import Text.Parsec.Combinator+  ( between, sepEndBy, eof )++import Text.Parsec.Error+  ( ParseError )++import Text.Parsec.ByteString.Lazy+  ( Parser )++import Text.Parsec.Char+  ( space, spaces, char )++import Control.Applicative+  ( (<*), (<$>) )++import qualified Data.ByteString.Lazy as BS++-- | Brainfuck operations+data Op+  = IncP      -- ^ Increment the byte pointer: @ ">" @+  | DecP      -- ^ Decrement the byte pointer: @ "<" @+  | Inc       -- ^ Increment the byte pointed by the pointer: @ "+" @+  | Dec       -- ^ Decrement the byte pointed by the pointer: @ "-" @+  | PutByte   -- ^ Write the byte pointed by the pointer (side-effect): @ "." @+  | GetByte   -- ^ Read a byte, write at the current location+              -- (side-effect): @ "," @+  | Loop [Op] -- ^ Loop over 'Op's untill current @ == 0 @: @ "[...]" @+  deriving (Show, Eq)++-- | A program is a list of 'Op's. One possible 'Op' is a 'Loop' of other 'Op's+type Program = [Op]++program :: Parser Program+program = do+  skipMany space+  sepEndBy operation spaces++fullProgram :: Parser Program+fullProgram = program <* eof++operation :: Parser Op+operation = simpleOp <|> loop++simpleChar :: Parser Char+simpleChar = (char '>') <|> (char '<') <|> (char '+') <|>+             (char '-') <|> (char '.') <|> (char ',')++simpleOp :: Parser Op+simpleOp = fmap build simpleChar+  where build '>' = IncP+        build '<' = DecP+        build '+' = Inc+        build '-' = Dec+        build '.' = PutByte+        build ',' = GetByte+        build _   = error "Unknown character" -- this should never happen++loop :: Parser Op+loop = Loop <$> between (char '[') (char ']') program++-- | Parse program stream. Returns an error or the parsed 'Program'+parseProgram :: BS.ByteString -> Either ParseError Program+parseProgram = runP fullProgram () ""

@@ -0,0 +1,115 @@+{-# LANGUAGE FlexibleInstances #-}++{- |+Module      : HaskBF.Tape+Description : Implement the brainfuck tape+Copyright   : (c) Sebastian Galkin, 2014+License     : MIT+Maintainer  : paraseba@gmail.com+Stability   : experimental++Provides a type and operations to implement the brainfuck tape. The tape has+the concept of a pointer, and the pointer can be incremented or decremented.++-}++module HaskBF.Tape (+  Tape (Tape)+  , ExecutionError (errMsg, errTape)+  , rTape, wTape+  , inc, dec+  , right, left+  , BFExError+  , BFTape+  , blankTape+) where++import Data.Int+  ( Int8 )+import Control.Monad.Error+  ( Error, strMsg )++{- | Brainfuck tape. Constructor arguments correspond to+ -+ -   1. left of the current pointer+ -   2. current pointed value+ -   3. right of the current pointer+ -+ - The left part of the tape is reversed, so the first element of the list+ - is the rightmost position. The right list is normal order, its first element+ - is the leftmost one. -}+data Tape t = Tape [t] t [t]+  deriving (Show)++-- | Write element to the current position in the tape+wTape :: t      -- ^ The element to write+      -> Tape t -- ^ The tape+      -> Tape t -- ^ The modified tape+wTape b (Tape l _ r) = Tape l b r++-- | Read the pointed element+rTape :: Tape t -- ^ The tape+      -> t      -- ^ The element currently pointed by the pointer+rTape (Tape _ current _) = current++update :: (t -> t) -> Tape t -> Tape t+update f t = wTape (f $ rTape t) t++-- | Increment the currently pointed element+inc :: Num a+    => Tape a -- ^ The tape+    -> Tape a -- ^ The tape with the current position incremented+inc = update (+ 1)++-- | Decrement the currently pointed element+dec :: Num a+    => Tape a -- ^ The tape+    -> Tape a -- ^ The tape with the current position decremented+dec = update (+ (- 1))++{- | Type for execution errors, trying to move the tape beyond one of its+ - ends. The 'String' argument is the error message and the 'Tape' is in+ - the state right before the faulting operation -}+data ExecutionError a = ExecutionError {errMsg :: String, errTape :: Tape a}++-- | Move the pinter to the right+right :: Tape a  -- ^ The tape+      -> Either (ExecutionError a) (Tape a)+      {- ^ A new tape with its pointer pointing to the+       - element to the right of the pointer in the+       - original tape; or an execution error if the+       - tape to the right is exhausted -}+right t@(Tape _ _ []) =+  Left $ ExecutionError "Error trying to go right on an empty tape" t++right (Tape l c (r : rs)) = Right $ Tape (c : l) r rs++-- | Move the pinter to the left+left :: Tape a  -- ^ The tape+     -> Either (ExecutionError a) (Tape a)+     {- ^ A new tape with its pointer pointing to+      - the element to the left of the pointer in+      - the original tape; or an execution error if+      - the tape to the left is exhausted -}+left t@(Tape [] _ _) =+  Left $ ExecutionError "Error trying to go left on an empty tape" t++left (Tape (l : ls) c r) = Right $ Tape ls l (c : r)++constTape :: t -> Tape t+constTape b = Tape [] b (repeat b)++-- | Execution error type for basic Brainfuck tapes+type BFExError = ExecutionError Int8++-- | Brainfuck tapes type+type BFTape = Tape Int8++instance Error BFExError where+  strMsg s = ExecutionError s (Tape [] 0 [])++{- | A @(0 :: 'Int8')@ initialized, infinite 'Tape' pointing to its+ - leftmost position. An attemp to move the pointer left will result+ - in an error -}+blankTape :: BFTape+blankTape = constTape 0

@@ -0,0 +1,76 @@+{- |+Module      : Main+Description : Evaluate a BrainFuck program+Copyright   : (c) Sebastian Galkin, 2014+License     : MIT+Maintainer  : paraseba@gmail.com+Stability   : experimental++Usage:++> brainfuck path/to/program.bf++It will parse the program and evaluate it by doing I/O to the console. In case+of parsing or execution errors it reports them to stderr++-}++module Main(main) where++import HaskBF.Eval+  ( evalBS, EvalResult ( EvalSuccess, EvalExecError, EvalParseError )+  , defaultIOMachine, BFExError, Tape ( Tape ), BFTape, errMsg, errTape, rTape )++import System.Exit+  ( ExitCode (..), exitWith )++import System.Environment+  ( getArgs, getProgName )++import qualified Data.ByteString.Lazy as BS++main :: IO ExitCode+main =+  getProgram                >>=+    BS.readFile             >>=+    evalBS defaultIOMachine >>=+    reportResults           >>=+    exitWith++{- | Read command line and obtain the path to the program. Display error message+ - if missing argument -}+getProgram :: IO FilePath+getProgram = do+  args <- getArgs+  if length args /= 1+    then do+           exe <- getProgName+           error $ "Usage: " ++ exe ++ " filepath"+    else return $ head args++-- | Report result of program parsing and evaluation+reportResults :: EvalResult -> IO ExitCode++reportResults (EvalSuccess _) = return ExitSuccess++reportResults (EvalParseError parseError) = do+  putStrLn "Error parsing program:"+  print parseError+  return $ ExitFailure 1++reportResults (EvalExecError err) = do+  putStrLn $ "Error evaluating program: " ++ errMsg err+  putStrLn $ "Current tape value: " ++ (show . rTape . errTape) err+  putStrLn $ "Consumed tape: " ++ (showConsumed . errTape) err+  return $ ExitFailure 2++{- | Use heuristic to display tape state. It estimates consumed right tape by+ - calling 'consumed' -}+showConsumed :: BFTape -> String+showConsumed (Tape _ _ r) =+  "[" ++ concatMap ( (++ ",") . show ) (consumed r ++ [0, 0, 0]) ++ "..."++-- | Return consumed tape by assuming that it is unused after 10 zeros.+consumed :: (Eq a, Num a) => [a] -> [a]+consumed (0 : 0 : 0 : 0 : 0 : 0 : 0 : 0 : 0 : 0 : _) = []+consumed (x : xs) = x : consumed xs

@@ -0,0 +1,31 @@++{-main :: IO ()-}+{-main = do-}+  {-Test.Parser.tests-}++import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.QuickCheck (Testable)++import Data.List+import Data.Ord++import qualified Test.Parser+import qualified Test.Tape+import qualified Test.Eval++main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [properties]++properties :: TestTree+properties = testGroup "Properties" qcProps++mkGroup :: Testable prop => TestName -> [(TestName, prop)] -> TestTree+mkGroup name tests = testGroup name $ map (uncurry QC.testProperty) tests++qcProps = [mkGroup "Parser" Test.Parser.properties+          ,mkGroup "Tape"   Test.Tape.properties+          ,mkGroup "Eval"   Test.Eval.properties+          ]