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 AST = Function String [String] Expr
   8          | Eval Expr
   9   deriving Show
  10 data Expr = Num Float
  11           | BinOp BinOpType Expr Expr
  12           | Var String
  13           | Call String [Expr]
  14   deriving Show
  15 data BinOpType = Add | Sub | Mul
  16   deriving Show
  17
  18 instance Read AST where
  19   readPrec = parseFunction +++ (Eval <$> readPrec)
  20     where parseFunction = lift $ do
  21             skipSpaces
  22             string "def"
  23             skipSpaces
  24             name <- munch1 isAlpha
  25             params <- between (char '(') (char ')') $
  26                       sepBy (munch1 isAlpha) skipSpaces
  27             skipSpaces
  28             body <- between (char '{') (char '}') $
  29                       readS_to_P reads
  30             skipSpaces
  31             return (Function name params body)
  32
  33 instance Read Expr where
  34   readPrec = choice [ parseNum
  35                     , parseVar
  36                     , parseCall
  37                     , parseBinOp '+' Add
  38                     , parseBinOp '-' Sub
  39                     , parseBinOp '*' Mul
  40                     ]
  41     where parseNum = Num <$> readPrec
  42           parseVar = Var <$> lift (munch1 isAlpha)
  43           parseCall = do
  44             func <- lift (munch1 isAlpha)
  45             params <- lift $ between (char '(') (char ')') $
  46                         sepBy (readS_to_P reads)
  47                               (skipSpaces >> char ',' >> skipSpaces)
  48             return (Call func params)
  49           parseBinOp c typ = step $ do
  50             a <- prec 11 readPrec
  51             lift $ do
  52               skipSpaces
  53               char c
  54               skipSpaces
  55             b <- readPrec
  56             return (BinOp typ a b)