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