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   deriving Show
  13
  14 data BinOp = Add | Sub | Mul | Cmp Ordering
  15   deriving Show
  16
  17 instance Read Expr where
  18   readPrec = parens $ choice [ parseNum
  19                              , parseVar
  20                              , parseCall
  21                              , parseIf
  22                              , parseBinOp "<" 10 (Cmp LT)
  23                              , parseBinOp ">" 10 (Cmp GT)
  24                              , parseBinOp "==" 10 (Cmp EQ)
  25                              , parseBinOp "+" 20 Add
  26                              , parseBinOp "-" 20 Sub
  27                              , parseBinOp "*" 40 Mul
  28                              ]
  29     where parseNum = Num <$> readPrec
  30           parseVar = Var <$> lift (munch1 isAlpha)
  31           parseBinOp s prc op = prec prc $ do
  32             a <- step readPrec
  33             lift $ do
  34               skipSpaces
  35               string s
  36               skipSpaces
  37             b <- readPrec
  38             return (BinOp op a b)
  39           parseCall = do
  40             func <- lift (munch1 isAlpha)
  41             params <- lift $ between (char '(') (char ')') $
  42                         sepBy (readS_to_P reads)
  43                               (skipSpaces >> char ',' >> skipSpaces)
  44             return (Call func params)
  45           parseIf = do
  46             lift $ skipSpaces >> string "if" >> skipSpaces
  47             cond <- readPrec
  48             lift $ skipSpaces >> string "then" >> skipSpaces
  49             thenE <- readPrec
  50             lift $ skipSpaces >> string "else" >> skipSpaces
  51             elseE <- readPrec
  52             return (If cond thenE elseE)
  53
  54 data Prototype = Prototype String [String]
  55   deriving Show
  56
  57 instance Read Prototype where
  58   readPrec = lift $ do
  59     name <- munch1 isAlpha
  60     params <- between (char '(') (char ')') $
  61                 sepBy (munch1 isAlpha) skipSpaces
  62     return (Prototype name params)
  63
  64 data AST = Function Prototype Expr
  65          | Extern Prototype
  66          | TopLevelExpr Expr
  67   deriving Show
  68
  69 instance Read AST where
  70   readPrec = parseFunction +++ parseExtern +++ parseTopLevel
  71     where parseFunction = do
  72             lift $ string "def" >> skipSpaces
  73             Function <$> readPrec <*> readPrec
  74           parseExtern = do
  75             lift $ string "extern" >> skipSpaces
  76             Extern <$> readPrec
  77           parseTopLevel = TopLevelExpr <$> readPrec