X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tiger%2Fsrc%2Flib%2Ftiger%2Ftiger_parser.mly;fp=tiger%2Fsrc%2Flib%2Ftiger%2Ftiger_parser.mly;h=0000000000000000000000000000000000000000;hb=cda83e5ec171672a59966d2bd9cd28bd7a8fe083;hp=1bb9388b7a3f5ac509bce3226a7a3fa3a16fcaad;hpb=46486dc8836fede7e00aaa614d99d98ed7646bdc;p=tiger.ml.git diff --git a/tiger/src/lib/tiger/tiger_parser.mly b/tiger/src/lib/tiger/tiger_parser.mly deleted file mode 100644 index 1bb9388..0000000 --- a/tiger/src/lib/tiger/tiger_parser.mly +++ /dev/null @@ -1,533 +0,0 @@ -%{ - module Ast = Tiger_absyn - module Sym = Tiger_symbol - - let pos () = - Tiger_position.of_lexing_positions - ~pos_start:(Parsing.symbol_start_pos ()) - ~pos_end:(Parsing.symbol_end_pos ()) -%} - -/* Declarations */ -%token AND -%token ARRAY -%token ASSIGN -%token BREAK -%token COLON -%token COMMA -%token DIVIDE -%token DO -%token DOT -%token ELSE -%token END -%token EOF -%token EQ -%token FOR -%token FUNCTION -%token GE -%token GT -%token ID -%token IF -%token IN -%token INT -%token LBRACE -%token LBRACK -%token LE -%token LET -%token LPAREN -%token LT -%token MINUS -%token NEQ -%token NIL -%token OF -%token OR -%token PLUS -%token RBRACE -%token RBRACK -%token RPAREN -%token SEMICOLON -%token STRING -%token THEN -%token TIMES -%token TO -%token TYPE -%token VAR -%token WHILE - -/* from lowest precedence */ -%nonassoc THEN -%nonassoc ELSE -%nonassoc ASSIGN -%nonassoc OF DO -%left OR -%left AND -%nonassoc EQ NEQ GT LT GE LE -%left PLUS MINUS -%left TIMES DIVIDE -%nonassoc HIGHEST -/* to highest precedence */ - -%type program - -%start program - -%% - -program: exp EOF { $1 }; - -exp: - | NIL - { Ast.NilExp } - | INT - { Ast.IntExp $1 } - | MINUS exp %prec HIGHEST - { - Ast.OpExp - { left = Ast.IntExp 0 - ; oper = Ast.MinusOp - ; right = $2 - ; pos = pos () - } - } - | lvalue LBRACK exp RBRACK OF exp - { - match $1 with - | Ast.SimpleVar {symbol=typ; _} -> - Ast.ArrayExp - { typ - ; size = $3 - ; init = $6 - ; pos = pos () - } - | Ast.SubscriptVar _ | Ast.FieldVar _ -> - raise Parse_error - } - | ID LBRACE rec_fields_bind RBRACE - { - let type_id = $1 in - let fields = $3 in - let typ = Sym.of_string type_id in - let pos = pos () in - Ast.RecordExp {fields; typ; pos} - } - | lvalue - { Ast.VarExp $1 } - | lvalue ASSIGN exp - { - let var = $1 in - let exp = $3 in - let pos = pos () in - Ast.AssignExp {var; exp; pos} - } - | STRING - { Ast.StringExp {string = $1; pos = pos ()} } - | ID LPAREN fun_args RPAREN - { - Ast.CallExp - { func = Sym.of_string $1 - ; args = $3 - ; pos = pos () - } - } - | exp PLUS exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.PlusOp - ; right = $3 - ; pos = pos () - } - } - | exp MINUS exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.MinusOp - ; right = $3 - ; pos = pos () - } - } - | exp TIMES exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.TimesOp - ; right = $3 - ; pos = pos () - } - } - | exp DIVIDE exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.DivideOp - ; right = $3 - ; pos = pos () - } - } - | exp EQ exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.EqOp - ; right = $3 - ; pos = pos () - } - } - | exp NEQ exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.NeqOp - ; right = $3 - ; pos = pos () - } - } - | exp GT exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.GtOp - ; right = $3 - ; pos = pos () - } - } - | exp LT exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.LtOp - ; right = $3 - ; pos = pos () - } - } - | exp GE exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.GeOp - ; right = $3 - ; pos = pos () - } - } - | exp LE exp - { - Ast.OpExp - { left = $1 - ; oper = Ast.LeOp - ; right = $3 - ; pos = pos () - } - } - | exp AND exp - { - let e1 = $1 in - let e2 = $3 in - Ast.IfExp - { test = e1 - ; then' = e2 - ; else' = Some (Ast.IntExp 0) - ; pos = pos () - } - } - | exp OR exp - { - let e1 = $1 in - let e2 = $3 in - Ast.IfExp - { test = e1 - ; then' = Ast.IntExp 1 - ; else' = Some e2 - ; pos = pos () - } - } - | IF exp THEN exp ELSE exp - { - let e1 = $2 in - let e2 = $4 in - let e3 = $6 in - Ast.IfExp - { test = e1 - ; then' = e2 - ; else' = Some e3 - ; pos = pos () - } - } - | IF exp THEN exp - { - let e1 = $2 in - let e2 = $4 in - Ast.IfExp - { test = e1 - ; then' = e2 - ; else' = None - ; pos = pos () - } - } - | WHILE exp DO exp - { - let e1 = $2 in - let e2 = $4 in - Ast.WhileExp - { test = e1 - ; body = e2 - ; pos = pos () - } - } - | FOR ID ASSIGN exp TO exp DO exp - { - let var = $2 in - let e1 = $4 in - let e2 = $6 in - let e3 = $8 in - Ast.ForExp - { var = Sym.of_string var - ; escape = ref true - ; lo = e1 - ; hi = e2 - ; body = e3 - ; pos = pos () - } - } - | BREAK - { Ast.BreakExp (pos ()) } - | LPAREN exps RPAREN - { Ast.SeqExp $2 } - | LET decs IN exps END - { - let decs = $2 in - let exps = $4 in - Ast.LetExp {decs; body = Ast.SeqExp exps; pos = pos ()} - } - ; - -exps: - | { [] } - | exp { ($1, pos ()) :: [] } - | exp SEMICOLON exps { ($1, pos ()) :: $3 } - ; - -rec_fields_bind: - | ID EQ exp { (Sym.of_string $1, $3, pos ()) :: [] } - | ID EQ exp COMMA rec_fields_bind { (Sym.of_string $1, $3, pos ()) :: $5 } - ; - -/* ------------------------------------------------------------------------- */ -/* BEGIN unintuitive rules for decs (which avoid shift/reduce conflicts) */ -/* ------------------------------------------------------------------------- */ -/* - In order to support mutual recursion, we need to group consecutive - type and function declarations (see Tiger-book pages 97-99). - - Initially, I defined the rules to do so as: - - decs: - | dec { $1 :: [] } - | dec decs { $1 :: $2 } - ; - dec: - | var_dec { $1 } - | typ_decs { Ast.TypeDecs $1 } - | fun_decs { Ast.FunDecs $1 } - ; - - which, while straightforward (and working, because ocamlyacc defaults to - shift in case of a conflict), nonetheless caused a shift/reduce conflict in - each of: typ_decs and fun_decs; where the parser did not know whether to - shift and stay in (typ|fun_)_dec state or to reduce and get back to dec - state. - - Sadly, tagging the rules with a lower precedence (to explicitly favor - shifting) - does not help :( - - %nonassoc LOWEST - ... - dec: - | var_dec { $1 } - | typ_decs %prec LOWEST { Ast.TypeDecs $1 } - | fun_decs %prec LOWEST { Ast.FunDecs $1 } - ; - - The difficulty seems to be in the lack of a separator token which would be - able to definitively mark the end of each sequence of consecutive - (typ_|fun_) declarations. - - Keeping this in mind, another alternative is to manually capture the possible - interspersion patterns in the rules like: - - (N * foo) followed-by (N * not-foo) - - for the exception of var_dec, which, since we do not need to group its - consecutive sequences, can be reduced upon first sighting. -*/ - -decs: - | var_dec decs_any { $1 :: $2 } - | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 } - | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 } - ; - -decs_any: - | { [] } - | var_dec decs_any { $1 :: $2 } - | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 } - | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 } - ; - -decs_any_but_fun: - | { [] } - | var_dec decs_any { $1 :: $2 } - | typ_decs decs_any_but_typ { (Ast.TypeDecs $1) :: $2 } - ; - -decs_any_but_typ: - | { [] } - | var_dec decs_any { $1 :: $2 } - | fun_decs decs_any_but_fun { (Ast.FunDecs $1) :: $2 } - ; - -/*---------------------------------------------------------------------------*/ -/* END unintuitive rules for decs (which avoid shift/reduce conflicts) */ -/*---------------------------------------------------------------------------*/ - -typ_decs: - | typ_dec { $1 :: [] } - | typ_dec typ_decs { $1 :: $2 } - ; - -typ_dec: - | TYPE ID EQ ID - { - let type_id_left = $2 in - let type_id_right = $4 in - let pos = pos () in (* FIXME: rhs id should have its own pos, no? *) - Ast.TypeDec - { name = Sym.of_string type_id_left - ; ty = Ast.NameTy {symbol = Sym.of_string type_id_right; pos} - ; pos - } - } - | TYPE ID EQ LBRACE type_fields RBRACE - { - let type_id = $2 in - let type_fields = $5 in - Ast.TypeDec - { name = Sym.of_string type_id - ; ty = Ast.RecordTy type_fields - ; pos = pos () - } - } - | TYPE ID EQ ARRAY OF ID - { - let type_id = Sym.of_string $2 in - let element_type_id = Sym.of_string $6 in - let pos = pos () in - Ast.TypeDec - { name = type_id - ; ty = Ast.ArrayTy {symbol = element_type_id; pos} - ; pos - } - } - ; - -var_dec: - | VAR ID maybe_type_sig ASSIGN exp - { - let var_id = Sym.of_string $2 in - let maybe_type_sig = $3 in - let exp = $5 in - let pos = pos () in - Ast.VarDec - { name = var_id - ; escape = ref true - ; typ = maybe_type_sig - ; init = exp - ; pos - } - } - ; - -fun_decs: - | fun_dec { $1 :: [] } - | fun_dec fun_decs { $1 :: $2 } - ; - -fun_dec: - | FUNCTION ID LPAREN type_fields RPAREN maybe_type_sig EQ exp - { - let name = Sym.of_string $2 in - let params = $4 in - let result = $6 in - let body = $8 in - let pos = pos () in - Ast.FunDec {name; params; result; body; pos} - } - ; - -maybe_type_sig: - | { None } - | COLON ID { Some (Sym.of_string $2, pos ()) } - ; - -type_fields: - | - { [] } - | ID COLON ID - { - let field = - Ast.Field - { name = Sym.of_string $1 - ; escape = ref true - ; typ = Sym.of_string $3 - ; pos = pos () - } - in - field :: [] - } - | ID COLON ID COMMA type_fields - { - let field = - Ast.Field - { name = Sym.of_string $1 - ; escape = ref true - ; typ = Sym.of_string $3 - ; pos = pos () - } - in - field :: $5 - } - ; - -fun_args: - | { [] } - | exp { $1 :: [] } - | exp COMMA fun_args { $1 :: $3 } - ; - -lvalue: - | ID - { - Ast.SimpleVar - { symbol = Sym.of_string $1 - ; pos = pos () - } - } - | lvalue LBRACK exp RBRACK - { - Ast.SubscriptVar - { var = $1 - ; exp = $3 - ; pos = pos () - } - } - | lvalue DOT ID - { - Ast.FieldVar - { var = $1 - ; symbol = Sym.of_string $3 - ; pos = pos () - } - } - ; - -%%