AST.hs

   1 module AST where
   2
   3 import Data.Char
   4 import Text.Read
   5 import Text.ParserCombinators.ReadP hiding ((+++), choice)
   6
   7 newtype Program = Program [AST]
   8   deriving Show
   9
  10 instance Read Program where
  11   readPrec = fmap Program $ lift $ sepBy1 (readPrec_to_P readPrec 0) $ do
  12     skipSpaces
  13     char ';'
  14     skipSpaces
  15
  16 data AST = Function String [String] Expr
  17          | Eval Expr
  18   deriving Show
  19 data Expr = Num Float
  20           | BinOp BinOpType Expr Expr
  21           | Var String
  22           | Call String [Expr]
  23   deriving Show
  24 data BinOpType = Add | Sub | Mul
  25   deriving Show
  26
  27 instance Read AST where
  28   readPrec = parseFunction +++ (Eval <$> readPrec)
  29     where parseFunction = lift $ do
  30             skipSpaces
  31             string "def"
  32             skipSpaces
  33             name <- munch1 isAlpha
  34             params <- between (char '(') (char ')') $
  35                       sepBy (munch1 isAlpha) skipSpaces
  36             skipSpaces
  37             body <- readS_to_P reads
  38             return (Function name params body)
  39
  40 instance Read Expr where
  41   readPrec = choice [ parseNum
  42                     , parseVar
  43                     , parseCall
  44                     , parseBinOp '+' Add
  45                     , parseBinOp '-' Sub
  46                     , parseBinOp '*' Mul
  47                     ]
  48     where parseNum = Num <$> readPrec
  49           parseVar = Var <$> lift (munch1 isAlpha)
  50           parseCall = do
  51             func <- lift (munch1 isAlpha)
  52             params <- lift $ between (char '(') (char ')') $
  53                         sepBy (readS_to_P reads)
  54                               (skipSpaces >> char ',' >> skipSpaces)
  55             return (Call func params)
  56           parseBinOp c typ = step $ do
  57             a <- prec 11 readPrec
  58             lift $ do
  59               skipSpaces
  60               char c
  61               skipSpaces
  62             b <- readPrec
  63             return (BinOp typ a b)