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