parsing/parser.mly

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the Q Public License version 1.0.               */
  10 /*                                                                     */
  11 /***********************************************************************/
  12
  13 /* $Id$ */
  14
  15 /* The parser definition */
  16
  17 %{
  18 open Location
  19 open Asttypes
  20 open Longident
  21 open Parsetree
  22
  23 let mktyp d =
  24   { ptyp_desc = d; ptyp_loc = symbol_rloc() }
  25 let mkpat d =
  26   { ppat_desc = d; ppat_loc = symbol_rloc() }
  27 let mkexp d =
  28   { pexp_desc = d; pexp_loc = symbol_rloc() }
  29 let mkmty d =
  30   { pmty_desc = d; pmty_loc = symbol_rloc() }
  31 let mksig d =
  32   { psig_desc = d; psig_loc = symbol_rloc() }
  33 let mkmod d =
  34   { pmod_desc = d; pmod_loc = symbol_rloc() }
  35 let mkstr d =
  36   { pstr_desc = d; pstr_loc = symbol_rloc() }
  37 let mkfield d =
  38   { pfield_desc = d; pfield_loc = symbol_rloc() }
  39 let mkclass d =
  40   { pcl_desc = d; pcl_loc = symbol_rloc() }
  41 let mkcty d =
  42   { pcty_desc = d; pcty_loc = symbol_rloc() }
  43
  44 let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
  45 let reloc_exp x = { x with pexp_loc = symbol_rloc () };;
  46
  47 let mkoperator name pos =
  48   { pexp_desc = Pexp_ident(Lident name); pexp_loc = rhs_loc pos }
  49
  50 (*
  51   Ghost expressions and patterns:
  52   expressions and patterns that do not appear explicitely in the
  53   source file they have the loc_ghost flag set to true.
  54   Then the profiler will not try to instrument them and the
  55   -stypes option will not try to display their type.
  56
  57   Every grammar rule that generates an element with a location must
  58   make at most one non-ghost element, the topmost one.
  59
  60   How to tell whether your location must be ghost:
  61   A location corresponds to a range of characters in the source file.
  62   If the location contains a piece of code that is syntactically
  63   valid (according to the documentation), and corresponds to the
  64   AST node, then the location must be real; in all other cases,
  65   it must be ghost.
  66 *)
  67 let ghexp d = { pexp_desc = d; pexp_loc = symbol_gloc () };;
  68 let ghpat d = { ppat_desc = d; ppat_loc = symbol_gloc () };;
  69 let ghtyp d = { ptyp_desc = d; ptyp_loc = symbol_gloc () };;
  70
  71 let mkassert e =
  72   match e with
  73   | {pexp_desc = Pexp_construct (Lident "false", None, false) } ->
  74          mkexp (Pexp_assertfalse)
  75   | _ -> mkexp (Pexp_assert (e))
  76 ;;
  77
  78 let mkinfix arg1 name arg2 =
  79   mkexp(Pexp_apply(mkoperator name 2, ["", arg1; "", arg2]))
  80
  81 let neg_float_string f =
  82   if String.length f > 0 && f.[0] = '-'
  83   then String.sub f 1 (String.length f - 1)
  84   else "-" ^ f
  85
  86 let mkuminus name arg =
  87   match name, arg.pexp_desc with
  88   | "-", Pexp_constant(Const_int n) ->
  89       mkexp(Pexp_constant(Const_int(-n)))
  90   | "-", Pexp_constant(Const_int32 n) ->
  91       mkexp(Pexp_constant(Const_int32(Int32.neg n)))
  92   | "-", Pexp_constant(Const_int64 n) ->
  93       mkexp(Pexp_constant(Const_int64(Int64.neg n)))
  94   | "-", Pexp_constant(Const_nativeint n) ->
  95       mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
  96   | _, Pexp_constant(Const_float f) ->
  97       mkexp(Pexp_constant(Const_float(neg_float_string f)))
  98   | _ ->
  99       mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, ["", arg]))
 100
 101 let rec mktailexp = function
 102     [] ->
 103       ghexp(Pexp_construct(Lident "[]", None, false))
 104   | e1 :: el ->
 105       let exp_el = mktailexp el in
 106       let l = {loc_start = e1.pexp_loc.loc_start;
 107                loc_end = exp_el.pexp_loc.loc_end;
 108                loc_ghost = true}
 109       in
 110       let arg = {pexp_desc = Pexp_tuple [e1; exp_el]; pexp_loc = l} in
 111       {pexp_desc = Pexp_construct(Lident "::", Some arg, false); pexp_loc = l}
 112
 113 let rec mktailpat = function
 114     [] ->
 115       ghpat(Ppat_construct(Lident "[]", None, false))
 116   | p1 :: pl ->
 117       let pat_pl = mktailpat pl in
 118       let l = {loc_start = p1.ppat_loc.loc_start;
 119                loc_end = pat_pl.ppat_loc.loc_end;
 120                loc_ghost = true}
 121       in
 122       let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
 123       {ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
 124
 125 let ghstrexp e =
 126   { pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
 127
 128 let array_function str name =
 129   Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))
 130
 131 let rec deep_mkrangepat c1 c2 =
 132   if c1 = c2 then ghpat(Ppat_constant(Const_char c1)) else
 133   ghpat(Ppat_or(ghpat(Ppat_constant(Const_char c1)),
 134                 deep_mkrangepat (Char.chr(Char.code c1 + 1)) c2))
 135
 136 let rec mkrangepat c1 c2 =
 137   if c1 > c2 then mkrangepat c2 c1 else
 138   if c1 = c2 then mkpat(Ppat_constant(Const_char c1)) else
 139   reloc_pat (deep_mkrangepat c1 c2)
 140
 141 let syntax_error () =
 142   raise Syntaxerr.Escape_error
 143
 144 let unclosed opening_name opening_num closing_name closing_num =
 145   raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
 146                                            rhs_loc closing_num, closing_name)))
 147
 148 let bigarray_function str name =
 149   Ldot(Ldot(Lident "Bigarray", str), name)
 150
 151 let bigarray_untuplify = function
 152     { pexp_desc = Pexp_tuple explist} -> explist
 153   | exp -> [exp]
 154
 155 let bigarray_get arr arg =
 156   match bigarray_untuplify arg with
 157     [c1] ->
 158       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "get")),
 159                        ["", arr; "", c1]))
 160   | [c1;c2] ->
 161       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "get")),
 162                        ["", arr; "", c1; "", c2]))
 163   | [c1;c2;c3] ->
 164       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "get")),
 165                        ["", arr; "", c1; "", c2; "", c3]))
 166   | coords ->
 167       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
 168                        ["", arr; "", ghexp(Pexp_array coords)]))
 169
 170 let bigarray_set arr arg newval =
 171   match bigarray_untuplify arg with
 172     [c1] ->
 173       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" "set")),
 174                        ["", arr; "", c1; "", newval]))
 175   | [c1;c2] ->
 176       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" "set")),
 177                        ["", arr; "", c1; "", c2; "", newval]))
 178   | [c1;c2;c3] ->
 179       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" "set")),
 180                        ["", arr; "", c1; "", c2; "", c3; "", newval]))
 181   | coords ->
 182       mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
 183                        ["", arr;
 184                         "", ghexp(Pexp_array coords);
 185                         "", newval]))
 186 %}
 187
 188 /* Tokens */
 189
 190 %token AMPERAMPER
 191 %token AMPERSAND
 192 %token AND
 193 %token AS
 194 %token ASSERT
 195 %token BACKQUOTE
 196 %token BAR
 197 %token BARBAR
 198 %token BARRBRACKET
 199 %token BEGIN
 200 %token <char> CHAR
 201 %token CLASS
 202 %token COLON
 203 %token COLONCOLON
 204 %token COLONEQUAL
 205 %token COLONGREATER
 206 %token COMMA
 207 %token CONSTRAINT
 208 %token DO
 209 %token DONE
 210 %token DOT
 211 %token DOTDOT
 212 %token DOWNTO
 213 %token ELSE
 214 %token END
 215 %token EOF
 216 %token EQUAL
 217 %token EXCEPTION
 218 %token EXTERNAL
 219 %token FALSE
 220 %token <string> FLOAT
 221 %token FOR
 222 %token FUN
 223 %token FUNCTION
 224 %token FUNCTOR
 225 %token GREATER
 226 %token GREATERRBRACE
 227 %token GREATERRBRACKET
 228 %token IF
 229 %token IN
 230 %token INCLUDE
 231 %token <string> INFIXOP0
 232 %token <string> INFIXOP1
 233 %token <string> INFIXOP2
 234 %token <string> INFIXOP3
 235 %token <string> INFIXOP4
 236 %token INHERIT
 237 %token INITIALIZER
 238 %token <int> INT
 239 %token <int32> INT32
 240 %token <int64> INT64
 241 %token <string> LABEL
 242 %token LAZY
 243 %token LBRACE
 244 %token LBRACELESS
 245 %token LBRACKET
 246 %token LBRACKETBAR
 247 %token LBRACKETLESS
 248 %token LBRACKETGREATER
 249 %token LESS
 250 %token LESSMINUS
 251 %token LET
 252 %token <string> LIDENT
 253 %token LPAREN
 254 %token MATCH
 255 %token METHOD
 256 %token MINUS
 257 %token MINUSDOT
 258 %token MINUSGREATER
 259 %token MODULE
 260 %token MUTABLE
 261 %token <nativeint> NATIVEINT
 262 %token NEW
 263 %token OBJECT
 264 %token OF
 265 %token OPEN
 266 %token <string> OPTLABEL
 267 %token OR
 268 /* %token PARSER */
 269 %token PLUS
 270 %token <string> PREFIXOP
 271 %token PRIVATE
 272 %token QUESTION
 273 %token QUESTIONQUESTION
 274 %token QUOTE
 275 %token RBRACE
 276 %token RBRACKET
 277 %token REC
 278 %token RPAREN
 279 %token SEMI
 280 %token SEMISEMI
 281 %token SHARP
 282 %token SIG
 283 %token STAR
 284 %token <string> STRING
 285 %token STRUCT
 286 %token THEN
 287 %token TILDE
 288 %token TO
 289 %token TRUE
 290 %token TRY
 291 %token TYPE
 292 %token <string> UIDENT
 293 %token UNDERSCORE
 294 %token VAL
 295 %token VIRTUAL
 296 %token WHEN
 297 %token WHILE
 298 %token WITH
 299
 300 /* Precedences and associativities.
 301
 302 Tokens and rules have precedences.  A reduce/reduce conflict is resolved
 303 in favor of the first rule (in source file order).  A shift/reduce conflict
 304 is resolved by comparing the precedence and associativity of the token to
 305 be shifted with those of the rule to be reduced.
 306
 307 By default, a rule has the precedence of its rightmost terminal (if any).
 308
 309 When there is a shift/reduce conflict between a rule and a token that
 310 have the same precedence, it is resolved using the associativity:
 311 if the token is left-associative, the parser will reduce; if
 312 right-associative, the parser will shift; if non-associative,
 313 the parser will declare a syntax error.
 314
 315 We will only use associativities with operators of the kind  x * x -> x
 316 for example, in the rules of the form    expr: expr BINOP expr
 317 in all other cases, we define two precedences if needed to resolve
 318 conflicts.
 319
 320 The precedences must be listed from low to high.
 321 */
 322
 323 %nonassoc IN
 324 %nonassoc below_SEMI
 325 %nonassoc SEMI                          /* below EQUAL ({lbl=...; lbl=...}) */
 326 %nonassoc LET                           /* above SEMI ( ...; let ... in ...) */
 327 %nonassoc below_WITH
 328 %nonassoc FUNCTION WITH                 /* below BAR  (match ... with ...) */
 329 %nonassoc AND             /* above WITH (module rec A: SIG with ... and ...) */
 330 %nonassoc THEN                          /* below ELSE (if ... then ...) */
 331 %nonassoc ELSE                          /* (if ... then ... else ...) */
 332 %nonassoc LESSMINUS                     /* below COLONEQUAL (lbl <- x := e) */
 333 %right    COLONEQUAL                    /* expr (e := e := e) */
 334 %nonassoc AS
 335 %left     BAR                           /* pattern (p|p|p) */
 336 %nonassoc below_COMMA
 337 %left     COMMA                         /* expr/expr_comma_list (e,e,e) */
 338 %right    MINUSGREATER                  /* core_type2 (t -> t -> t) */
 339 %right    OR BARBAR                     /* expr (e || e || e) */
 340 %right    AMPERSAND AMPERAMPER          /* expr (e && e && e) */
 341 %nonassoc below_EQUAL
 342 %left     INFIXOP0 EQUAL LESS GREATER   /* expr (e OP e OP e) */
 343 %right    INFIXOP1                      /* expr (e OP e OP e) */
 344 %right    COLONCOLON                    /* expr (e :: e :: e) */
 345 %left     INFIXOP2 PLUS MINUS MINUSDOT  /* expr (e OP e OP e) */
 346 %left     INFIXOP3 STAR                 /* expr (e OP e OP e) */
 347 %right    INFIXOP4                      /* expr (e OP e OP e) */
 348 %nonassoc prec_unary_minus              /* unary - */
 349 %nonassoc prec_constant_constructor     /* cf. simple_expr (C versus C x) */
 350 %nonassoc prec_constr_appl              /* above AS BAR COLONCOLON COMMA */
 351 %nonassoc below_SHARP
 352 %nonassoc SHARP                         /* simple_expr/toplevel_directive */
 353 %nonassoc below_DOT
 354 %nonassoc DOT
 355 /* Finally, the first tokens of simple_expr are above everything else. */
 356 %nonassoc BACKQUOTE BEGIN CHAR FALSE FLOAT INT INT32 INT64
 357           LBRACE LBRACELESS LBRACKET LBRACKETBAR LIDENT LPAREN
 358           NEW NATIVEINT PREFIXOP STRING TRUE UIDENT
 359
 360
 361 /* Entry points */
 362
 363 %start implementation                   /* for implementation files */
 364 %type <Parsetree.structure> implementation
 365 %start interface                        /* for interface files */
 366 %type <Parsetree.signature> interface
 367 %start toplevel_phrase                  /* for interactive use */
 368 %type <Parsetree.toplevel_phrase> toplevel_phrase
 369 %start use_file                         /* for the #use directive */
 370 %type <Parsetree.toplevel_phrase list> use_file
 371
 372 %%
 373
 374 /* Entry points */
 375
 376 implementation:
 377     structure EOF                        { $1 }
 378 ;
 379 interface:
 380     signature EOF                        { List.rev $1 }
 381 ;
 382 toplevel_phrase:
 383     top_structure SEMISEMI               { Ptop_def $1 }
 384   | seq_expr SEMISEMI                    { Ptop_def[ghstrexp $1] }
 385   | toplevel_directive SEMISEMI          { $1 }
 386   | EOF                                  { raise End_of_file }
 387 ;
 388 top_structure:
 389     structure_item                       { [$1] }
 390   | structure_item top_structure         { $1 :: $2 }
 391 ;
 392 use_file:
 393     use_file_tail                        { $1 }
 394   | seq_expr use_file_tail               { Ptop_def[ghstrexp $1] :: $2 }
 395 ;
 396 use_file_tail:
 397     EOF                                         { [] }
 398   | SEMISEMI EOF                                { [] }
 399   | SEMISEMI seq_expr use_file_tail             { Ptop_def[ghstrexp $2] :: $3 }
 400   | SEMISEMI structure_item use_file_tail       { Ptop_def[$2] :: $3 }
 401   | SEMISEMI toplevel_directive use_file_tail   { $2 :: $3 }
 402   | structure_item use_file_tail                { Ptop_def[$1] :: $2 }
 403   | toplevel_directive use_file_tail            { $1 :: $2 }
 404 ;
 405
 406 /* Module expressions */
 407
 408 module_expr:
 409     mod_longident
 410       { mkmod(Pmod_ident $1) }
 411   | STRUCT structure END
 412       { mkmod(Pmod_structure($2)) }
 413   | STRUCT structure error
 414       { unclosed "struct" 1 "end" 3 }
 415   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_expr
 416       { mkmod(Pmod_functor($3, $5, $8)) }
 417   | module_expr LPAREN module_expr RPAREN
 418       { mkmod(Pmod_apply($1, $3)) }
 419   | module_expr LPAREN module_expr error
 420       { unclosed "(" 2 ")" 4 }
 421   | LPAREN module_expr COLON module_type RPAREN
 422       { mkmod(Pmod_constraint($2, $4)) }
 423   | LPAREN module_expr COLON module_type error
 424       { unclosed "(" 1 ")" 5 }
 425   | LPAREN module_expr RPAREN
 426       { $2 }
 427   | LPAREN module_expr error
 428       { unclosed "(" 1 ")" 3 }
 429 ;
 430 structure:
 431     structure_tail                              { $1 }
 432   | seq_expr structure_tail                     { ghstrexp $1 :: $2 }
 433 ;
 434 structure_tail:
 435     /* empty */                                 { [] }
 436   | SEMISEMI                                    { [] }
 437   | SEMISEMI seq_expr structure_tail            { ghstrexp $2 :: $3 }
 438   | SEMISEMI structure_item structure_tail      { $2 :: $3 }
 439   | structure_item structure_tail               { $1 :: $2 }
 440 ;
 441 structure_item:
 442     LET rec_flag let_bindings
 443       { match $3 with
 444           [{ppat_desc = Ppat_any}, exp] -> mkstr(Pstr_eval exp)
 445         | _ -> mkstr(Pstr_value($2, List.rev $3)) }
 446   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
 447       { mkstr(Pstr_primitive($2, {pval_type = $4; pval_prim = $6})) }
 448   | TYPE type_declarations
 449       { mkstr(Pstr_type(List.rev $2)) }
 450   | EXCEPTION UIDENT constructor_arguments
 451       { mkstr(Pstr_exception($2, $3)) }
 452   | EXCEPTION UIDENT EQUAL constr_longident
 453       { mkstr(Pstr_exn_rebind($2, $4)) }
 454   | MODULE UIDENT module_binding
 455       { mkstr(Pstr_module($2, $3)) }
 456   | MODULE REC module_rec_bindings
 457       { mkstr(Pstr_recmodule(List.rev $3)) }
 458   | MODULE TYPE ident EQUAL module_type
 459       { mkstr(Pstr_modtype($3, $5)) }
 460   | OPEN mod_longident
 461       { mkstr(Pstr_open $2) }
 462   | CLASS class_declarations
 463       { mkstr(Pstr_class (List.rev $2)) }
 464   | CLASS TYPE class_type_declarations
 465       { mkstr(Pstr_class_type (List.rev $3)) }
 466   | INCLUDE module_expr
 467       { mkstr(Pstr_include $2) }
 468 ;
 469 module_binding:
 470     EQUAL module_expr
 471       { $2 }
 472   | COLON module_type EQUAL module_expr
 473       { mkmod(Pmod_constraint($4, $2)) }
 474   | LPAREN UIDENT COLON module_type RPAREN module_binding
 475       { mkmod(Pmod_functor($2, $4, $6)) }
 476 ;
 477 module_rec_bindings:
 478     module_rec_binding                            { [$1] }
 479   | module_rec_bindings AND module_rec_binding    { $3 :: $1 }
 480 ;
 481 module_rec_binding:
 482     UIDENT COLON module_type EQUAL module_expr    { ($1, $3, $5) }
 483 ;
 484
 485 /* Module types */
 486
 487 module_type:
 488     mty_longident
 489       { mkmty(Pmty_ident $1) }
 490   | SIG signature END
 491       { mkmty(Pmty_signature(List.rev $2)) }
 492   | SIG signature error
 493       { unclosed "sig" 1 "end" 3 }
 494   | FUNCTOR LPAREN UIDENT COLON module_type RPAREN MINUSGREATER module_type
 495       %prec below_WITH
 496       { mkmty(Pmty_functor($3, $5, $8)) }
 497   | module_type WITH with_constraints
 498       { mkmty(Pmty_with($1, List.rev $3)) }
 499   | LPAREN module_type RPAREN
 500       { $2 }
 501   | LPAREN module_type error
 502       { unclosed "(" 1 ")" 3 }
 503 ;
 504 signature:
 505     /* empty */                                 { [] }
 506   | signature signature_item                    { $2 :: $1 }
 507   | signature signature_item SEMISEMI           { $2 :: $1 }
 508 ;
 509 signature_item:
 510     VAL val_ident COLON core_type
 511       { mksig(Psig_value($2, {pval_type = $4; pval_prim = []})) }
 512   | EXTERNAL val_ident COLON core_type EQUAL primitive_declaration
 513       { mksig(Psig_value($2, {pval_type = $4; pval_prim = $6})) }
 514   | TYPE type_declarations
 515       { mksig(Psig_type(List.rev $2)) }
 516   | EXCEPTION UIDENT constructor_arguments
 517       { mksig(Psig_exception($2, $3)) }
 518   | MODULE UIDENT module_declaration
 519       { mksig(Psig_module($2, $3)) }
 520   | MODULE REC module_rec_declarations
 521       { mksig(Psig_recmodule(List.rev $3)) }
 522   | MODULE TYPE ident
 523       { mksig(Psig_modtype($3, Pmodtype_abstract)) }
 524   | MODULE TYPE ident EQUAL module_type
 525       { mksig(Psig_modtype($3, Pmodtype_manifest $5)) }
 526   | OPEN mod_longident
 527       { mksig(Psig_open $2) }
 528   | INCLUDE module_type
 529       { mksig(Psig_include $2) }
 530   | CLASS class_descriptions
 531       { mksig(Psig_class (List.rev $2)) }
 532   | CLASS TYPE class_type_declarations
 533       { mksig(Psig_class_type (List.rev $3)) }
 534 ;
 535
 536 module_declaration:
 537     COLON module_type
 538       { $2 }
 539   | LPAREN UIDENT COLON module_type RPAREN module_declaration
 540       { mkmty(Pmty_functor($2, $4, $6)) }
 541 ;
 542 module_rec_declarations:
 543     module_rec_declaration                              { [$1] }
 544   | module_rec_declarations AND module_rec_declaration  { $3 :: $1 }
 545 ;
 546 module_rec_declaration:
 547     UIDENT COLON module_type                            { ($1, $3) }
 548 ;
 549
 550 /* Class expressions */
 551
 552 class_declarations:
 553     class_declarations AND class_declaration    { $3 :: $1 }
 554   | class_declaration                           { [$1] }
 555 ;
 556 class_declaration:
 557     virtual_flag class_type_parameters LIDENT class_fun_binding
 558       { let params, variance = List.split (fst $2) in
 559         {pci_virt = $1; pci_params = params, snd $2;
 560          pci_name = $3; pci_expr = $4; pci_variance = variance;
 561          pci_loc = symbol_rloc ()} }
 562 ;
 563 class_fun_binding:
 564     EQUAL class_expr
 565       { $2 }
 566   | COLON class_type EQUAL class_expr
 567       { mkclass(Pcl_constraint($4, $2)) }
 568   | labeled_simple_pattern class_fun_binding
 569       { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $2)) }
 570 ;
 571 class_type_parameters:
 572     /*empty*/                                   { [], symbol_gloc () }
 573   | LBRACKET type_parameter_list RBRACKET       { List.rev $2, symbol_rloc () }
 574 ;
 575 class_fun_def:
 576     labeled_simple_pattern MINUSGREATER class_expr
 577       { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $3)) }
 578   | labeled_simple_pattern class_fun_def
 579       { let (l,o,p) = $1 in mkclass(Pcl_fun(l, o, p, $2)) }
 580 ;
 581 class_expr:
 582     class_simple_expr
 583       { $1 }
 584   | FUN class_fun_def
 585       { $2 }
 586   | class_simple_expr simple_labeled_expr_list
 587       { mkclass(Pcl_apply($1, List.rev $2)) }
 588   | LET rec_flag let_bindings IN class_expr
 589       { mkclass(Pcl_let ($2, List.rev $3, $5)) }
 590 ;
 591 class_simple_expr:
 592     LBRACKET core_type_comma_list RBRACKET class_longident
 593       { mkclass(Pcl_constr($4, List.rev $2)) }
 594   | class_longident
 595       { mkclass(Pcl_constr($1, [])) }
 596   | OBJECT class_structure END
 597       { mkclass(Pcl_structure($2)) }
 598   | OBJECT class_structure error
 599       { unclosed "object" 1 "end" 3 }
 600   | LPAREN class_expr COLON class_type RPAREN
 601       { mkclass(Pcl_constraint($2, $4)) }
 602   | LPAREN class_expr COLON class_type error
 603       { unclosed "(" 1 ")" 5 }
 604   | LPAREN class_expr RPAREN
 605       { $2 }
 606   | LPAREN class_expr error
 607       { unclosed "(" 1 ")" 3 }
 608 ;
 609 class_structure:
 610     class_self_pattern class_fields
 611       { $1, List.rev $2 }
 612 ;
 613 class_self_pattern:
 614     LPAREN pattern RPAREN
 615       { reloc_pat $2 }
 616   | LPAREN pattern COLON core_type RPAREN
 617       { mkpat(Ppat_constraint($2, $4)) }
 618   | /* empty */
 619       { ghpat(Ppat_any) }
 620 ;
 621 class_fields:
 622     /* empty */
 623       { [] }
 624   | class_fields INHERIT class_expr parent_binder
 625       { Pcf_inher ($3, $4) :: $1 }
 626   | class_fields VAL virtual_value
 627       { Pcf_valvirt $3 :: $1 }
 628   | class_fields VAL value
 629       { Pcf_val $3 :: $1 }
 630   | class_fields virtual_method
 631       { Pcf_virt $2 :: $1 }
 632   | class_fields concrete_method
 633       { Pcf_meth $2 :: $1 }
 634   | class_fields CONSTRAINT constrain
 635       { Pcf_cstr $3 :: $1 }
 636   | class_fields INITIALIZER seq_expr
 637       { Pcf_init $3 :: $1 }
 638 ;
 639 parent_binder:
 640     AS LIDENT
 641           { Some $2 }
 642   | /* empty */
 643           { None }
 644 ;
 645 virtual_value:
 646     MUTABLE VIRTUAL label COLON core_type
 647       { $3, Mutable, $5, symbol_rloc () }
 648   | VIRTUAL mutable_flag label COLON core_type
 649       { $3, $2, $5, symbol_rloc () }
 650 ;
 651 value:
 652     mutable_flag label EQUAL seq_expr
 653       { $2, $1, $4, symbol_rloc () }
 654   | mutable_flag label type_constraint EQUAL seq_expr
 655       { $2, $1, (let (t, t') = $3 in ghexp(Pexp_constraint($5, t, t'))),
 656         symbol_rloc () }
 657 ;
 658 virtual_method:
 659     METHOD PRIVATE VIRTUAL label COLON poly_type
 660       { $4, Private, $6, symbol_rloc () }
 661   | METHOD VIRTUAL private_flag label COLON poly_type
 662       { $4, $3, $6, symbol_rloc () }
 663 ;
 664 concrete_method :
 665     METHOD private_flag label strict_binding
 666       { $3, $2, ghexp(Pexp_poly ($4, None)), symbol_rloc () }
 667   | METHOD private_flag label COLON poly_type EQUAL seq_expr
 668       { $3, $2, ghexp(Pexp_poly($7,Some $5)), symbol_rloc () }
 669 ;
 670
 671 /* Class types */
 672
 673 class_type:
 674     class_signature
 675       { $1 }
 676   | QUESTION LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
 677       { mkcty(Pcty_fun("?" ^ $2 ,
 678                        {ptyp_desc = Ptyp_constr(Lident "option", [$4]);
 679                         ptyp_loc = $4.ptyp_loc},
 680                        $6)) }
 681   | OPTLABEL simple_core_type_or_tuple MINUSGREATER class_type
 682       { mkcty(Pcty_fun("?" ^ $1 ,
 683                        {ptyp_desc = Ptyp_constr(Lident "option", [$2]);
 684                         ptyp_loc = $2.ptyp_loc},
 685                        $4)) }
 686   | LIDENT COLON simple_core_type_or_tuple MINUSGREATER class_type
 687       { mkcty(Pcty_fun($1, $3, $5)) }
 688   | simple_core_type_or_tuple MINUSGREATER class_type
 689       { mkcty(Pcty_fun("", $1, $3)) }
 690 ;
 691 class_signature:
 692     LBRACKET core_type_comma_list RBRACKET clty_longident
 693       { mkcty(Pcty_constr ($4, List.rev $2)) }
 694   | clty_longident
 695       { mkcty(Pcty_constr ($1, [])) }
 696   | OBJECT class_sig_body END
 697       { mkcty(Pcty_signature $2) }
 698   | OBJECT class_sig_body error
 699       { unclosed "object" 1 "end" 3 }
 700 ;
 701 class_sig_body:
 702     class_self_type class_sig_fields
 703       { $1, List.rev $2 }
 704 ;
 705 class_self_type:
 706     LPAREN core_type RPAREN
 707       { $2 }
 708   | /* empty */
 709       { mktyp(Ptyp_any) }
 710 ;
 711 class_sig_fields:
 712     /* empty */                                 { [] }
 713   | class_sig_fields INHERIT class_signature    { Pctf_inher $3 :: $1 }
 714   | class_sig_fields VAL value_type             { Pctf_val   $3 :: $1 }
 715   | class_sig_fields virtual_method             { Pctf_virt  $2 :: $1 }
 716   | class_sig_fields method_type                { Pctf_meth  $2 :: $1 }
 717   | class_sig_fields CONSTRAINT constrain       { Pctf_cstr  $3 :: $1 }
 718 ;
 719 value_type:
 720     VIRTUAL mutable_flag label COLON core_type
 721       { $3, $2, Virtual, $5, symbol_rloc () }
 722   | MUTABLE virtual_flag label COLON core_type
 723       { $3, Mutable, $2, $5, symbol_rloc () }
 724   | label COLON core_type
 725       { $1, Immutable, Concrete, $3, symbol_rloc () }
 726 ;
 727 method_type:
 728     METHOD private_flag label COLON poly_type
 729       { $3, $2, $5, symbol_rloc () }
 730 ;
 731 constrain:
 732         core_type EQUAL core_type          { $1, $3, symbol_rloc () }
 733 ;
 734 class_descriptions:
 735     class_descriptions AND class_description    { $3 :: $1 }
 736   | class_description                           { [$1] }
 737 ;
 738 class_description:
 739     virtual_flag class_type_parameters LIDENT COLON class_type
 740       { let params, variance = List.split (fst $2) in
 741         {pci_virt = $1; pci_params = params, snd $2;
 742          pci_name = $3; pci_expr = $5; pci_variance = variance;
 743          pci_loc = symbol_rloc ()} }
 744 ;
 745 class_type_declarations:
 746     class_type_declarations AND class_type_declaration  { $3 :: $1 }
 747   | class_type_declaration                              { [$1] }
 748 ;
 749 class_type_declaration:
 750     virtual_flag class_type_parameters LIDENT EQUAL class_signature
 751       { let params, variance = List.split (fst $2) in
 752         {pci_virt = $1; pci_params = params, snd $2;
 753          pci_name = $3; pci_expr = $5; pci_variance = variance;
 754          pci_loc = symbol_rloc ()} }
 755 ;
 756
 757 /* Core expressions */
 758
 759 seq_expr:
 760   | expr        %prec below_SEMI  { $1 }
 761   | expr SEMI                     { reloc_exp $1 }
 762   | expr SEMI seq_expr            { mkexp(Pexp_sequence($1, $3)) }
 763 ;
 764 labeled_simple_pattern:
 765     QUESTION LPAREN label_let_pattern opt_default RPAREN
 766       { ("?" ^ fst $3, $4, snd $3) }
 767   | QUESTION label_var
 768       { ("?" ^ fst $2, None, snd $2) }
 769   | OPTLABEL LPAREN let_pattern opt_default RPAREN
 770       { ("?" ^ $1, $4, $3) }
 771   | OPTLABEL pattern_var
 772       { ("?" ^ $1, None, $2) }
 773   | TILDE LPAREN label_let_pattern RPAREN
 774       { (fst $3, None, snd $3) }
 775   | TILDE label_var
 776       { (fst $2, None, snd $2) }
 777   | LABEL simple_pattern
 778       { ($1, None, $2) }
 779   | simple_pattern
 780       { ("", None, $1) }
 781 ;
 782 pattern_var:
 783     LIDENT            { mkpat(Ppat_var $1) }
 784   | UNDERSCORE        { mkpat Ppat_any }
 785 ;
 786 opt_default:
 787     /* empty */                         { None }
 788   | EQUAL seq_expr                      { Some $2 }
 789 ;
 790 label_let_pattern:
 791     label_var
 792       { $1 }
 793   | label_var COLON core_type
 794       { let (lab, pat) = $1 in (lab, mkpat(Ppat_constraint(pat, $3))) }
 795 ;
 796 label_var:
 797     LIDENT    { ($1, mkpat(Ppat_var $1)) }
 798 ;
 799 let_pattern:
 800     pattern
 801       { $1 }
 802   | pattern COLON core_type
 803       { mkpat(Ppat_constraint($1, $3)) }
 804 ;
 805 expr:
 806     simple_expr %prec below_SHARP
 807       { $1 }
 808   | simple_expr simple_labeled_expr_list
 809       { mkexp(Pexp_apply($1, List.rev $2)) }
 810   | LET rec_flag let_bindings IN seq_expr
 811       { mkexp(Pexp_let($2, List.rev $3, $5)) }
 812   | LET MODULE UIDENT module_binding IN seq_expr
 813       { mkexp(Pexp_letmodule($3, $4, $6)) }
 814   | FUNCTION opt_bar match_cases
 815       { mkexp(Pexp_function("", None, List.rev $3)) }
 816   | FUN labeled_simple_pattern fun_def
 817       { let (l,o,p) = $2 in mkexp(Pexp_function(l, o, [p, $3])) }
 818   | MATCH seq_expr WITH opt_bar match_cases
 819       { mkexp(Pexp_match($2, List.rev $5)) }
 820   | TRY seq_expr WITH opt_bar match_cases
 821       { mkexp(Pexp_try($2, List.rev $5)) }
 822   | TRY seq_expr WITH error
 823       { syntax_error() }
 824   | expr_comma_list %prec below_COMMA
 825       { mkexp(Pexp_tuple(List.rev $1)) }
 826   | constr_longident simple_expr %prec below_SHARP
 827       { mkexp(Pexp_construct($1, Some $2, false)) }
 828   | name_tag simple_expr %prec below_SHARP
 829       { mkexp(Pexp_variant($1, Some $2)) }
 830   | IF seq_expr THEN expr ELSE expr
 831       { mkexp(Pexp_ifthenelse($2, $4, Some $6)) }
 832   | IF seq_expr THEN expr
 833       { mkexp(Pexp_ifthenelse($2, $4, None)) }
 834   | WHILE seq_expr DO seq_expr DONE
 835       { mkexp(Pexp_while($2, $4)) }
 836   | FOR val_ident EQUAL seq_expr direction_flag seq_expr DO seq_expr DONE
 837       { mkexp(Pexp_for($2, $4, $6, $5, $8)) }
 838   | expr COLONCOLON expr
 839       { mkexp(Pexp_construct(Lident "::",
 840                              Some(ghexp(Pexp_tuple[$1;$3])),
 841                              false)) }
 842   | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN
 843       { mkexp(Pexp_construct(Lident "::",
 844                              Some(ghexp(Pexp_tuple[$5;$7])),
 845                              false)) }
 846   | expr INFIXOP0 expr
 847       { mkinfix $1 $2 $3 }
 848   | expr INFIXOP1 expr
 849       { mkinfix $1 $2 $3 }
 850   | expr INFIXOP2 expr
 851       { mkinfix $1 $2 $3 }
 852   | expr INFIXOP3 expr
 853       { mkinfix $1 $2 $3 }
 854   | expr INFIXOP4 expr
 855       { mkinfix $1 $2 $3 }
 856   | expr PLUS expr
 857       { mkinfix $1 "+" $3 }
 858   | expr MINUS expr
 859       { mkinfix $1 "-" $3 }
 860   | expr MINUSDOT expr
 861       { mkinfix $1 "-." $3 }
 862   | expr STAR expr
 863       { mkinfix $1 "*" $3 }
 864   | expr EQUAL expr
 865       { mkinfix $1 "=" $3 }
 866   | expr LESS expr
 867       { mkinfix $1 "<" $3 }
 868   | expr GREATER expr
 869       { mkinfix $1 ">" $3 }
 870   | expr OR expr
 871       { mkinfix $1 "or" $3 }
 872   | expr BARBAR expr
 873       { mkinfix $1 "||" $3 }
 874   | expr AMPERSAND expr
 875       { mkinfix $1 "&" $3 }
 876   | expr AMPERAMPER expr
 877       { mkinfix $1 "&&" $3 }
 878   | expr COLONEQUAL expr
 879       { mkinfix $1 ":=" $3 }
 880   | subtractive expr %prec prec_unary_minus
 881       { mkuminus $1 $2 }
 882   | simple_expr DOT label_longident LESSMINUS expr
 883       { mkexp(Pexp_setfield($1, $3, $5)) }
 884   | simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
 885       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "set")),
 886                          ["",$1; "",$4; "",$7])) }
 887   | simple_expr DOT LBRACKET seq_expr RBRACKET LESSMINUS expr
 888       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "set")),
 889                          ["",$1; "",$4; "",$7])) }
 890   | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
 891       { bigarray_set $1 $4 $7 }
 892   | label LESSMINUS expr
 893       { mkexp(Pexp_setinstvar($1, $3)) }
 894   | ASSERT simple_expr %prec below_SHARP
 895       { mkassert $2 }
 896   | LAZY simple_expr %prec below_SHARP
 897       { mkexp (Pexp_lazy ($2)) }
 898   | OBJECT class_structure END
 899       { mkexp (Pexp_object($2)) }
 900   | OBJECT class_structure error
 901       { unclosed "object" 1 "end" 3 }
 902 ;
 903 simple_expr:
 904     val_longident
 905       { mkexp(Pexp_ident $1) }
 906   | constant
 907       { mkexp(Pexp_constant $1) }
 908   | constr_longident %prec prec_constant_constructor
 909       { mkexp(Pexp_construct($1, None, false)) }
 910   | name_tag %prec prec_constant_constructor
 911       { mkexp(Pexp_variant($1, None)) }
 912   | LPAREN seq_expr RPAREN
 913       { reloc_exp $2 }
 914   | LPAREN seq_expr error
 915       { unclosed "(" 1 ")" 3 }
 916   | BEGIN seq_expr END
 917       { reloc_exp $2 }
 918   | BEGIN END
 919       { mkexp (Pexp_construct (Lident "()", None, false)) }
 920   | BEGIN seq_expr error
 921       { unclosed "begin" 1 "end" 3 }
 922   | LPAREN seq_expr type_constraint RPAREN
 923       { let (t, t') = $3 in mkexp(Pexp_constraint($2, t, t')) }
 924   | simple_expr DOT label_longident
 925       { mkexp(Pexp_field($1, $3)) }
 926   | simple_expr DOT LPAREN seq_expr RPAREN
 927       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "Array" "get")),
 928                          ["",$1; "",$4])) }
 929   | simple_expr DOT LPAREN seq_expr error
 930       { unclosed "(" 3 ")" 5 }
 931   | simple_expr DOT LBRACKET seq_expr RBRACKET
 932       { mkexp(Pexp_apply(ghexp(Pexp_ident(array_function "String" "get")),
 933                          ["",$1; "",$4])) }
 934   | simple_expr DOT LBRACKET seq_expr error
 935       { unclosed "[" 3 "]" 5 }
 936   | simple_expr DOT LBRACE expr RBRACE
 937       { bigarray_get $1 $4 }
 938   | simple_expr DOT LBRACE expr_comma_list error
 939       { unclosed "{" 3 "}" 5 }
 940   | LBRACE record_expr RBRACE
 941       { let (exten, fields) = $2 in mkexp(Pexp_record(fields, exten)) }
 942   | LBRACE record_expr error
 943       { unclosed "{" 1 "}" 3 }
 944   | LBRACKETBAR expr_semi_list opt_semi BARRBRACKET
 945       { mkexp(Pexp_array(List.rev $2)) }
 946   | LBRACKETBAR expr_semi_list opt_semi error
 947       { unclosed "[|" 1 "|]" 4 }
 948   | LBRACKETBAR BARRBRACKET
 949       { mkexp(Pexp_array []) }
 950   | LBRACKET expr_semi_list opt_semi RBRACKET
 951       { reloc_exp (mktailexp (List.rev $2)) }
 952   | LBRACKET expr_semi_list opt_semi error
 953       { unclosed "[" 1 "]" 4 }
 954   | PREFIXOP simple_expr
 955       { mkexp(Pexp_apply(mkoperator $1 1, ["",$2])) }
 956   | NEW class_longident
 957       { mkexp(Pexp_new($2)) }
 958   | LBRACELESS field_expr_list opt_semi GREATERRBRACE
 959       { mkexp(Pexp_override(List.rev $2)) }
 960   | LBRACELESS field_expr_list opt_semi error
 961       { unclosed "{<" 1 ">}" 4 }
 962   | LBRACELESS GREATERRBRACE
 963       { mkexp(Pexp_override []) }
 964   | simple_expr SHARP label
 965       { mkexp(Pexp_send($1, $3)) }
 966 ;
 967 simple_labeled_expr_list:
 968     labeled_simple_expr
 969       { [$1] }
 970   | simple_labeled_expr_list labeled_simple_expr
 971       { $2 :: $1 }
 972 ;
 973 labeled_simple_expr:
 974     simple_expr %prec below_SHARP
 975       { ("", $1) }
 976   | label_expr
 977       { $1 }
 978 ;
 979 label_expr:
 980     LABEL simple_expr %prec below_SHARP
 981       { ($1, $2) }
 982   | TILDE label_ident
 983       { $2 }
 984   | QUESTION label_ident
 985       { ("?" ^ fst $2, snd $2) }
 986   | OPTLABEL simple_expr %prec below_SHARP
 987       { ("?" ^ $1, $2) }
 988 ;
 989 label_ident:
 990     LIDENT   { ($1, mkexp(Pexp_ident(Lident $1))) }
 991 ;
 992 let_bindings:
 993     let_binding                                 { [$1] }
 994   | let_bindings AND let_binding                { $3 :: $1 }
 995 ;
 996 let_binding:
 997     val_ident fun_binding
 998       { ({ppat_desc = Ppat_var $1; ppat_loc = rhs_loc 1}, $2) }
 999   | pattern EQUAL seq_expr
