X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=AST.hs;h=b019a2a2078f91c18a5046f63e10676f2c40d5aa;hb=refs%2Fheads%2Ftutorial-3;hp=b57d7cb8cede024a9c2bb0e366d8d066474d331d;hpb=5c4c0171f43b2d66cec3a882cdf2ecd904c83a1a;p=kaleidoscope-hs.git diff --git a/AST.hs b/AST.hs index b57d7cb..b019a2a 100644 --- a/AST.hs +++ b/AST.hs @@ -2,12 +2,14 @@ module AST where import Data.Char import Text.Read -import Text.ParserCombinators.ReadP hiding ((+++), choice) +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 + | For String Expr Expr (Maybe Expr) Expr deriving Show data BinOp = Add | Sub | Mul | Cmp Ordering @@ -17,7 +19,11 @@ instance Read Expr where readPrec = parens $ choice [ parseNum , parseVar , parseCall + , parseIf + , parseFor , parseBinOp "<" 10 (Cmp LT) + , parseBinOp ">" 10 (Cmp GT) + , parseBinOp "==" 10 (Cmp EQ) , parseBinOp "+" 20 Add , parseBinOp "-" 20 Sub , parseBinOp "*" 40 Mul @@ -26,10 +32,7 @@ instance Read Expr where 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 @@ -38,6 +41,27 @@ instance Read Expr where 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) + parseFor = do + spaced $ string "for" + identifier <- lift (munch1 isAlpha) + spaced $ char '=' + start <- readPrec + spaced $ char ',' + cond <- readPrec + stp <- (spaced (char ',') >> Just <$> step readPrec) + <++ pure Nothing + spaced $ string "in" + body <- readPrec + return (For identifier start cond stp body) + spaced f = lift $ skipSpaces >> f >> skipSpaces data Prototype = Prototype String [String] deriving Show