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