Chunk up files

[timetravel.git] / AST.hs

diff --git a/AST.hs b/AST.hs
new file mode 100644 (file)
index 0000000..cf1fc40
--- /dev/null
+++ b/AST.hs
@@ -0,0 +1,84 @@
+module AST where
+
+import Text.ParserCombinators.ReadP
+import Text.Read (readPrec, lift)
+import Data.Char
+import Data.Functor
+
+{-------------------------------------------------------------------}
+{- The pure expression language                                    -}
+{-------------------------------------------------------------------}
+
+data Val = I Int | B Bool
+           deriving Eq
+
+instance Show Val where
+  show (I x) = show x
+  show (B x) = show x
+
+data Expr = Const Val
+     | Add Expr Expr | Sub Expr Expr  | Mul Expr Expr | Div Expr Expr
+     | And Expr Expr | Or Expr Expr | Not Expr
+     | Eq Expr Expr | Gt Expr Expr | Lt Expr Expr
+     | Var String
+   deriving Eq
+
+instance Show Expr where
+  show (Const v) = show v
+  show (Add e1 e2) = show e1 ++ " + " ++ show e2
+  show (Sub e1 e2) = show e1 ++ " - " ++ show e2
+  show (Mul e1 e2) = show e1 ++ " * " ++ show e2
+  show (Div e1 e2) = show e1 ++ " / " ++ show e2
+  show (And e1 e2) = show e1 ++ " & " ++ show e2
+  show (Or e1 e2) = show e1 ++ " | " ++ show e2
+  show (Not e) = "!" ++ show e
+  show (Eq e1 e2) = show e1 ++ " == " ++ show e2
+  show (Gt e1 e2) = show e1 ++ " > " ++ show e2
+  show (Lt e1 e2) = show e1 ++ " < " ++ show e2
+  show (Var s) = s
+
+instance Read Expr where
+  readPrec = lift pExpr
+    where
+      pExpr = pVar +++ pLit +++ pBinOp
+      pBrackets = between (char '(') (char ')')
+
+      pVar = Var <$> munch1 isLetter
+      pLit = pLit' B +++ pLit' I
+      pLit' x = Const . x <$> readS_to_P (readsPrec 10000)
+
+      pBinOp = do
+        -- TODO: figure out how to just use pExpr without getting
+        -- stuck recursively
+        e1 <- pVar +++ pLit +++ pBrackets pBinOp
+        skipSpaces
+        op <- pOp
+        skipSpaces
+        e2 <- pVar +++ pLit +++ pBrackets pBinOp
+        return (op e1 e2)
+
+      pOp = choice
+        [ string "==" $> Eq
+        , char '+' $> Add
+        , char '-' $> Sub
+        , char '*' $> Mul
+        , char '/' $> Div
+        , char '&' $> And
+        , char '|' $> Or
+        , char '>' $> Gt
+        , char '<' $> Lt
+        ]
+
+{-------------------------------------------------------------------}
+{- The statement language                                          -}
+
+
+data Statement = Assign String Expr
+               | If Expr Statement Statement
+               | While Expr Statement
+               | Print Expr
+               | Seq Statement Statement
+               | Try Statement Statement
+               | Pass
+      deriving (Eq, Show)
+