1000       { ($1, $3) }
1001 ;
1002 fun_binding:
1003     strict_binding
1004       { $1 }
1005   | type_constraint EQUAL seq_expr
1006       { let (t, t') = $1 in ghexp(Pexp_constraint($3, t, t')) }
1007 ;
1008 strict_binding:
1009     EQUAL seq_expr
1010       { $2 }
1011   | labeled_simple_pattern fun_binding
1012       { let (l, o, p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
1013 ;
1014 match_cases:
1015     pattern match_action                        { [$1, $2] }
1016   | match_cases BAR pattern match_action        { ($3, $4) :: $1 }
1017 ;
1018 fun_def:
1019     match_action                                { $1 }
1020   | labeled_simple_pattern fun_def
1021       { let (l,o,p) = $1 in ghexp(Pexp_function(l, o, [p, $2])) }
1022 ;
1023 match_action:
1024     MINUSGREATER seq_expr                       { $2 }
1025   | WHEN seq_expr MINUSGREATER seq_expr         { mkexp(Pexp_when($2, $4)) }
1026 ;
1027 expr_comma_list:
1028     expr_comma_list COMMA expr                  { $3 :: $1 }
1029   | expr COMMA expr                             { [$3; $1] }
1030 ;
1031 record_expr:
1032     simple_expr WITH lbl_expr_list opt_semi     { (Some $1, List.rev $3) }
1033   | lbl_expr_list opt_semi                      { (None, List.rev $1) }
1034 ;
1035 lbl_expr_list:
1036     label_longident EQUAL expr
1037       { [$1,$3] }
1038   | lbl_expr_list SEMI label_longident EQUAL expr
1039       { ($3, $5) :: $1 }
1040 ;
1041 field_expr_list:
1042     label EQUAL expr
1043       { [$1,$3] }
1044   | field_expr_list SEMI label EQUAL expr
1045       { ($3, $5) :: $1 }
1046 ;
1047 expr_semi_list:
1048     expr                                        { [$1] }
1049   | expr_semi_list SEMI expr                    { $3 :: $1 }
1050 ;
1051 type_constraint:
1052     COLON core_type                             { (Some $2, None) }
1053   | COLON core_type COLONGREATER core_type      { (Some $2, Some $4) }
1054   | COLONGREATER core_type                      { (None, Some $2) }
1055   | COLON error                                 { syntax_error() }
1056   | COLONGREATER error                          { syntax_error() }
1057 ;
1058
1059 /* Patterns */
1060
1061 pattern:
1062     simple_pattern
1063       { $1 }
1064   | pattern AS val_ident
1065       { mkpat(Ppat_alias($1, $3)) }
1066   | pattern_comma_list  %prec below_COMMA
1067       { mkpat(Ppat_tuple(List.rev $1)) }
1068   | constr_longident pattern %prec prec_constr_appl
1069       { mkpat(Ppat_construct($1, Some $2, false)) }
1070   | name_tag pattern %prec prec_constr_appl
1071       { mkpat(Ppat_variant($1, Some $2)) }
1072   | pattern COLONCOLON pattern
1073       { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
1074                              false)) }
1075   | LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
1076       { mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
1077                              false)) }
1078   | pattern BAR pattern
1079       { mkpat(Ppat_or($1, $3)) }
1080 ;
1081 simple_pattern:
1082     val_ident %prec below_EQUAL
1083       { mkpat(Ppat_var $1) }
1084   | UNDERSCORE
1085       { mkpat(Ppat_any) }
1086   | signed_constant
1087       { mkpat(Ppat_constant $1) }
1088   | CHAR DOTDOT CHAR
1089       { mkrangepat $1 $3 }
1090   | constr_longident
1091       { mkpat(Ppat_construct($1, None, false)) }
1092   | name_tag
1093       { mkpat(Ppat_variant($1, None)) }
1094   | SHARP type_longident
1095       { mkpat(Ppat_type $2) }
1096   | LBRACE lbl_pattern_list opt_semi RBRACE
1097       { mkpat(Ppat_record(List.rev $2)) }
1098   | LBRACE lbl_pattern_list opt_semi error
1099       { unclosed "{" 1 "}" 4 }
1100   | LBRACKET pattern_semi_list opt_semi RBRACKET
1101       { reloc_pat (mktailpat (List.rev $2)) }
1102   | LBRACKET pattern_semi_list opt_semi error
1103       { unclosed "[" 1 "]" 4 }
1104   | LBRACKETBAR pattern_semi_list opt_semi BARRBRACKET
1105       { mkpat(Ppat_array(List.rev $2)) }
1106   | LBRACKETBAR BARRBRACKET
1107       { mkpat(Ppat_array []) }
1108   | LBRACKETBAR pattern_semi_list opt_semi error
1109       { unclosed "[|" 1 "|]" 4 }
1110   | LPAREN pattern RPAREN
1111       { reloc_pat $2 }
1112   | LPAREN pattern error
1113       { unclosed "(" 1 ")" 3 }
1114   | LPAREN pattern COLON core_type RPAREN
1115       { mkpat(Ppat_constraint($2, $4)) }
1116   | LPAREN pattern COLON core_type error
1117       { unclosed "(" 1 ")" 5 }
1118 ;
1119
1120 pattern_comma_list:
1121     pattern_comma_list COMMA pattern            { $3 :: $1 }
1122   | pattern COMMA pattern                       { [$3; $1] }
1123 ;
1124 pattern_semi_list:
1125     pattern                                     { [$1] }
1126   | pattern_semi_list SEMI pattern              { $3 :: $1 }
1127 ;
1128 lbl_pattern_list:
1129     label_longident EQUAL pattern               { [($1, $3)] }
1130   | lbl_pattern_list SEMI label_longident EQUAL pattern { ($3, $5) :: $1 }
1131 ;
1132
1133 /* Primitive declarations */
1134
1135 primitive_declaration:
1136     STRING                                      { [$1] }
1137   | STRING primitive_declaration                { $1 :: $2 }
1138 ;
1139
1140 /* Type declarations */
1141
1142 type_declarations:
1143     type_declaration                            { [$1] }
1144   | type_declarations AND type_declaration      { $3 :: $1 }
1145 ;
1146
1147 type_declaration:
1148     type_parameters LIDENT type_kind constraints
1149       { let (params, variance) = List.split $1 in
1150         let (kind, manifest) = $3 in
1151         ($2, {ptype_params = params;
1152               ptype_cstrs = List.rev $4;
1153               ptype_kind = kind;
1154               ptype_manifest = manifest;
1155               ptype_variance = variance;
1156               ptype_loc = symbol_rloc()}) }
1157 ;
1158 constraints:
1159         constraints CONSTRAINT constrain        { $3 :: $1 }
1160       | /* empty */                             { [] }
1161 ;
1162 type_kind:
1163     /*empty*/
1164       { (Ptype_abstract, None) }
1165   | EQUAL core_type
1166       { (Ptype_abstract, Some $2) }
1167   | EQUAL constructor_declarations
1168       { (Ptype_variant(List.rev $2, Public), None) }
1169   | EQUAL PRIVATE constructor_declarations
1170       { (Ptype_variant(List.rev $3, Private), None) }
1171   | EQUAL private_flag BAR constructor_declarations
1172       { (Ptype_variant(List.rev $4, $2), None) }
1173   | EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
1174       { (Ptype_record(List.rev $4, $2), None) }
1175   | EQUAL core_type EQUAL private_flag opt_bar constructor_declarations
1176       { (Ptype_variant(List.rev $6, $4), Some $2) }
1177   | EQUAL core_type EQUAL private_flag LBRACE label_declarations opt_semi RBRACE
1178       { (Ptype_record(List.rev $6, $4), Some $2) }
1179   | EQUAL PRIVATE core_type
1180       { (Ptype_private, Some $3) }
1181 ;
1182 type_parameters:
1183     /*empty*/                                   { [] }
1184   | type_parameter                              { [$1] }
1185   | LPAREN type_parameter_list RPAREN           { List.rev $2 }
1186 ;
1187 type_parameter:
1188     type_variance QUOTE ident                   { $3, $1 }
1189 ;
1190 type_variance:
1191     /* empty */                                 { false, false }
1192   | PLUS                                        { true, false }
1193   | MINUS                                       { false, true }
1194 ;
1195 type_parameter_list:
1196     type_parameter                              { [$1] }
1197   | type_parameter_list COMMA type_parameter    { $3 :: $1 }
1198 ;
1199 constructor_declarations:
1200     constructor_declaration                     { [$1] }
1201   | constructor_declarations BAR constructor_declaration { $3 :: $1 }
1202 ;
1203 constructor_declaration:
1204     constr_ident constructor_arguments          { ($1, $2, symbol_rloc()) }
1205 ;
1206 constructor_arguments:
1207     /*empty*/                                   { [] }
1208   | OF core_type_list                           { List.rev $2 }
1209 ;
1210 label_declarations:
1211     label_declaration                           { [$1] }
1212   | label_declarations SEMI label_declaration   { $3 :: $1 }
1213 ;
1214 label_declaration:
1215     mutable_flag label COLON poly_type          { ($2, $1, $4, symbol_rloc()) }
1216 ;
1217
1218 /* "with" constraints (additional type equations over signature components) */
1219
1220 with_constraints:
1221     with_constraint                             { [$1] }
1222   | with_constraints AND with_constraint        { $3 :: $1 }
1223 ;
1224 with_constraint:
1225     TYPE type_parameters label_longident with_type_binder core_type constraints
1226       { let params, variance = List.split $2 in
1227         ($3, Pwith_type {ptype_params = params;
1228                          ptype_cstrs = List.rev $6;
1229                          ptype_kind = $4;
1230                          ptype_manifest = Some $5;
1231                          ptype_variance = variance;
1232                          ptype_loc = symbol_rloc()}) }
1233     /* used label_longident instead of type_longident to disallow
1234        functor applications in type path */
1235   | MODULE mod_longident EQUAL mod_ext_longident
1236       { ($2, Pwith_module $4) }
1237 ;
1238 with_type_binder:
1239     EQUAL          { Ptype_abstract }
1240   | EQUAL PRIVATE  { Ptype_private }
1241 ;
1242
1243 /* Polymorphic types */
1244
1245 typevar_list:
1246         QUOTE ident                             { [$2] }
1247       | typevar_list QUOTE ident                { $3 :: $1 }
1248 ;
1249 poly_type:
1250         core_type
1251           { mktyp(Ptyp_poly([], $1)) }
1252       | typevar_list DOT core_type
1253           { mktyp(Ptyp_poly(List.rev $1, $3)) }
1254 ;
1255
1256 /* Core types */
1257
1258 core_type:
1259     core_type2
1260       { $1 }
1261   | core_type2 AS QUOTE ident
1262       { mktyp(Ptyp_alias($1, $4)) }
1263 ;
1264 core_type2:
1265     simple_core_type_or_tuple
1266       { $1 }
1267   | QUESTION LIDENT COLON core_type2 MINUSGREATER core_type2
1268       { mktyp(Ptyp_arrow("?" ^ $2 ,
1269                {ptyp_desc = Ptyp_constr(Lident "option", [$4]);
1270                 ptyp_loc = $4.ptyp_loc}, $6)) }
1271   | OPTLABEL core_type2 MINUSGREATER core_type2
1272       { mktyp(Ptyp_arrow("?" ^ $1 ,
1273                {ptyp_desc = Ptyp_constr(Lident "option", [$2]);
1274                 ptyp_loc = $2.ptyp_loc}, $4)) }
1275   | LIDENT COLON core_type2 MINUSGREATER core_type2
1276       { mktyp(Ptyp_arrow($1, $3, $5)) }
1277   | core_type2 MINUSGREATER core_type2
1278       { mktyp(Ptyp_arrow("", $1, $3)) }
1279 ;
1280
1281 simple_core_type:
1282     simple_core_type2  %prec below_SHARP
1283       { $1 }
1284   | LPAREN core_type_comma_list RPAREN %prec below_SHARP
1285       { match $2 with [sty] -> sty | _ -> raise Parse_error }
1286 ;
1287 simple_core_type2:
1288     QUOTE ident
1289       { mktyp(Ptyp_var $2) }
1290   | UNDERSCORE
1291       { mktyp(Ptyp_any) }
1292   | type_longident
1293       { mktyp(Ptyp_constr($1, [])) }
1294   | simple_core_type2 type_longident
1295       { mktyp(Ptyp_constr($2, [$1])) }
1296   | LPAREN core_type_comma_list RPAREN type_longident
1297       { mktyp(Ptyp_constr($4, List.rev $2)) }
1298   | LESS meth_list GREATER
1299       { mktyp(Ptyp_object $2) }
1300   | LESS GREATER
1301       { mktyp(Ptyp_object []) }
1302   | SHARP class_longident opt_present
1303       { mktyp(Ptyp_class($2, [], $3)) }
1304   | simple_core_type2 SHARP class_longident opt_present
1305       { mktyp(Ptyp_class($3, [$1], $4)) }
1306   | LPAREN core_type_comma_list RPAREN SHARP class_longident opt_present
1307       { mktyp(Ptyp_class($5, List.rev $2, $6)) }
1308   | LBRACKET tag_field RBRACKET
1309       { mktyp(Ptyp_variant([$2], true, None)) }
1310 /* PR#3835: this is not LR(1), would need lookahead=2
1311   | LBRACKET simple_core_type2 RBRACKET
1312       { mktyp(Ptyp_variant([$2], true, None)) }
1313 */
1314   | LBRACKET BAR row_field_list RBRACKET
1315       { mktyp(Ptyp_variant(List.rev $3, true, None)) }
1316   | LBRACKET row_field BAR row_field_list RBRACKET
1317       { mktyp(Ptyp_variant($2 :: List.rev $4, true, None)) }
1318   | LBRACKETGREATER opt_bar row_field_list RBRACKET
1319       { mktyp(Ptyp_variant(List.rev $3, false, None)) }
1320   | LBRACKETGREATER RBRACKET
1321       { mktyp(Ptyp_variant([], false, None)) }
1322   | LBRACKETLESS opt_bar row_field_list RBRACKET
1323       { mktyp(Ptyp_variant(List.rev $3, true, Some [])) }
1324   | LBRACKETLESS opt_bar row_field_list GREATER name_tag_list RBRACKET
1325       { mktyp(Ptyp_variant(List.rev $3, true, Some (List.rev $5))) }
1326 ;
1327 row_field_list:
1328     row_field                                   { [$1] }
1329   | row_field_list BAR row_field                { $3 :: $1 }
1330 ;
1331 row_field:
1332     tag_field                                   { $1 }
1333   | simple_core_type2                           { Rinherit $1 }
1334 ;
1335 tag_field:
1336     name_tag OF opt_ampersand amper_type_list
1337       { Rtag ($1, $3, List.rev $4) }
1338   | name_tag
1339       { Rtag ($1, true, []) }
1340 ;
1341 opt_ampersand:
1342     AMPERSAND                                   { true }
1343   | /* empty */                                 { false }
1344 ;
1345 amper_type_list:
1346     core_type                                   { [$1] }
1347   | amper_type_list AMPERSAND core_type         { $3 :: $1 }
1348 ;
1349 opt_present:
1350     LBRACKETGREATER name_tag_list RBRACKET      { List.rev $2 }
1351   | /* empty */                                 { [] }
1352 ;
1353 name_tag_list:
1354     name_tag                                    { [$1] }
1355   | name_tag_list name_tag                      { $2 :: $1 }
1356 ;
1357 simple_core_type_or_tuple:
1358     simple_core_type                            { $1 }
1359   | simple_core_type STAR core_type_list
1360       { mktyp(Ptyp_tuple($1 :: List.rev $3)) }
1361 ;
1362 core_type_comma_list:
1363     core_type                                   { [$1] }
1364   | core_type_comma_list COMMA core_type        { $3 :: $1 }
1365 ;
1366 core_type_list:
1367     simple_core_type                            { [$1] }
1368   | core_type_list STAR simple_core_type        { $3 :: $1 }
1369 ;
1370 meth_list:
1371     field SEMI meth_list                        { $1 :: $3 }
1372   | field opt_semi                              { [$1] }
1373   | DOTDOT                                      { [mkfield Pfield_var] }
1374 ;
1375 field:
1376     label COLON poly_type                       { mkfield(Pfield($1, $3)) }
1377 ;
1378 label:
1379     LIDENT                                      { $1 }
1380 ;
1381
1382 /* Constants */
1383
1384 constant:
1385     INT                                         { Const_int $1 }
1386   | CHAR                                        { Const_char $1 }
1387   | STRING                                      { Const_string $1 }
1388   | FLOAT                                       { Const_float $1 }
1389   | INT32                                       { Const_int32 $1 }
1390   | INT64                                       { Const_int64 $1 }
1391   | NATIVEINT                                   { Const_nativeint $1 }
1392 ;
1393 signed_constant:
1394     constant                                    { $1 }
1395   | MINUS INT                                   { Const_int(- $2) }
1396   | MINUS FLOAT                                 { Const_float("-" ^ $2) }
1397   | MINUS INT32                                 { Const_int32(Int32.neg $2) }
1398   | MINUS INT64                                 { Const_int64(Int64.neg $2) }
1399   | MINUS NATIVEINT                             { Const_nativeint(Nativeint.neg $2) }
1400 ;
1401 /* Identifiers and long identifiers */
1402
1403 ident:
1404     UIDENT                                      { $1 }
1405   | LIDENT                                      { $1 }
1406 ;
1407 val_ident:
1408     LIDENT                                      { $1 }
1409   | LPAREN operator RPAREN                      { $2 }
1410 ;
1411 operator:
1412     PREFIXOP                                    { $1 }
1413   | INFIXOP0                                    { $1 }
1414   | INFIXOP1                                    { $1 }
1415   | INFIXOP2                                    { $1 }
1416   | INFIXOP3                                    { $1 }
1417   | INFIXOP4                                    { $1 }
1418   | PLUS                                        { "+" }
1419   | MINUS                                       { "-" }
1420   | MINUSDOT                                    { "-." }
1421   | STAR                                        { "*" }
1422   | EQUAL                                       { "=" }
1423   | LESS                                        { "<" }
1424   | GREATER                                     { ">" }
1425   | OR                                          { "or" }
1426   | BARBAR                                      { "||" }
1427   | AMPERSAND                                   { "&" }
1428   | AMPERAMPER                                  { "&&" }
1429   | COLONEQUAL                                  { ":=" }
1430 ;
1431 constr_ident:
1432     UIDENT                                      { $1 }
1433 /*  | LBRACKET RBRACKET                           { "[]" } */
1434   | LPAREN RPAREN                               { "()" }
1435   | COLONCOLON                                  { "::" }
1436 /*  | LPAREN COLONCOLON RPAREN                    { "::" } */
1437   | FALSE                                       { "false" }
1438   | TRUE                                        { "true" }
1439 ;
1440
1441 val_longident:
1442     val_ident                                   { Lident $1 }
1443   | mod_longident DOT val_ident                 { Ldot($1, $3) }
1444 ;
1445 constr_longident:
1446     mod_longident       %prec below_DOT         { $1 }
1447   | LBRACKET RBRACKET                           { Lident "[]" }
1448   | LPAREN RPAREN                               { Lident "()" }
1449   | FALSE                                       { Lident "false" }
1450   | TRUE                                        { Lident "true" }
1451 ;
1452 label_longident:
1453     LIDENT                                      { Lident $1 }
1454   | mod_longident DOT LIDENT                    { Ldot($1, $3) }
1455 ;
1456 type_longident:
1457     LIDENT                                      { Lident $1 }
1458   | mod_ext_longident DOT LIDENT                { Ldot($1, $3) }
1459 ;
1460 mod_longident:
1461     UIDENT                                      { Lident $1 }
1462   | mod_longident DOT UIDENT                    { Ldot($1, $3) }
1463 ;
1464 mod_ext_longident:
1465     UIDENT                                      { Lident $1 }
1466   | mod_ext_longident DOT UIDENT                { Ldot($1, $3) }
1467   | mod_ext_longident LPAREN mod_ext_longident RPAREN { Lapply($1, $3) }
1468 ;
1469 mty_longident:
1470     ident                                       { Lident $1 }
1471   | mod_ext_longident DOT ident                 { Ldot($1, $3) }
1472 ;
1473 clty_longident:
1474     LIDENT                                      { Lident $1 }
1475   | mod_ext_longident DOT LIDENT                { Ldot($1, $3) }
1476 ;
1477 class_longident:
1478     LIDENT                                      { Lident $1 }
1479   | mod_longident DOT LIDENT                    { Ldot($1, $3) }
1480 ;
1481
1482 /* Toplevel directives */
1483
1484 toplevel_directive:
1485     SHARP ident                 { Ptop_dir($2, Pdir_none) }
1486   | SHARP ident STRING          { Ptop_dir($2, Pdir_string $3) }
1487   | SHARP ident INT             { Ptop_dir($2, Pdir_int $3) }
1488   | SHARP ident val_longident   { Ptop_dir($2, Pdir_ident $3) }
1489   | SHARP ident FALSE           { Ptop_dir($2, Pdir_bool false) }
1490   | SHARP ident TRUE            { Ptop_dir($2, Pdir_bool true) }
1491 ;
1492
1493 /* Miscellaneous */
1494
1495 name_tag:
1496     BACKQUOTE ident                             { $2 }
1497 ;
1498 rec_flag:
1499     /* empty */                                 { Nonrecursive }
1500   | REC                                         { Recursive }
1501 ;
1502 direction_flag:
1503     TO                                          { Upto }
1504   | DOWNTO                                      { Downto }
1505 ;
1506 private_flag:
1507     /* empty */                                 { Public }
1508   | PRIVATE                                     { Private }
1509 ;
1510 mutable_flag:
1511     /* empty */                                 { Immutable }
1512   | MUTABLE                                     { Mutable }
1513 ;
1514 virtual_flag:
1515     /* empty */                                 { Concrete }
1516   | VIRTUAL                                     { Virtual }
1517 ;
1518 opt_bar:
1519     /* empty */                                 { () }
1520   | BAR                                         { () }
1521 ;
1522 opt_semi:
1523   | /* empty */                                 { () }
1524   | SEMI                                        { () }
1525 ;
1526 subtractive:
1527   | MINUS                                       { "-" }
1528   | MINUSDOT                                    { "-." }
1529 ;
1530 %%