1 {-# LANGUAGE TemplateHaskell #-}
3 ( module Symantic.Parser.Grammar
4 --, module Symantic.Parser.Staging
5 , module Symantic.Parser
7 import Symantic.Parser.Grammar
8 import qualified Symantic.Parser.Staging as Hask
10 --import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred, repeat)
12 -- import Data.Char (Char)
13 import Prelude (undefined)
14 import Data.String (String)
15 import Text.Show (Show)
17 -- import Control.Monad (liftM)
18 -- import Data.Char (isAlpha, isAlphaNum, isSpace, isUpper, isDigit, digitToInt, chr, ord)
19 -- import Data.Set (fromList, member)
20 -- import Data.Maybe (catMaybes)
21 -- import Text.Read (readMaybe)
22 import Language.Haskell.TH (TExpQ)
24 import qualified Prelude
38 data Expr = Var String | Num Int | Add Expr Expr deriving Show
39 data Asgn = Asgn String Expr deriving Show
41 data BrainFuckOp = RightPointer | LeftPointer | Increment | Decrement | Output | Input | Loop [BrainFuckOp] deriving (Show, Eq)
44 cinput = m --try (string "aaa") <|> string "db" --(string "aab" <|> string "aac") --(char 'a' <|> char 'b') *> string "ab"
46 --m = match "ab" (lookAhead item) op empty
47 --op 'a' = item $> runtime "aaaaa"
48 --op 'b' = item $> runtime "bbbbb"
50 -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
51 bf = match [char '>'] item op empty
52 op (Hask.Runtime '>' _) = string ">"
55 --defuncTest = runtime Just <$> (runtime (+) <$> (item $> runtime 1) <*> (item $> runtime 8))
57 -- manyTest = many (string "ab" $> (runtime 'c'))
59 --nfb = negLook (char 'a') <|> void (string "ab")
61 --skipManyInspect = skipMany (char 'a')
63 boom :: Applicable repr => repr ()
65 let foo = (-- newRegister_ unit (\r0 ->
66 let goo = (-- newRegister_ unit (\r1 ->
67 let hoo = {-get r0 <~> get r1 *>-} goo *> hoo in hoo
69 in goo) *> pure Hask.unit
72 runtime :: a -> TExpQ a -> Hask.Runtime a
73 runtime e c = Hask.Runtime (Hask.Eval e) (Hask.Code c)
85 brainfuck = whitespace *> bf
87 whitespace = skipMany (noneOf "<>+-[],.$")
88 lexeme :: repr a -> repr a
89 lexeme p = p <* whitespace
90 -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
91 bf :: repr [BrainFuckOp]
92 bf = many (lexeme (match ((\c -> runtime c [||c||]) Prelude.<$> "><+-.,[") (look item) op empty))
93 -- op :: Pure repr Char -> repr BrainFuckOp
94 op (Hask.Runtime (Hask.Eval c) _) = case c of
95 '>' -> item $> runtime RightPointer [||RightPointer||]
96 '<' -> item $> runtime LeftPointer [||LeftPointer||]
97 '+' -> item $> runtime Increment [||Increment||]
98 '-' -> item $> runtime Decrement [||Decrement||]
99 '.' -> item $> runtime Output [||Output||]
100 ',' -> item $> runtime Input [||Input||]
101 '[' -> between (lexeme item) (char ']') (runtime Loop [||Loop||] <$> bf)