module AST where import Data.Char import Text.Read import Text.ParserCombinators.ReadP hiding ((+++), choice) newtype Program = Program [AST] deriving Show instance Read Program where readPrec = fmap Program $ lift $ sepBy1 (readS_to_P reads) $ do skipSpaces char ';' skipSpaces data AST = Function String [String] Expr | Eval Expr deriving Show data Expr = Num Float | BinOp BinOpType Expr Expr | Var String | Call String [Expr] | If Expr Expr Expr deriving Show data BinOpType = Add | Sub | Mul | Cmp Ordering deriving Show instance Read AST where readPrec = parseFunction +++ (Eval <$> readPrec) where parseFunction = lift $ do skipSpaces string "def" skipSpaces name <- munch1 isAlpha params <- between (char '(') (char ')') $ sepBy (munch1 isAlpha) skipSpaces skipSpaces body <- readS_to_P reads return (Function name params body) instance Read Expr where readPrec = choice [ parseNum , parseVar , parseCall , parseIf , parseBinOp "+" Add , parseBinOp "-" Sub , parseBinOp "*" Mul , parseBinOp ">" (Cmp GT) , parseBinOp "<" (Cmp LT) , parseBinOp "==" (Cmp EQ) ] where parseNum = Num <$> readPrec parseVar = Var <$> lift (munch1 isAlpha) parseCall = do func <- lift (munch1 isAlpha) params <- lift $ between (char '(') (char ')') $ sepBy (readS_to_P reads) (skipSpaces >> char ',' >> skipSpaces) return (Call func params) parseBinOp s typ = step $ do a <- prec 11 readPrec lift $ do skipSpaces string s skipSpaces b <- readPrec return (BinOp typ a b) parseIf = do lift $ do string "if" skipSpaces cond <- step readPrec lift $ do skipSpaces string "then" skipSpaces thenE <- step readPrec lift $ do skipSpaces string "else" skipSpaces elseE <- step readPrec return (If cond thenE elseE)