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
21 | Extern String [String]
24 data Expr = Num Double
25 | BinOp BinOpType Expr Expr
30 data BinOpType = Add | Sub | Mul | Cmp Ordering
33 instance Read AST where
34 readPrec = parseFunction +++ parseExtern +++ (Eval <$> readPrec)
35 where parseFunction = do
36 lift $ string "def" >> skipSpaces
37 (name, params) <- parsePrototype
39 Function name params <$> readPrec
41 lift $ string "extern" >> skipSpaces
42 uncurry Extern <$> parsePrototype
43 parsePrototype = lift $ do
44 name <- munch1 isAlpha
45 params <- between (char '(') (char ')') $
46 sepBy (munch1 isAlpha) skipSpaces
49 instance Read Expr where
50 readPrec = choice [ parseParens
58 , parseBinOp ">" (Cmp GT)
59 , parseBinOp "<" (Cmp LT)
60 , parseBinOp "==" (Cmp EQ)
62 where parseParens = step $ lift $
63 between (char '(') (char ')') (readS_to_P reads)
64 parseNum = Num <$> readPrec
65 parseVar = Var <$> lift (munch1 isAlpha)
67 func <- lift (munch1 isAlpha)
68 params <- lift $ between (char '(') (char ')') $
69 sepBy (readS_to_P reads)
70 (skipSpaces >> char ',' >> skipSpaces)
71 return (Call func params)
72 parseBinOp s typ = step $ do
73 a <- prec 11 readPrec -- set recursion limit of 11
78 BinOp typ a <$> readPrec
88 thenE <- step readPrec
93 elseE <- step readPrec
94 return (If cond thenE elseE)