brainheck 0.1.0.0 → 0.1.0.1

raw patch · 8 files changed

+69/−75 lines, 8 filesdep −primitivedep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: primitive

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +17/−0
• app/Main.hs +11/−2
• bf/helloworld.bf +2/−0
• brainheck.cabal +6/−13
• src/Brainheck.hs +27/−38
• src/Brainheck/Exec/Opt.hs +0/−20
• stack.yaml +6/−0
• test/Spec.hs +0/−2

@@ -6,4 +6,21 @@  ## Installation +With [nix](http://nixos.org/nix/):++```bash+ $ nix-env -i brainheck+```++With [stack](https://haskellstack.org/):++```bash+ $ stack install brainheck+```+ ## Examples++```bash+ $ brainheck helloworld.bf+ Hello World!+```

@@ -1,6 +1,15 @@ module Main where -import Brainheck.Exec.Opt+import Brainheck+import Options.Applicative+import qualified Data.Text.IO as TIO+import Data.Monoid +program :: Parser FilePath+program = argument str (metavar "FILE" <> help "Brainfuck file")+ main :: IO ()-main = exec+main = let runFile filepath = either (error . show) id . (parseBrainheck filepath) <$> TIO.readFile filepath >>= run in+    runFile =<< execParser (info (program <**> helper) (fullDesc+        <> progDesc "Brainh*ck - an interpreter"+        <> header "brainheck - a brainfuck intrepreter written in haskell and supporting utf-8"))

@@ -0,0 +1,2 @@+>++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.

@@ -1,5 +1,5 @@ name:                brainheck-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Brainh*ck interpreter in haskell description:         Brainh*ck interpreter written in haskell and taking advantage of many prominent libraries homepage:            https://github.com/vmchale/brainheck#readme@@ -11,18 +11,17 @@ category:            Web build-type:          Simple extra-source-files:  README.md+                   , stack.yaml+                   , bf/helloworld.bf cabal-version:       >=1.10  library   hs-source-dirs:      src   exposed-modules:     Brainheck-                     , Brainheck.Exec.Opt   build-depends:       base >= 4.7 && < 5                      , mtl                      , vector                      , recursion-schemes-                     , optparse-applicative-                     , primitive                      , text                      , lens                      , megaparsec@@ -31,6 +30,7 @@   default-extensions:  DeriveFunctor                      , DeriveFoldable                      , DeriveTraversable+                     , TypeFamilies  executable brainheck   hs-source-dirs:      app@@ -38,15 +38,8 @@   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   build-depends:       base                      , brainheck-  default-language:    Haskell2010--test-suite brainheck-test-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs-  build-depends:       base-                     , brainheck-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+                     , optparse-applicative+                     , text   default-language:    Haskell2010  source-repository head

