add initial parser
This commit is contained in:
parent
54ea8baa54
commit
5b4118ef8c
|
@ -0,0 +1,85 @@
|
|||
module Parser where
|
||||
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String
|
||||
import Text.Parsec.Expr
|
||||
import qualified Text.Parsec.Token as T
|
||||
import Text.Parsec.Language
|
||||
import AST
|
||||
|
||||
languageDef = emptyDef {T.commentStart="{-",
|
||||
T.commentEnd="-}",
|
||||
T.commentLine="--",
|
||||
T.nestedComments=True,
|
||||
T.identStart = letter <|> char '_',
|
||||
T.identLetter = alphaNum <|> char '_',
|
||||
T.reservedNames = ["do", "end", "(", ")", ";", "."],
|
||||
T.reservedOpNames = ["+", "*"]}
|
||||
|
||||
lexer = T.makeTokenParser languageDef
|
||||
exprparser = buildExpressionParser ops term <?> "expression"
|
||||
ops = [ [Infix (reservedOp "*" >> return Mul) AssocLeft ]
|
||||
, [Infix (reservedOp "+" >> return Add) AssocLeft]
|
||||
]
|
||||
|
||||
identifier = T.identifier lexer -- parses an identifier
|
||||
reserved = T.reserved lexer -- parses a reserved name
|
||||
reservedOp = T.reservedOp lexer -- parses an operator
|
||||
parens = T.parens lexer -- parses surrounding parenthesis
|
||||
integer = T.integer lexer -- parses an integer
|
||||
semi = T.semi lexer -- parses a semicolon
|
||||
whiteSpace = T.whiteSpace lexer -- parses whitespace
|
||||
symbol = T.symbol lexer
|
||||
|
||||
statement =
|
||||
do
|
||||
e <- exprparser
|
||||
-- char ';'
|
||||
return e
|
||||
|
||||
block = do
|
||||
reserved "do"
|
||||
lst <- seqStmt
|
||||
reserved "end"
|
||||
return $ Block lst
|
||||
|
||||
funDef = do
|
||||
name <- identifier
|
||||
reserved "("
|
||||
reserved ")"
|
||||
reserved "->"
|
||||
lst <- exprparser
|
||||
return $ rewriteFun (FunDef name (UnitP, lst))
|
||||
|
||||
-- curry FunDef to a definition of lambdas
|
||||
rewriteFun (FunDef name (pattern, body)) =
|
||||
Def name $ Lambda [(pattern, [body])]
|
||||
|
||||
call = do
|
||||
name <- identifier
|
||||
whiteSpace
|
||||
char '('
|
||||
char ')'
|
||||
whiteSpace
|
||||
return $ Call name [UnitConst]
|
||||
|
||||
term = block
|
||||
<|> try funDef
|
||||
<|> try call
|
||||
<|> parens exprparser
|
||||
<|> fmap Var identifier
|
||||
<|> fmap IntConst integer
|
||||
|
||||
manyExpr = many1 exprparser
|
||||
|
||||
seqStmt = do
|
||||
lst <- sepBy1 statement semi
|
||||
return lst
|
||||
|
||||
program =
|
||||
many1 $ do
|
||||
e <- exprparser
|
||||
reserved "."
|
||||
return e
|
||||
|
||||
parseProgram = parse program "program"
|
Loading…
Reference in New Issue