packages feed

brainheck (empty) → 0.1.0.0

raw patch · 8 files changed

+200/−0 lines, 8 filesdep +basedep +brainheckdep +containerssetup-changed

Dependencies added: base, brainheck, containers, lens, megaparsec, mtl, optparse-applicative, primitive, recursion-schemes, text, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Vanessa McHale (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Vanessa McHale nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# Brainheck intrepreter++This is a brainh\*ck interpreter written in Haskell. It's intended to be as+abstruse as possible and as such makes use of recursion schemes, lenses, and+monadic parser combinators.++## Installation++## Examples
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Brainheck.Exec.Opt++main :: IO ()+main = exec
+ brainheck.cabal view
@@ -0,0 +1,54 @@+name:                brainheck+version:             0.1.0.0+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+license:             BSD3+license-file:        LICENSE+author:              Vanessa McHale+maintainer:          tmchale@wisc.edu+copyright:           Copyright: (c) 2016 Vanessa McHale+category:            Web+build-type:          Simple+extra-source-files:  README.md+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+                     , containers+  default-language:    Haskell2010+  default-extensions:  DeriveFunctor+                     , DeriveFoldable+                     , DeriveTraversable++executable brainheck+  hs-source-dirs:      app+  main-is:             Main.hs+  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+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/vmchale/brainheck
+ src/Brainheck.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE TypeFamilies    #-}++module Brainheck+    ( run+    , parseBrainheck+    ) 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.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++data Syntax a = Loop (Syntax a)+              | Seq [Syntax a]+              | Token Char 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 ++toAction :: Char -> St ()+toAction = maybe (error mempty) id . flip M.lookup keys+    where keys = M.fromList [ ('.', displayChar)+                            , (',', readChar)+                            , ('+', modifyVal (+1))+                            , ('-', modifyVal (subtract 1))+                            , ('>', modifyState _2 (+1))+                            , ('<', modifyState _2 (subtract 1))+                            ]++brainheck :: Parser (Syntax Char)+brainheck = Seq <$> many (action <|> loop)+    where loop = Loop <$> between (char '[') (char ']') brainheck+          action = Seq . (fmap Token) <$> (some . oneOf) "+-.,<>"++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++run :: (Syntax Char) -> IO ()+run parsed = fst <$> runStateT (cata algebra parsed) initial++parseBrainheck :: T.Text -> Either (ParseError (Token T.Text) Dec) (Syntax Char)+parseBrainheck = (parse (brainheck) "") . (T.filter (`elem` "[]+-.,<>"))
+ src/Brainheck/Exec/Opt.hs view
@@ -0,0 +1,20 @@+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
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"