@@ -1,77 +1,66 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE KindSignatures  #-}-{-# LANGUAGE TypeFamilies    #-}+{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE KindSignatures   #-}+{-# LANGUAGE FlexibleContexts #-} +-- | Module with parser etc.  module Brainheck     ( run     , parseBrainheck+    -- * Types+    , Syntax (..)     ) where  import qualified Data.Vector as V import Control.Monad.State.Lazy import Data.Functor.Foldable import Data.Functor.Foldable.TH-import Text.Megaparsec hiding (State)+import Text.Megaparsec import Text.Megaparsec.Text-import qualified Text.Megaparsec.Lexer as L import qualified Data.Text as T-import Control.Monad.Primitive import Control.Lens import Data.Vector.Lens import qualified Data.Map as M  type St a = StateT IndexArr IO a type IndexArr = (V.Vector Int, Int)--- TODO use mutable vector, e.g. V.MVector (PrimState IO) Int +-- | Syntax tree for brainfuck data Syntax a = Loop (Syntax a)               | Seq [Syntax a]-              | Token Char deriving (Show)+              | Token a deriving (Show)  makeBaseFunctor ''Syntax -initial :: IndexArr-initial = (V.replicate 30000 0, 0)--check :: St Bool-check = get >>= (\(arr,i) -> pure . (==0) . (V.! i) $ arr)--displayChar :: St ()-displayChar = get >>= (\(arr,i) -> liftIO . putChar . toEnum . (V.! i) $ arr)--readChar :: St ()-readChar = get >>= (\(_,i) -> modifyByIndex i . const =<< (liftIO . (fmap fromEnum)) getChar)--modifyState lens = (lens %%=) . (pure .)--modifyByIndex :: Int -> (Int -> Int) -> St ()-modifyByIndex i = modifyState (_1 . sliced i 1) . fmap--modifyVal :: (Int -> Int) -> St ()-modifyVal f = flip modifyByIndex f . snd =<< get -+-- | Map a char to its action in the `St` monad toAction :: Char -> St () toAction = maybe (error mempty) id . flip M.lookup keys-    where keys = M.fromList [ ('.', displayChar)+    where modifyVal f = flip modifyByIndex f . snd =<< get +          modifyByIndex i = modifyState (_1 . sliced i 1 . forced) . fmap+          modifyState lens = (lens %%=) . (pure .)+          readChar = get >>= (\(_,i) -> modifyByIndex i . const =<< (liftIO . (fmap fromEnum)) getChar)+          displayChar = get >>= (\(arr,i) -> liftIO . putChar . toEnum . (V.! i) $ arr)+          keys = M.fromList [ ('.', displayChar)                             , (',', readChar)                             , ('+', modifyVal (+1))                             , ('-', modifyVal (subtract 1))                             , ('>', modifyState _2 (+1))-                            , ('<', modifyState _2 (subtract 1))-                            ]+                            , ('<', modifyState _2 (subtract 1)) ] +-- | Parse to syntax tree brainheck :: Parser (Syntax Char)-brainheck = Seq <$> many (action <|> loop)-    where loop = Loop <$> between (char '[') (char ']') brainheck-          action = Seq . (fmap Token) <$> (some . oneOf) "+-.,<>"+brainheck = Seq <$> many (Seq . (fmap Token) <$> (some . oneOf) "+-.,<>"+    <|> Loop <$> between (char '[') (char ']') brainheck)  algebra :: Base (Syntax Char) (St ()) -> St ()-algebra l@(LoopF x) = check >>= (\bool -> if bool then pure () else x >> algebra l) algebra (TokenF x) = toAction x algebra (SeqF x) = foldr (>>) (pure ()) x+algebra l@(LoopF x) = check >>= (\bool -> if bool then pure () else x >> algebra l)+    where check = get >>= (\(arr,i) -> pure . (==0) . (V.! i) $ arr) +-- | Evaluate syntax tree run :: (Syntax Char) -> IO ()-run parsed = fst <$> runStateT (cata algebra parsed) initial+run parsed = fst <$> runStateT (cata algebra parsed) (V.replicate 30000 0, 0) -parseBrainheck :: T.Text -> Either (ParseError (Token T.Text) Dec) (Syntax Char)-parseBrainheck = (parse (brainheck) "") . (T.filter (`elem` "[]+-.,<>"))+-- | Parse and return an error or a syntax tree+parseBrainheck :: FilePath -> T.Text -> Either (ParseError (Token T.Text) Dec) (Syntax Char)+parseBrainheck filepath = (parse (brainheck) filepath) . (T.filter (`elem` "[]+-.,<>"))

@@ -1,20 +0,0 @@-module Brainheck.Exec.Opt where--import Options.Applicative-import Brainheck-import qualified Data.Text.IO as TIO-import Data.Monoid-import Control.Monad.State.Lazy--data Program = Program { filepath :: FilePath }--program :: Parser Program-program = Program <$> argument str (metavar "FILE" <> help "Brainfuck file")--exec :: IO ()-exec = runFile =<< execParser (info (program <**> helper) (fullDesc-     <> progDesc "Brainh*ck interpreter"-     <> header "brainheck - a brainh*ck intrepreter written in haskell and supporting utf-8"))--runFile :: Program -> IO ()-runFile program = either (error . show) id . parseBrainheck <$> TIO.readFile (filepath program) >>= run

@@ -0,0 +1,6 @@+resolver: lts-8.8+packages:+- '.'+extra-deps: []+flags: {}+extra-package-dbs: []

@@ -1,2 +0,0 @@-main :: IO ()-main = putStrLn "Test suite not yet implemented"