AST.hs

   1 module AST where
   2
   3 import Data.Char
   4 import Text.Read
   5 import Text.ParserCombinators.ReadP hiding ((+++), (<++), choice)
   6
   7 data Expr = Num Double
   8           | Var String
   9           | BinOp BinOp Expr Expr
  10           | Call String [Expr]
  11           | If Expr Expr Expr
  12           | For String Expr Expr (Maybe Expr) Expr
  13   deriving Show
  14
  15 data BinOp = Add | Sub | Mul | Cmp Ordering
  16   deriving Show
  17
  18 instance Read Expr where
  19   readPrec = parens $ choice [ parseNum
  20                              , parseVar
  21                              , parseCall
  22                              , parseIf
  23                              , parseFor
  24                              , parseBinOp "<" 10 (Cmp LT)
  25                              , parseBinOp ">" 10 (Cmp GT)
  26                              , parseBinOp "==" 10 (Cmp EQ)
  27                              , parseBinOp "+" 20 Add
  28                              , parseBinOp "-" 20 Sub
  29                              , parseBinOp "*" 40 Mul
  30                              ]
  31     where parseNum = Num <$> readPrec
  32           parseVar = Var <$> lift (munch1 isAlpha)
  33           parseBinOp s prc op = prec prc $ do
  34             a <- step readPrec
  35             spaced $ string s
  36             b <- readPrec
  37             return (BinOp op a b)
  38           parseCall = do
  39             func <- lift (munch1 isAlpha)
  40             params <- lift $ between (char '(') (char ')') $
  41                         sepBy (readS_to_P reads)
  42                               (skipSpaces >> char ',' >> skipSpaces)
  43             return (Call func params)
  44           parseIf = do
  45             spaced $ string "if"
  46             cond <- readPrec
  47             spaced $ string "then"
  48             thenE <- readPrec
  49             spaced $ string "else"
  50             elseE <- readPrec
  51             return (If cond thenE elseE)
  52           parseFor = do
  53             spaced $ string "for"
  54             identifier <- lift (munch1 isAlpha)
  55             spaced $ char '='
  56             start <- readPrec
  57             spaced $ char ','
  58             cond <- readPrec
  59             stp <- (spaced (char ',') >> Just <$> step readPrec)
  60                      <++ pure Nothing
  61             spaced $ string "in"
  62             body <- readPrec
  63             return (For identifier start cond stp body)
  64           spaced f = lift $ skipSpaces >> f >> skipSpaces
  65
  66 data Prototype = Prototype String [String]
  67   deriving Show
  68
  69 instance Read Prototype where
  70   readPrec = lift $ do
  71     name <- munch1 isAlpha
  72     params <- between (char '(') (char ')') $
  73                 sepBy (munch1 isAlpha) skipSpaces
  74     return (Prototype name params)
  75
  76 data AST = Function Prototype Expr
  77          | Extern Prototype
  78          | TopLevelExpr Expr
  79   deriving Show
  80
  81 instance Read AST where
  82   readPrec = parseFunction +++ parseExtern +++ parseTopLevel
  83     where parseFunction = do
  84             lift $ string "def" >> skipSpaces
  85             Function <$> readPrec <*> readPrec
  86           parseExtern = do
  87             lift $ string "extern" >> skipSpaces
  88             Extern <$> readPrec
  89           parseTopLevel = TopLevelExpr <$> readPrec