examples/evaluator/ArithParser.hs

   1 module ArithParser where
   2
   3 import Control.Monad
   4
   5 import ArithTypes
   6
   7 import Foreign
   8
   9 import Text.ParserCombinators.Parsec
  10 import qualified Text.ParserCombinators.Parsec.Token as P
  11 import Text.ParserCombinators.Parsec.Language
  12 import Text.ParserCombinators.Parsec.Expr
  13
  14 lexer :: P.TokenParser ()
  15 lexer  = P.makeTokenParser
  16          (haskellStyle
  17          { reservedOpNames = ["*","/","+","-"]
  18          })
  19
  20 statement :: Parser Stmt
  21 statement = do s <- statement'
  22                eof
  23                return s
  24
  25 statement' :: Parser Stmt
  26 statement' = try((do [i] <- identifier
  27                      if i < 'a' || i > 'z'
  28                        then fail "character a-z expected"
  29                        else return ()
  30                      symbol ":="
  31                      e <- expr
  32                      return $ Assign i e) <?> "assignment")
  33             <|> liftM Cmd cmd
  34             <|> liftM Print expr
  35
  36 cmd :: Parser Cmd
  37 cmd = try (do symbol ":help"
  38               return Help)
  39       <|> try (do symbol ":verbose"
  40                   return Verbose)
  41       <|> (do symbol ":quit"
  42               return Quit)
  43
  44 expr    :: Parser Exp
  45 expr    = buildExpressionParser table factor
  46         <?> "expression"
  47
  48 table   = [[op "*" Mul AssocLeft, op "/" Div AssocLeft]
  49           ,[op "+" Add AssocLeft, op "-" Sub AssocLeft]
  50           ]
  51         where
  52           op s f assoc
  53              = Infix (do{ reservedOp s; return f} <?> "operator") assoc
  54
  55 factor  =   parens expr
  56         <|> liftM (Lit . fromInteger) natural
  57         <|> (do [i] <- identifier
  58                 if i < 'a' || i > 'z'
  59                    then fail "character a-z expected"
  60                    else return ()
  61                 return $ Var i)
  62         <?> "simple expression"
  63
  64 whiteSpace= P.whiteSpace lexer
  65 lexeme    = P.lexeme lexer
  66 symbol    = P.symbol lexer
  67 natural   = P.natural lexer
  68 parens    = P.parens lexer
  69 semi      = P.semi lexer
  70 identifier= P.identifier lexer
  71 reserved  = P.reserved lexer
  72 reservedOp= P.reservedOp lexer
  73