2 module Ast = Tiger_absyn
3 module Err = Tiger_error
4 module Sym = Tiger_symbol
7 Tiger_position.of_lexing_positions
8 ~pos_start:(Parsing.symbol_start_pos ())
9 ~pos_end:(Parsing.symbol_end_pos ())
50 %token <string> STRING
58 /* from lowest precedence */
65 %nonassoc EQ NEQ GT LT GE LE
69 /* to highest precedence */
71 %type <Tiger_absyn.t> program
79 | error {Err.raise (Err.Invalid_syntax (pos ()))}
87 | MINUS exp %prec HIGHEST
96 | lvalue LBRACK exp RBRACK OF exp
99 | Ast.SimpleVar {symbol=typ; _} ->
106 | Ast.SubscriptVar _ | Ast.FieldVar _ ->
109 | ID LBRACE rec_fields_bind RBRACE
113 let typ = Sym.of_string type_id in
115 Ast.RecordExp {fields; typ; pos}
124 Ast.AssignExp {var; exp; pos}
127 { Ast.StringExp {string = $1; pos = pos ()} }
128 | ID LPAREN fun_args RPAREN
131 { func = Sym.of_string $1
167 ; oper = Ast.DivideOp
233 ; else' = Some (Ast.IntExp 0)
243 ; then' = Ast.IntExp 1
248 | IF exp THEN exp ELSE exp
281 | FOR ID ASSIGN exp TO exp DO exp
288 { var = Sym.of_string var
297 { Ast.BreakExp (pos ()) }
300 | LET decs IN exps END
304 Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()}
310 | exp { ($1, pos ()) :: [] }
311 | exp SEMICOLON exps { ($1, pos ()) :: $3 }
316 | ID EQ exp { (Sym.of_string $1, $3, pos ()) :: [] }
317 | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 }
320 /* ------------------------------------------------------------------------- */
321 /* BEGIN unintuitive rules for decs (which avoid shift/reduce conflicts) */
322 /* ------------------------------------------------------------------------- */
324 In order to support mutual recursion, we need to group consecutive
325 type and function declarations (see Tiger-book pages 97-99).
327 Initially, I defined the rules to do so as:
331 | dec decs { $1 :: $2 }
335 | typ_decs { Ast.TypeDecs $1 }
336 | fun_decs { Ast.FunDecs $1 }
339 which, while straightforward (and working, because ocamlyacc defaults to
340 shift in case of a conflict), nonetheless caused a shift/reduce conflict in
341 each of: typ_decs and fun_decs; where the parser did not know whether to
342 shift and stay in (typ|fun_)_dec state or to reduce and get back to dec
345 Sadly, tagging the rules with a lower precedence (to explicitly favor
346 shifting) - does not help :(
352 | typ_decs %prec LOWEST { Ast.TypeDecs $1 }
353 | fun_decs %prec LOWEST { Ast.FunDecs $1 }
356 The difficulty seems to be in the lack of a separator token which would be
357 able to definitively mark the end of each sequence of consecutive
358 (typ_|fun_) declarations.
360 Keeping this in mind, another alternative is to manually capture the possible
361 interspersion patterns in the rules like:
363 (N * foo) followed-by (N * not-foo)
365 for the exception of var_dec, which, since we do not need to group its
366 consecutive sequences, can be reduced upon first sighting.
370 | var_dec decs_any { $1 :: $2 }
371 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
372 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
377 | var_dec decs_any { $1 :: $2 }
378 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
379 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
384 | var_dec decs_any { $1 :: $2 }
385 | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 }
390 | var_dec decs_any { $1 :: $2 }
391 | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 }
394 /*---------------------------------------------------------------------------*/
395 /* END unintuitive rules for decs (which avoid shift/reduce conflicts) */
396 /*---------------------------------------------------------------------------*/
399 | typ_dec { $1 :: [] }
400 | typ_dec typ_decs { $1 :: $2 }
406 let type_id_left = $2 in
407 let type_id_right = $4 in
408 let pos = pos () in (* FIXME: rhs id should have its own pos, no? *)
410 { name = Sym.of_string type_id_left
411 ; ty = Ast.NameTy {symbol = Sym.of_string type_id_right; pos}
415 | TYPE ID EQ LBRACE type_fields RBRACE
418 let type_fields = $5 in
420 { name = Sym.of_string type_id
421 ; ty = Ast.RecordTy type_fields
425 | TYPE ID EQ ARRAY OF ID
427 let type_id = Sym.of_string $2 in
428 let element_type_id = Sym.of_string $6 in
432 ; ty = Ast.ArrayTy {symbol = element_type_id; pos}
439 | VAR ID maybe_type_sig ASSIGN exp
441 let var_id = Sym.of_string $2 in
442 let maybe_type_sig = $3 in
448 ; typ = maybe_type_sig
456 | fun_dec { $1 :: [] }
457 | fun_dec fun_decs { $1 :: $2 }
461 | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp
463 let name = Sym.of_string $2 in
468 Ast.FunDec {name; params; result; body; pos}
474 | COLON ID { Some (Sym.of_string $2, pos ()) }
484 { name = Sym.of_string $1
486 ; typ = Sym.of_string $3
492 | ID COLON ID COMMA type_fields
496 { name = Sym.of_string $1
498 ; typ = Sym.of_string $3
509 | exp COMMA fun_args { $1 :: $3 }
516 { symbol = Sym.of_string $1
520 | lvalue LBRACK exp RBRACK
532 ; symbol = Sym.of_string $3