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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
module Parser where
import Ast
import Data.Maybe (isJust)
import Lexer
import Text.Parsec
import qualified Text.Parsec.Expr as E
import Text.Parsec.String (Parser)
binary s f assoc =
E.Infix
( reservedOp s
>> do
pos <- getPosition
return $ BinOp f pos
)
assoc
opTable =
[ [binary "=" Assign E.AssocLeft],
[ binary "*" Mul E.AssocLeft,
binary "/" Div E.AssocLeft
],
[ binary "+" Plus E.AssocLeft,
binary "-" Minus E.AssocLeft
]
]
expr :: Parser Expr
expr = E.buildExpressionParser opTable factor
number :: Parser Expr
number = do
pos <- getPosition
n <- integer
return $ Num n pos
true :: Parser Expr
true = do
pos <- getPosition
reserved "true"
return $ Bool' True pos
false :: Parser Expr
false = do
pos <- getPosition
reserved "false"
return $ Bool' False pos
variable :: Parser Expr
variable = do
pos <- getPosition
var <- identifier
return $ Variable var pos
typ :: Parser Type
typ = do
p <- identifier
return $ Type p
typFn :: Parser Type
typFn = do
p <- parens $ commaSep typ
r <- optionMaybe $ do
reserved "->"
typ
return $ FuncType p r
type' :: Parser Type
type' = do
try typFn
<|> typ <?> "type"
-- argument
arg :: Parser (String, Type, Bool, SourcePos)
arg = do
pos <- getPosition
i <- identifier
_ <- colonSep <?> "\":\" before type"
t <- type' <?> "type"
return $ (i, t, True, pos)
-- function definition (common to def and lambda)
fdef :: Ident -> Bool -> Bool -> SourcePos -> Parser Expr
fdef ident priv anon pos = do
args <- parens $ commaSep arg
rtyp <-
optionMaybe
( do
_ <- colonSep <?> "\":\" before type"
rtyp <- type' <?> "return type"
return $ rtyp
)
body <-
braces $
many $
do
x <- fStatement
pure $ [x]
<|> grVar True
return $ Func ident args rtyp (concat $ body) priv anon pos
function :: Bool -> Parser Expr
function priv = do
pos <- getPosition
reserved "def"
ident <- identifier
fdef ident priv False pos
-- ident: type = value
varWithValue :: Bool -> Parser Expr
varWithValue priv = do
(ident, typ, _, pos) <- arg
reservedOp "=" <?> "assignation"
value <- expr
return $ Var ident typ value priv pos
-- group variable declaration
grVar :: Bool -> Parser [Expr]
grVar priv = do
reserved "var"
xs <- parens $ commaSep $ varWithValue priv
reservedOp ";"
return $ xs
-- variable declaration
var :: Bool -> Parser Expr
var priv = do
reserved "var"
x <- varWithValue priv
reservedOp ";"
return $ x
-- private definition
privateDf :: (Bool -> Parser Expr) -> Parser Expr
privateDf f = do
priv <- optionMaybe $ reserved "private"
f (isJust priv)
-- private group definition
privateDfn :: (Bool -> Parser [Expr]) -> Parser [Expr]
privateDfn f = do
priv <- optionMaybe $ reserved "private"
f (isJust priv)
lambdaId :: SourcePos -> Ident
lambdaId s =
"lambda" ++ "@" ++ show (sourceLine s) ++ "," ++ show (sourceColumn s)
lambda :: Parser Expr
lambda = do
pos <- getPosition
fdef (lambdaId pos) True True pos
return' :: Parser Expr
return' = do
pos <- getPosition
reserved "return"
value <- optionMaybe expr
reservedOp ";"
return $ Return value pos
call :: Parser Expr
call = do
pos <- getPosition
ident <- try lambda <|> variable
args <- parens $ commaSep expr
return $ Call ident args pos
factor :: Parser Expr
factor =
number
<|> true
<|> false
<|> try call
<|> try lambda
<|> try variable
<|> parens expr
exprStmt :: Parser Expr
exprStmt = do
e <- expr <|> factor
reservedOp ";"
return $ e
-- statements that appear in functions
fStatement :: Parser Expr
fStatement = try exprStmt <|> var True <|> return'
-- top level statement
statement :: Parser Expr
statement =
try exprStmt <|> try (privateDf var)
<|> return' -- this will raise an error
module' :: Parser Expr
module' = do
pos <- getPosition
reserved "module"
ident <- identifier
return $ Module ident pos
program :: Parser [Expr]
program = do
m <- module'
n <-
many $
do
x <- try (privateDf function) <|> statement
pure $ [x]
<|> privateDfn grVar
return $ [m] ++ (concat $ n)
parse :: Parser [Expr]
parse = program
parseFromFile p fname = do
input <- readFile fname
return (runParser p () fname input)
|
