X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs-old.git;a=blobdiff_plain;f=AST.hs;h=99b6d42a23b9af254c8767ac969accc8248f03bb;hp=73523d6d4c8a37cef977d5614d355aaac13756af;hb=749e5a29af22fc74b8c597485de9be6485ccc62f;hpb=fd502ca628b539cffbc38c21755ebaa615b30b72 diff --git a/AST.hs b/AST.hs index 73523d6..99b6d42 100644 --- a/AST.hs +++ b/AST.hs @@ -8,15 +8,20 @@ newtype Program = Program [AST] deriving Show instance Read Program where - readPrec = fmap Program $ lift $ sepBy1 (readS_to_P reads) $ 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] @@ -26,17 +31,20 @@ 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 [ parseParens @@ -62,13 +70,12 @@ instance Read Expr where (skipSpaces >> char ',' >> skipSpaces) return (Call func params) parseBinOp s typ = step $ do - a <- prec 11 readPrec + a <- prec 11 readPrec -- set recursion limit of 11 lift $ do skipSpaces string s skipSpaces - b <- readPrec - return (BinOp typ a b) + BinOp typ a <$> readPrec parseIf = do lift $ do string "if"