[tiger.ml.git] / compiler / src / lib / tiger / tiger_parser.mly

%{
  module Ast = Tiger_absyn
  module Err = Tiger_error
  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 <string> ID
%token IF
%token IN
%token <int> 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> 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 <Tiger_absyn.t> program

%start program

%%

program:
  | exp EOF { $1 }
  | error {Err.raise (Err.Invalid_syntax (pos ()))}
  ;

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 ()
        }
    }
  ;

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