X-Git-Url: http://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=AST.hs;fp=AST.hs;h=b019a2a2078f91c18a5046f63e10676f2c40d5aa;hp=9ff555a74d10c6d970fc8b7df0a37c1d98fdbffc;hb=705b0b8458673edb7273e6e19914390a55e51d23;hpb=7b8ef6725099f09b81f8c39ca6f00dec14213bed diff --git a/AST.hs b/AST.hs index 9ff555a..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 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,6 +19,8 @@ instance Read Expr where readPrec = parens $ choice [ parseNum , parseVar , parseCall + , parseIf + , parseFor , parseBinOp "<" 10 (Cmp LT) , parseBinOp ">" 10 (Cmp GT) , parseBinOp "==" 10 (Cmp EQ) @@ -28,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 @@ -40,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