X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=AST.hs;h=ae18a52347ce91c37336a06f891bae690ba691ec;hb=0d4ed473c520786af90ab70dac51451ea2b8b941;hp=5b22ea6c662714d483f1dd1ec51755e5f4b7dc7a;hpb=0d60a0af6b11db89bee6ee8377be3d3f0aae715e;p=kaleidoscope-hs.git diff --git a/AST.hs b/AST.hs index 5b22ea6..ae18a52 100644 --- a/AST.hs +++ b/AST.hs @@ -1,32 +1,75 @@ module AST where +import Data.Char import Text.Read import Text.ParserCombinators.ReadP hiding ((+++), choice) -data Expr = Num Float +data Expr = Num Double + | Var String | BinOp BinOp Expr Expr + | Call String [Expr] + | If Expr Expr Expr deriving Show data BinOp = Add | Sub | Mul | Cmp Ordering deriving Show instance Read Expr where - readPrec = choice [ parseNum + readPrec = parens $ choice [ parseNum + , parseVar + , parseCall + , parseIf , parseBinOp "<" 10 (Cmp LT) + , parseBinOp ">" 10 (Cmp GT) + , parseBinOp "==" 10 (Cmp EQ) , parseBinOp "+" 20 Add , parseBinOp "-" 20 Sub , parseBinOp "*" 40 Mul ] where parseNum = Num <$> readPrec - -- use 'prec 1' and 'step' so that parsing 'a' - -- can only go one step deep, to prevent ininfite - -- recursion + parseVar = Var <$> lift (munch1 isAlpha) parseBinOp s prc op = prec prc $ do a <- step readPrec - lift $ do - skipSpaces - string s - skipSpaces + spaced $ string s b <- readPrec return (BinOp op a b) + parseCall = do + func <- lift (munch1 isAlpha) + params <- lift $ between (char '(') (char ')') $ + sepBy (readS_to_P reads) + (skipSpaces >> char ',' >> skipSpaces) + return (Call func params) + parseIf = do + spaced $ string "if" + cond <- readPrec + spaced $ string "then" + thenE <- readPrec + spaced $ string "else" + elseE <- readPrec + return (If cond thenE elseE) + spaced f = lift $ skipSpaces >> f >> skipSpaces +data Prototype = Prototype String [String] + deriving Show + +instance Read Prototype where + readPrec = lift $ do + name <- munch1 isAlpha + params <- between (char '(') (char ')') $ + sepBy (munch1 isAlpha) skipSpaces + return (Prototype name params) + +data AST = Function Prototype Expr + | Extern Prototype + | TopLevelExpr Expr + deriving Show + +instance Read AST where + readPrec = parseFunction +++ parseExtern +++ parseTopLevel + where parseFunction = do + lift $ string "def" >> skipSpaces + Function <$> readPrec <*> readPrec + parseExtern = do + lift $ string "extern" >> skipSpaces + Extern <$> readPrec + parseTopLevel = TopLevelExpr <$> readPrec