X-Git-Url: https://git.lukelau.me/?p=kaleidoscope-hs.git;a=blobdiff_plain;f=AST.hs;h=7dad3a19e91eab9f12657101bd224b5c81742d07;hp=5628e7c7cd74c8d0f04d5b4e9c908e245e5696f6;hb=8a66ac4f81c3d1eab3b13a9e58cee0098573eff1;hpb=ae80d076cba678169dbddac4a53edd2cb1e091fb diff --git a/AST.hs b/AST.hs index 5628e7c..7dad3a1 100644 --- a/AST.hs +++ b/AST.hs @@ -1,23 +1,57 @@ module AST where +import Data.Char import Text.Read -import Text.ParserCombinators.ReadP hiding ((+++)) +import Text.ParserCombinators.ReadP hiding ((+++), choice) data Expr = Num Float - | Add Expr Expr + | Var String + | BinOp BinOp Expr Expr + deriving Show + +data BinOp = Add | Sub | Mul | Cmp Ordering deriving Show instance Read Expr where - readPrec = parseNum +++ parseAdd + readPrec = choice [ parseNum + , parseVar + , parseBinOp "<" 10 (Cmp LT) + , parseBinOp "+" 20 Add + , parseBinOp "-" 20 Sub + , parseBinOp "*" 40 Mul + ] where parseNum = Num <$> readPrec - -- use 'prec 1' and 'step' so that parsing 'a' - -- can only go one step deep, to prevent ininfite - -- recursion - parseAdd = prec 1 $ do + parseVar = Var <$> lift (munch1 isAlpha) + parseBinOp s prc op = prec prc $ do a <- step readPrec lift $ do skipSpaces - char '+' + string s skipSpaces b <- readPrec - return (Add a b) + return (BinOp op a b) + +data Prototype = Prototype String [String] + deriving Show + +instance Read Prototype where + readPrec = lift $ do + name <- munch1 isAlpha + params <- between (char '(') (char ')') $ + sepBy (munch1 isAlpha) skipSpaces + return (Prototype name params) + +data AST = Function Prototype Expr + | Extern Prototype + | TopLevelExpr Expr + deriving Show + +instance Read AST where + readPrec = parseFunction +++ parseExtern +++ parseTopLevel + where parseFunction = do + lift $ string "def" >> skipSpaces + Function <$> readPrec <*> readPrec + parseExtern = do + lift $ string "extern" >> skipSpaces + Extern <$> readPrec + parseTopLevel = TopLevelExpr <$> readPrec