X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=AST.hs;h=b019a2a2078f91c18a5046f63e10676f2c40d5aa;hb=705b0b8458673edb7273e6e19914390a55e51d23;hp=e491b648a7d45f7bd3b419b0e3ff6a8c215cbd83;hpb=99457827942e4d9ee32ed5b0ea4abed54df5b449;p=kaleidoscope-hs.git diff --git a/AST.hs b/AST.hs index e491b64..b019a2a 100644 --- a/AST.hs +++ b/AST.hs @@ -2,11 +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 @@ -15,7 +18,12 @@ data BinOp = Add | Sub | Mul | Cmp Ordering 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 @@ -24,12 +32,36 @@ 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 + 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) + 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