diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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! +``` diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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")) diff --git a/bf/helloworld.bf b/bf/helloworld.bf new file mode 100644 --- /dev/null +++ b/bf/helloworld.bf @@ -0,0 +1,2 @@ +>++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>-> ++++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+. diff --git a/brainheck.cabal b/brainheck.cabal --- a/brainheck.cabal +++ b/brainheck.cabal @@ -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 diff --git a/src/Brainheck.hs b/src/Brainheck.hs --- a/src/Brainheck.hs +++ b/src/Brainheck.hs @@ -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` "[]+-.,<>")) diff --git a/src/Brainheck/Exec/Opt.hs b/src/Brainheck/Exec/Opt.hs deleted file mode 100644 --- a/src/Brainheck/Exec/Opt.hs +++ /dev/null @@ -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 diff --git a/stack.yaml b/stack.yaml new file mode 100644 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,6 @@ +resolver: lts-8.8 +packages: +- '.' +extra-deps: [] +flags: {} +extra-package-dbs: [] diff --git a/test/Spec.hs b/test/Spec.hs deleted file mode 100644 --- a/test/Spec.hs +++ /dev/null @@ -1,2 +0,0 @@ -main :: IO () -main = putStrLn "Test suite not yet implemented"