Refactor test framework
[tiger.ml.git] / compiler / src / lib / tiger / tiger_parser.mly
CommitLineData
543d3420 1%{
28875fec
SK
2 module Ast = Tiger_absyn
3 module Sym = Tiger_symbol
4
5 let pos () =
6 Tiger_position.of_lexing_positions
7 ~pos_start:(Parsing.symbol_start_pos ())
8 ~pos_end:(Parsing.symbol_end_pos ())
543d3420
SK
9%}
10
11/* Declarations */
12%token AND
13%token ARRAY
14%token ASSIGN
15%token BREAK
16%token COLON
17%token COMMA
18%token DIVIDE
19%token DO
20%token DOT
21%token ELSE
22%token END
23%token EOF
24%token EQ
25%token FOR
26%token FUNCTION
27%token GE
28%token GT
29%token <string> ID
30%token IF
31%token IN
32%token <int> INT
33%token LBRACE
34%token LBRACK
35%token LE
36%token LET
37%token LPAREN
38%token LT
39%token MINUS
40%token NEQ
41%token NIL
42%token OF
43%token OR
44%token PLUS
45%token RBRACE
46%token RBRACK
47%token RPAREN
48%token SEMICOLON
49%token <string> STRING
50%token THEN
51%token TIMES
52%token TO
53%token TYPE
54%token VAR
55%token WHILE
56
57/* from lowest precedence */
28875fec
SK
58%nonassoc THEN
59%nonassoc ELSE
c7598faf 60%nonassoc ASSIGN
28875fec 61%nonassoc OF DO
543d3420
SK
62%left OR
63%left AND
64%nonassoc EQ NEQ GT LT GE LE
65%left PLUS MINUS
66%left TIMES DIVIDE
28875fec 67%nonassoc HIGHEST
543d3420
SK
68/* to highest precedence */
69
28875fec 70%type <Tiger_absyn.t> program
543d3420
SK
71
72%start program
73
74%%
75
28875fec 76program: exp EOF { $1 };
543d3420
SK
77
78exp:
79 | NIL
28875fec 80 { Ast.NilExp }
543d3420 81 | INT
28875fec
SK
82 { Ast.IntExp $1 }
83 | MINUS exp %prec HIGHEST
84 {
85 Ast.OpExp
86 { left = Ast.IntExp 0
87 ; oper = Ast.MinusOp
88 ; right = $2
89 ; pos = pos ()
90 }
91 }
92 | lvalue LBRACK exp RBRACK OF exp
93 {
94 match $1 with
95 | Ast.SimpleVar {symbol=typ; _} ->
96 Ast.ArrayExp
97 { typ
98 ; size = $3
99 ; init = $6
100 ; pos = pos ()
101 }
102 | Ast.SubscriptVar _ | Ast.FieldVar _ ->
103 raise Parse_error
104 }
105 | ID LBRACE rec_fields_bind RBRACE
543d3420 106 {
ef945634 107 let type_id = $1 in
28875fec
SK
108 let fields = $3 in
109 let typ = Sym.of_string type_id in
110 let pos = pos () in
111 Ast.RecordExp {fields; typ; pos}
543d3420
SK
112 }
113 | lvalue
28875fec 114 { Ast.VarExp $1 }
543d3420
SK
115 | lvalue ASSIGN exp
116 {
28875fec
SK
117 let var = $1 in
118 let exp = $3 in
119 let pos = pos () in
120 Ast.AssignExp {var; exp; pos}
543d3420
SK
121 }
122 | STRING
28875fec 123 { Ast.StringExp {string = $1; pos = pos ()} }
29de275c
SK
124 | ID LPAREN fun_args RPAREN
125 {
28875fec
SK
126 Ast.CallExp
127 { func = Sym.of_string $1
128 ; args = $3
129 ; pos = pos ()
130 }
543d3420 131 }
6a74bf44 132 | exp PLUS exp
543d3420 133 {
28875fec
SK
134 Ast.OpExp
135 { left = $1
136 ; oper = Ast.PlusOp
137 ; right = $3
138 ; pos = pos ()
139 }
6a74bf44
SK
140 }
141 | exp MINUS exp
142 {
28875fec
SK
143 Ast.OpExp
144 { left = $1
145 ; oper = Ast.MinusOp
146 ; right = $3
147 ; pos = pos ()
148 }
6a74bf44
SK
149 }
150 | exp TIMES exp
151 {
28875fec
SK
152 Ast.OpExp
153 { left = $1
154 ; oper = Ast.TimesOp
155 ; right = $3
156 ; pos = pos ()
157 }
6a74bf44
SK
158 }
159 | exp DIVIDE exp
160 {
28875fec
SK
161 Ast.OpExp
162 { left = $1
163 ; oper = Ast.DivideOp
164 ; right = $3
165 ; pos = pos ()
166 }
6a74bf44
SK
167 }
168 | exp EQ exp
169 {
28875fec
SK
170 Ast.OpExp
171 { left = $1
172 ; oper = Ast.EqOp
173 ; right = $3
174 ; pos = pos ()
175 }
6a74bf44
SK
176 }
177 | exp NEQ exp
178 {
28875fec
SK
179 Ast.OpExp
180 { left = $1
181 ; oper = Ast.NeqOp
182 ; right = $3
183 ; pos = pos ()
184 }
6a74bf44
SK
185 }
186 | exp GT exp
187 {
28875fec
SK
188 Ast.OpExp
189 { left = $1
190 ; oper = Ast.GtOp
191 ; right = $3
192 ; pos = pos ()
193 }
6a74bf44
SK
194 }
195 | exp LT exp
196 {
28875fec
SK
197 Ast.OpExp
198 { left = $1
199 ; oper = Ast.LtOp
200 ; right = $3
201 ; pos = pos ()
202 }
6a74bf44
SK
203 }
204 | exp GE exp
205 {
28875fec
SK
206 Ast.OpExp
207 { left = $1
208 ; oper = Ast.GeOp
209 ; right = $3
210 ; pos = pos ()
211 }
6a74bf44
SK
212 }
213 | exp LE exp
214 {
28875fec
SK
215 Ast.OpExp
216 { left = $1
217 ; oper = Ast.LeOp
218 ; right = $3
219 ; pos = pos ()
220 }
6a74bf44
SK
221 }
222 | exp AND exp
223 {
28875fec
SK
224 let e1 = $1 in
225 let e2 = $3 in
226 Ast.IfExp
227 { test = e1
228 ; then' = e2
229 ; else' = Some (Ast.IntExp 0)
230 ; pos = pos ()
231 }
6a74bf44
SK
232 }
233 | exp OR exp
234 {
28875fec
SK
235 let e1 = $1 in
236 let e2 = $3 in
237 Ast.IfExp
238 { test = e1
239 ; then' = Ast.IntExp 1
240 ; else' = Some e2
241 ; pos = pos ()
242 }
543d3420
SK
243 }
244 | IF exp THEN exp ELSE exp
245 {
246 let e1 = $2 in
247 let e2 = $4 in
248 let e3 = $6 in
28875fec
SK
249 Ast.IfExp
250 { test = e1
251 ; then' = e2
252 ; else' = Some e3
253 ; pos = pos ()
254 }
543d3420
SK
255 }
256 | IF exp THEN exp
257 {
28875fec
SK
258 let e1 = $2 in
259 let e2 = $4 in
260 Ast.IfExp
261 { test = e1
262 ; then' = e2
263 ; else' = None
264 ; pos = pos ()
265 }
543d3420
SK
266 }
267 | WHILE exp DO exp
268 {
28875fec
SK
269 let e1 = $2 in
270 let e2 = $4 in
271 Ast.WhileExp
272 { test = e1
273 ; body = e2
274 ; pos = pos ()
275 }
543d3420 276 }
ffff6f35 277 | FOR ID ASSIGN exp TO exp DO exp
543d3420 278 {
28875fec
SK
279 let var = $2 in
280 let e1 = $4 in
281 let e2 = $6 in
282 let e3 = $8 in
283 Ast.ForExp
284 { var = Sym.of_string var
285 ; escape = ref true
286 ; lo = e1
287 ; hi = e2
288 ; body = e3
289 ; pos = pos ()
290 }
543d3420
SK
291 }
292 | BREAK
28875fec 293 { Ast.BreakExp (pos ()) }
e7dfac93 294 | LPAREN exps RPAREN
28875fec 295 { Ast.SeqExp $2 }
e7dfac93 296 | LET decs IN exps END
543d3420
SK
297 {
298 let decs = $2 in
e7dfac93 299 let exps = $4 in
28875fec 300 Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()}
543d3420 301 }
a0db5523 302 ;
543d3420 303
28875fec
SK
304exps:
305 | { [] }
306 | exp { ($1, pos ()) :: [] }
307 | exp SEMICOLON exps { ($1, pos ()) :: $3 }
a0db5523 308 ;
b3c9d54d 309
28875fec
SK
310rec_fields_bind:
311 | ID EQ exp { (Sym.of_string $1, $3, pos ()) :: [] }
312 | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 }
a0db5523 313 ;
543d3420 314
46486dc8
SK
315/* ------------------------------------------------------------------------- */
316/* BEGIN unintuitive rules for decs (which avoid shift/reduce conflicts) */
317/* ------------------------------------------------------------------------- */
318/*
319 In order to support mutual recursion, we need to group consecutive
320 type and function declarations (see Tiger-book pages 97-99).
321
322 Initially, I defined the rules to do so as:
323
324 decs:
325 | dec { $1 :: [] }
326 | dec decs { $1 :: $2 }
327 ;
328 dec:
329 | var_dec { $1 }
330 | typ_decs { Ast.TypeDecs $1 }
331 | fun_decs { Ast.FunDecs $1 }
332 ;
333
334 which, while straightforward (and working, because ocamlyacc defaults to
335 shift in case of a conflict), nonetheless caused a shift/reduce conflict in
336 each of: typ_decs and fun_decs; where the parser did not know whether to
337 shift and stay in (typ|fun_)_dec state or to reduce and get back to dec
338 state.
339
340 Sadly, tagging the rules with a lower precedence (to explicitly favor
341 shifting) - does not help :(
342
343 %nonassoc LOWEST
344 ...
345 dec:
346 | var_dec { $1 }
347 | typ_decs %prec LOWEST { Ast.TypeDecs $1 }
348 | fun_decs %prec LOWEST { Ast.FunDecs $1 }
349 ;
350
351 The difficulty seems to be in the lack of a separator token which would be
352 able to definitively mark the end of each sequence of consecutive
353 (typ_|fun_) declarations.
354
355 Keeping this in mind, another alternative is to manually capture the possible
356 interspersion patterns in the rules like:
357
358 (N * foo) followed-by (N * not-foo)
359
360 for the exception of var_dec, which, since we do not need to group its
361 consecutive sequences, can be reduced upon first sighting.
362*/
363
543d3420 364decs:
46486dc8
SK
365 | var_dec decs_any { $1 :: $2 }
366 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
367 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
368 ;
369
370decs_any:
371 | { [] }
372 | var_dec decs_any { $1 :: $2 }
373 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
374 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
a0db5523 375 ;
543d3420 376
46486dc8
SK
377decs_any_but_fun:
378 | { [] }
379 | var_dec decs_any { $1 :: $2 }
380 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
28875fec
SK
381 ;
382
46486dc8
SK
383decs_any_but_typ:
384 | { [] }
385 | var_dec decs_any { $1 :: $2 }
386 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
387 ;
388
389/*---------------------------------------------------------------------------*/
390/* END unintuitive rules for decs (which avoid shift/reduce conflicts) */
391/*---------------------------------------------------------------------------*/
392
28875fec 393typ_decs:
46486dc8
SK
394 | typ_dec { $1 :: [] }
395 | typ_dec typ_decs { $1 :: $2 }
28875fec
SK
396 ;
397
398typ_dec:
3fbeb7c1 399 | TYPE ID EQ ID
ef945634 400 {
28875fec
SK
401 let type_id_left = $2 in
402 let type_id_right = $4 in
403 let pos = pos () in (* FIXME: rhs id should have its own pos, no? *)
404 Ast.TypeDec
405 { name = Sym.of_string type_id_left
406 ; ty = Ast.NameTy {symbol = Sym.of_string type_id_right; pos}
407 ; pos
408 }
ef945634 409 }
28875fec 410 | TYPE ID EQ LBRACE type_fields RBRACE
543d3420 411 {
3fbeb7c1 412 let type_id = $2 in
28875fec
SK
413 let type_fields = $5 in
414 Ast.TypeDec
415 { name = Sym.of_string type_id
416 ; ty = Ast.RecordTy type_fields
417 ; pos = pos ()
418 }
3fbeb7c1
SK
419 }
420 | TYPE ID EQ ARRAY OF ID
421 {
28875fec
SK
422 let type_id = Sym.of_string $2 in
423 let element_type_id = Sym.of_string $6 in
424 let pos = pos () in
425 Ast.TypeDec
426 { name = type_id
427 ; ty = Ast.ArrayTy {symbol = element_type_id; pos}
428 ; pos
429 }
543d3420 430 }
28875fec 431 ;
543d3420 432
28875fec
SK
433var_dec:
434 | VAR ID maybe_type_sig ASSIGN exp
435 {
436 let var_id = Sym.of_string $2 in
437 let maybe_type_sig = $3 in
438 let exp = $5 in
439 let pos = pos () in
440 Ast.VarDec
441 { name = var_id
442 ; escape = ref true
443 ; typ = maybe_type_sig
444 ; init = exp
445 ; pos
446 }
543d3420 447 }
28875fec 448 ;
543d3420 449
28875fec 450fun_decs:
46486dc8
SK
451 | fun_dec { $1 :: [] }
452 | fun_dec fun_decs { $1 :: $2 }
28875fec
SK
453 ;
454
455fun_dec:
456 | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp
543d3420 457 {
28875fec
SK
458 let name = Sym.of_string $2 in
459 let params = $4 in
460 let result = $6 in
461 let body = $8 in
462 let pos = pos () in
463 Ast.FunDec {name; params; result; body; pos}
543d3420 464 }
a0db5523 465 ;
543d3420 466
28875fec
SK
467maybe_type_sig:
468 | { None }
469 | COLON ID { Some (Sym.of_string $2, pos ()) }
470 ;
471
472type_fields:
473 |
474 { [] }
a87678f0 475 | ID COLON ID
543d3420 476 {
28875fec
SK
477 let field =
478 Ast.Field
479 { name = Sym.of_string $1
480 ; escape = ref true
481 ; typ = Sym.of_string $3
482 ; pos = pos ()
483 }
484 in
485 field :: []
486 }
487 | ID COLON ID COMMA type_fields
488 {
489 let field =
490 Ast.Field
491 { name = Sym.of_string $1
492 ; escape = ref true
493 ; typ = Sym.of_string $3
494 ; pos = pos ()
495 }
496 in
497 field :: $5
543d3420 498 }
a0db5523 499 ;
543d3420 500
543d3420 501fun_args:
28875fec
SK
502 | { [] }
503 | exp { $1 :: [] }
504 | exp COMMA fun_args { $1 :: $3 }
a0db5523 505 ;
543d3420 506
543d3420 507lvalue:
28875fec 508 | ID
543d3420 509 {
28875fec
SK
510 Ast.SimpleVar
511 { symbol = Sym.of_string $1
512 ; pos = pos ()
513 }
543d3420 514 }
28875fec 515 | lvalue LBRACK exp RBRACK
543d3420 516 {
28875fec
SK
517 Ast.SubscriptVar
518 { var = $1
519 ; exp = $3
520 ; pos = pos ()
521 }
543d3420 522 }
28875fec 523 | lvalue DOT ID
543d3420 524 {
28875fec
SK
525 Ast.FieldVar
526 { var = $1
527 ; symbol = Sym.of_string $3
528 ; pos = pos ()
529 }
543d3420 530 }
a0db5523 531 ;
543d3420
SK
532
533%%
This page took 0.139757 seconds and 4 git commands to generate.