1. module Parser where
    3. import Text.Parsec
    4. import Text.Parsec.String (Parser)
    6. import qualified Text.Parsec.Expr as Ex
    7. import qualified Text.Parsec.Token as Tok
    9. import Lexer
    10. import Syntax
    12. binary s f assoc = Ex.Infix (reservedOp s >> return (BinOp f)) assoc
    14. table = [[binary "*" Times Ex.AssocLeft,
    15.           binary "/" Divide Ex.AssocLeft]
    16.         ,[binary "+" Plus Ex.AssocLeft,
    17.           binary "-" Minus Ex.AssocLeft]]
    19. int :: Parser Expr
    20. int = do
    21.   n <- integer
    22.   return $ Float (fromInteger n)
    24. floating :: Parser Expr
    25. floating = do
    27.   return $ Float n
    29. expr :: Parser Expr
    31. variable :: Parser Expr
    32. variable = do
    33.   var <- identifier
    34.   return $ Var var
    36. function :: Parser Expr
    37. function = do
    38.   reserved "def"
    39.   name <- identifier
    40.   args <- parens $ many variable
    41.   body <- expr
    42.   return $ Function name args body
    44. extern :: Parser Expr
    45. extern = do
    46.   reserved "extern"
    47.   name <- identifier
    48.   args <- parens $ many variable
    49.   return $ Extern name args
    51. call :: Parser Expr
    52. call = do
    53.   name <- identifier
    54.   args <- parens $ commaSep expr
    55.   return $ Call name args
    57. factor :: Parser Expr
    58. factor = try floating
    59.       <|> try extern
    60.       <|> try function
    61.       <|> try call
    62.       <|> variable
    63.       <|> parens expr
    65. defn :: Parser Expr
    66. defn = try extern
    67.     <|> try function
    68.     <|> expr
    70. contents :: Parser a -> Parser a
    71. contents p = do
    72.   Tok.whiteSpace lexer
    73.   r <- p
    74.   eof
    75.   return r
    77. toplevel :: Parser [Expr]
    78. toplevel = many $ do
    79.     def <- defn
    80.     reservedOp ";"
    81.     return def
    83. parseExpr :: String -> Either ParseError Expr
    84. parseExpr s = parse (contents expr) "<stdin>" s
    87. parseToplevel s = parse (contents toplevel) "<stdin>" s