module Parser where import Control.Monad (void) import Data.Char (isSpace) import Data.Functor.Identity (Identity) import Text.Parsec import Text.Parsec.Expr import Debug.Trace import Expr type Parser = Parsec String () pLexemeSuffix :: Parser () pLexemeSuffix = eof <|> lookAhead (void (oneOf "()")) <|> void (many1 space) lexeme :: String -> Parser () lexeme s = try $ string s >> pLexemeSuffix operators :: OperatorTable String () Identity Expr operators = [[Prefix (symPrefix "+")] ,[Infix (symInfix "*") AssocLeft] ,[Infix (symInfix "+") AssocLeft ,Infix (symInfix "-") AssocLeft] ,[Infix (symInfix ":≤") AssocNone]] where symInfix :: String -> Parser (Expr -> Expr -> Expr) symInfix name = do lexeme name return (einfix name) symPrefix :: String -> Parser (Expr -> Expr) symPrefix name = do lexeme name return (EPrefix name) pAtom :: Parser Expr pAtom = do e <- pAtom' traceM ("pAtom: " ++ show e) return e pAtom' :: Parser Expr pAtom' = choice [do _ <- char '(' _ <- many space e <- pExpr lexeme ")" return e ,do s <- many1 digit pLexemeSuffix return (ELitInt (read s)) ,do s <- many1 (satisfy (\c -> not (isSpace c) && c `notElem` "(){}")) pLexemeSuffix return (EVar s)] pExpr :: Parser Expr pExpr = buildExpressionParser operators pAtom parseExpr :: Parser Expr parseExpr = do _ <- many space e <- pExpr eof return e