X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs-old.git;a=blobdiff_plain;f=AST.hs;h=99b6d42a23b9af254c8767ac969accc8248f03bb;hp=1965ae6ba8378bc8277b2b46fe031ea04a64a5d5;hb=749e5a29af22fc74b8c597485de9be6485ccc62f;hpb=808a6ae35fb1f2ff61a84991af1e7722298a4d62 diff --git a/AST.hs b/AST.hs index 1965ae6..99b6d42 100644 --- a/AST.hs +++ b/AST.hs @@ -8,44 +8,60 @@ newtype Program = Program [AST] deriving Show instance Read Program where - readPrec = fmap Program $ lift $ sepBy1 (readPrec_to_P readPrec 0) $ do + readPrec = fmap Program $ lift $ do + asts <- sepBy1 (readS_to_P reads) $ do skipSpaces char ';' skipSpaces + optional $ char ';' + skipSpaces + return asts data AST = Function String [String] Expr + | Extern String [String] | Eval Expr deriving Show -data Expr = Num Float +data Expr = Num Double | BinOp BinOpType Expr Expr | Var String | Call String [Expr] + | If Expr Expr Expr deriving Show -data BinOpType = Add | Sub | Mul +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 + readPrec = parseFunction +++ parseExtern +++ (Eval <$> readPrec) + where parseFunction = do + lift $ string "def" >> skipSpaces + (name, params) <- parsePrototype + lift skipSpaces + Function name params <$> readPrec + parseExtern = do + lift $ string "extern" >> skipSpaces + uncurry Extern <$> parsePrototype + parsePrototype = lift $ do name <- munch1 isAlpha params <- between (char '(') (char ')') $ sepBy (munch1 isAlpha) skipSpaces - skipSpaces - body <- readS_to_P reads - return (Function name params body) + return (name, params) instance Read Expr where - readPrec = choice [ parseNum + readPrec = choice [ parseParens + , parseNum , parseVar , parseCall - , parseBinOp '+' Add - , parseBinOp '-' Sub - , parseBinOp '*' Mul + , parseIf + , parseBinOp "+" Add + , parseBinOp "-" Sub + , parseBinOp "*" Mul + , parseBinOp ">" (Cmp GT) + , parseBinOp "<" (Cmp LT) + , parseBinOp "==" (Cmp EQ) ] - where parseNum = Num <$> readPrec + where parseParens = step $ lift $ + between (char '(') (char ')') (readS_to_P reads) + parseNum = Num <$> readPrec parseVar = Var <$> lift (munch1 isAlpha) parseCall = do func <- lift (munch1 isAlpha) @@ -53,11 +69,26 @@ instance Read Expr where sepBy (readS_to_P reads) (skipSpaces >> char ',' >> skipSpaces) return (Call func params) - parseBinOp c typ = step $ do - a <- prec 11 readPrec + parseBinOp s typ = step $ do + a <- prec 11 readPrec -- set recursion limit of 11 + lift $ do + skipSpaces + string s + skipSpaces + BinOp typ a <$> readPrec + parseIf = do + lift $ do + string "if" + skipSpaces + cond <- step readPrec + lift $ do + skipSpaces + string "then" + skipSpaces + thenE <- step readPrec lift $ do skipSpaces - char c + string "else" skipSpaces - b <- readPrec - return (BinOp typ a b) + elseE <- step readPrec + return (If cond thenE elseE)