AST.hs

   1 module AST where
   2
   3 import Text.ParserCombinators.ReadP
   4 import Text.Read (readPrec, lift)
   5 import Data.Char
   6 import Data.Functor
   7
   8 {-------------------------------------------------------------------}
   9 {- The pure expression language                                    -}
  10 {-------------------------------------------------------------------}
  11
  12 data Val = I Int | B Bool
  13            deriving Eq
  14
  15 instance Show Val where
  16   show (I x) = show x
  17   show (B x) = show x
  18
  19 data Expr = Const Val
  20      | Add Expr Expr | Sub Expr Expr  | Mul Expr Expr | Div Expr Expr
  21      | And Expr Expr | Or Expr Expr | Not Expr
  22      | Eq Expr Expr | Gt Expr Expr | Lt Expr Expr
  23      | Var String
  24    deriving Eq
  25
  26 instance Show Expr where
  27   show (Const v) = show v
  28   show (Add e1 e2) = show e1 ++ " + " ++ show e2
  29   show (Sub e1 e2) = show e1 ++ " - " ++ show e2
  30   show (Mul e1 e2) = show e1 ++ " * " ++ show e2
  31   show (Div e1 e2) = show e1 ++ " / " ++ show e2
  32   show (And e1 e2) = show e1 ++ " & " ++ show e2
  33   show (Or e1 e2) = show e1 ++ " | " ++ show e2
  34   show (Not e) = "!" ++ show e
  35   show (Eq e1 e2) = show e1 ++ " == " ++ show e2
  36   show (Gt e1 e2) = show e1 ++ " > " ++ show e2
  37   show (Lt e1 e2) = show e1 ++ " < " ++ show e2
  38   show (Var s) = s
  39
  40 instance Read Expr where
  41   readPrec = lift pExpr
  42     where
  43       pExpr = (pLit <++ pVar) +++ pBinOp
  44       pBrackets = between (char '(') (char ')')
  45
  46       pVar = Var <$> munch1 isLetter
  47       pLit = pLit' B +++ pLit' I
  48       pLit' x = Const . x <$> readS_to_P (readsPrec 10000)
  49
  50       pBinOp = do
  51         -- TODO: figure out how to just use pExpr without getting
  52         -- stuck recursively
  53         e1 <- (pLit <++ pVar) +++ pBrackets pBinOp
  54         skipSpaces
  55         op <- pOp
  56         skipSpaces
  57         e2 <- (pLit <++ pVar) +++ pBrackets pBinOp
  58         return (op e1 e2)
  59
  60       pOp = choice
  61         [ string "==" $> Eq
  62         , char '+' $> Add
  63         , char '-' $> Sub
  64         , char '*' $> Mul
  65         , char '/' $> Div
  66         , char '&' $> And
  67         , char '|' $> Or
  68         , char '>' $> Gt
  69         , char '<' $> Lt
  70         ]
  71
  72 {-------------------------------------------------------------------}
  73 {- The statement language                                          -}
  74
  75
  76 data Statement = Assign String Expr
  77                | If Expr Statement Statement
  78                | While Expr Statement
  79                | Print Expr
  80                | Seq Statement Statement
  81                | Try Statement Statement
  82                | Pass
  83       deriving (Eq, Show, Read)
  84