-import qualified Text.ParserCombinators.ReadP as Read
-import Text.ParserCombinators.ReadP ((<++))
-import qualified Text.Read as Read (lift, readPrec)
-import Debug.Trace
-
-{-------------------------------------------------------------------}
-{- 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 = Read.lift pExpr
- where pExpr :: Read.ReadP Expr
- pExpr = pVar <|> pLit <++ pBinOp
- pBrackets = Read.between (Read.char '(') (Read.char ')')
-
- pVar = Var <$> Read.munch1 isLetter
- pLit = pLit' B <|> pLit' I
- pLit' x = Const . x <$> Read.readS_to_P (readsPrec 10000)
-
- pBinOp = do
- e1 <- pLit <|> pVar
- Read.char ' '
- op <- pOp
- Read.char ' '
- e2 <- pLit <|> pVar
- return (op e1 e2)
-
- pOp = Read.choice
- [ Read.string "==" $> Eq
- , Read.char '+' $> Add
- , Read.char '-' $> Sub
- ]