5 import Text.ParserCombinators.ReadP hiding ((+++), choice)
7 newtype Program = Program [AST]
10 instance Read Program where
11 readPrec = fmap Program $ lift $ do
12 asts <- sepBy1 (readS_to_P reads) $ do
20 data AST = Function String [String] Expr
24 | BinOp BinOpType Expr Expr
29 data BinOpType = Add | Sub | Mul | Cmp Ordering
32 instance Read AST where
33 readPrec = parseFunction +++ (Eval <$> readPrec)
34 where parseFunction = lift $ do
38 name <- munch1 isAlpha
39 params <- between (char '(') (char ')') $
40 sepBy (munch1 isAlpha) skipSpaces
42 body <- readS_to_P reads
43 return (Function name params body)
45 instance Read Expr where
46 readPrec = choice [ parseParens
54 , parseBinOp ">" (Cmp GT)
55 , parseBinOp "<" (Cmp LT)
56 , parseBinOp "==" (Cmp EQ)
58 where parseParens = step $ lift $
59 between (char '(') (char ')') (readS_to_P reads)
60 parseNum = Num <$> readPrec
61 parseVar = Var <$> lift (munch1 isAlpha)
63 func <- lift (munch1 isAlpha)
64 params <- lift $ between (char '(') (char ')') $
65 sepBy (readS_to_P reads)
66 (skipSpaces >> char ',' >> skipSpaces)
67 return (Call func params)
68 parseBinOp s typ = step $ do
75 return (BinOp typ a b)
85 thenE <- step readPrec
90 elseE <- step readPrec
91 return (If cond thenE elseE)