-
Notifications
You must be signed in to change notification settings - Fork 0
/
Parser.hs
132 lines (112 loc) · 2.74 KB
/
Parser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
{-# LANGUAGE OverloadedStrings #-}
module Parser (
parseExpr
) where
import Text.Parsec
import Text.Parsec.Text.Lazy (Parser)
import qualified Text.Parsec.Pos as Pos
import qualified Text.Parsec.Expr as Ex
import qualified Text.Parsec.Token as Tok
import qualified Data.Text.Lazy as L
import Lexer
import Syntax
withPosParser :: Parser a -> Parser (a, SrcLoc)
withPosParser p = do
start <- getPosition
x <- p
end <- getPosition
return (x, SrcLoc start end)
integer :: Parser Integer
integer = Tok.integer lexer
variable :: Parser Expr
variable = do
(x, srcLoc) <- withPosParser identifier
return $ Var srcLoc x
number :: Parser Expr
number = do
(n, srcLoc) <- withPosParser integer
return $ Lit srcLoc (LInt (fromIntegral n))
bool :: Parser Expr
bool = (withPosParser (reserved "True") >>=
\(_, srcLoc) -> return $ Lit srcLoc (LBool True))
<|> (withPosParser (reserved "False") >>=
\(_, srcLoc) -> return $ Lit srcLoc (LBool False))
lambda :: Parser Expr
lambda = do
start <- getPosition
reservedOp "\\"
args <- many identifier
reservedOp "->"
body <- expr
end <- getPosition
let srcLoc = SrcLoc start end
return $ foldr (Lambda srcLoc) body args
letdecl :: Parser Expr
letdecl = do
start <- getPosition
reserved "let"
x <- identifier
args <- many1 identifier
reservedOp "="
e1 <- expr
reserved "in"
e2 <- expr
end <- getPosition
let srcloc = (SrcLoc start end)
return $ Let srcloc x (foldr (Lambda srcloc) e1 args) e2
letin :: Parser Expr
letin = do
start <- getPosition
reserved "let"
x <- identifier
reservedOp "="
e1 <- expr
reserved "in"
e2 <- expr
end <- getPosition
return $ Let (SrcLoc start end) x e1 e2
ifthen :: Parser Expr
ifthen = do
start <- getPosition
reserved "if"
cond <- aexp
reservedOp "then"
tr <- aexp
reserved "else"
fl <- aexp
end <- getPosition
return $ If (SrcLoc start end) cond tr fl
aexp :: Parser Expr
aexp =
parens expr
<|> bool
<|> number
<|> ifthen
<|> try letdecl
<|> try letin
<|> lambda
<|> variable
term :: Parser Expr
term = Ex.buildExpressionParser table aexp
infixOp :: String -> (SrcLoc -> a -> a -> a) -> Ex.Assoc -> Op a
infixOp x f = Ex.Infix $
withPosParser (reservedOp x) >>= (\(_, srcLoc) -> return $ f srcLoc)
table :: Operators Expr
table = [
[
infixOp "*" (Op Mul) Ex.AssocLeft
],
[
infixOp "+" (Op Add) Ex.AssocLeft
, infixOp "-" (Op Sub) Ex.AssocLeft
],
[
infixOp "==" (Op Eql) Ex.AssocLeft
]
]
expr :: Parser Expr
expr = do
(es, srcLoc) <- withPosParser $ many1 term
return (foldl1 (App srcLoc) es)
parseExpr :: L.Text -> Either ParseError Expr
parseExpr input = parse (contents expr) "filename" input