ocaml.opp.exp 95.6 KB
Newer Older
1
File "ocaml.mly", line 529, characters 29-36:
2
Warning: the token COMMENT is unused.
3
File "ocaml.mly", line 530, characters 30-39:
4
Warning: the token DOCSTRING is unused.
5
File "ocaml.mly", line 532, characters 7-10:
6
Warning: the token EOL is unused.
7
File "ocaml.mly", line 448, characters 7-22:
8 9 10 11 12 13
Warning: the token GREATERRBRACKET is unused.
%{
open Location
open Asttypes
open Longident
open Parsetree
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
open Ast_helper
open Docstrings

let mktyp d = Typ.mk ~loc:(symbol_rloc()) d
let mkpat d = Pat.mk ~loc:(symbol_rloc()) d
let mkexp d = Exp.mk ~loc:(symbol_rloc()) d
let mkmty d = Mty.mk ~loc:(symbol_rloc()) d
let mksig d = Sig.mk ~loc:(symbol_rloc()) d
let mkmod d = Mod.mk ~loc:(symbol_rloc()) d
let mkstr d = Str.mk ~loc:(symbol_rloc()) d
let mkclass d = Cl.mk ~loc:(symbol_rloc()) d
let mkcty d = Cty.mk ~loc:(symbol_rloc()) d
let mkctf ?attrs ?docs d =
  Ctf.mk ~loc:(symbol_rloc()) ?attrs ?docs d
let mkcf ?attrs ?docs d =
  Cf.mk ~loc:(symbol_rloc()) ?attrs ?docs d

let mkrhs rhs pos = mkloc rhs (rhs_loc pos)
32 33 34 35 36

let reloc_pat x = { x with ppat_loc = symbol_rloc () };;
let reloc_exp x = { x with pexp_loc = symbol_rloc () };;

let mkoperator name pos =
37 38 39 40 41
  let loc = rhs_loc pos in
  Exp.mk ~loc (Pexp_ident(mkloc (Lident name) loc))

let mkpatvar name pos =
  Pat.mk ~loc:(rhs_loc pos) (Ppat_var (mkrhs name pos))
42 43 44

(*
  Ghost expressions and patterns:
45
  expressions and patterns that do not appear explicitly in the
46 47
  source file they have the loc_ghost flag set to true.
  Then the profiler will not try to instrument them and the
48
  -annot option will not try to display their type.
49 50 51 52 53 54 55 56 57 58 59

  Every grammar rule that generates an element with a location must
  make at most one non-ghost element, the topmost one.

  How to tell whether your location must be ghost:
  A location corresponds to a range of characters in the source file.
  If the location contains a piece of code that is syntactically
  valid (according to the documentation), and corresponds to the
  AST node, then the location must be real; in all other cases,
  it must be ghost.
*)
60 61 62 63 64
let ghexp d = Exp.mk ~loc:(symbol_gloc ()) d
let ghpat d = Pat.mk ~loc:(symbol_gloc ()) d
let ghtyp d = Typ.mk ~loc:(symbol_gloc ()) d
let ghloc d = { txt = d; loc = symbol_gloc () }
let ghstr d = Str.mk ~loc:(symbol_gloc()) d
65 66

let mkinfix arg1 name arg2 =
67
  mkexp(Pexp_apply(mkoperator name 2, [Nolabel, arg1; Nolabel, arg2]))
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83

let neg_float_string f =
  if String.length f > 0 && f.[0] = '-'
  then String.sub f 1 (String.length f - 1)
  else "-" ^ f

let mkuminus name arg =
  match name, arg.pexp_desc with
  | "-", Pexp_constant(Const_int n) ->
      mkexp(Pexp_constant(Const_int(-n)))
  | "-", Pexp_constant(Const_int32 n) ->
      mkexp(Pexp_constant(Const_int32(Int32.neg n)))
  | "-", Pexp_constant(Const_int64 n) ->
      mkexp(Pexp_constant(Const_int64(Int64.neg n)))
  | "-", Pexp_constant(Const_nativeint n) ->
      mkexp(Pexp_constant(Const_nativeint(Nativeint.neg n)))
84
  | ("-" | "-."), Pexp_constant(Const_float f) ->
85 86
      mkexp(Pexp_constant(Const_float(neg_float_string f)))
  | _ ->
87 88 89 90 91 92 93 94 95 96 97 98
      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))

let mkuplus name arg =
  let desc = arg.pexp_desc in
  match name, desc with
  | "+", Pexp_constant(Const_int _)
  | "+", Pexp_constant(Const_int32 _)
  | "+", Pexp_constant(Const_int64 _)
  | "+", Pexp_constant(Const_nativeint _)
  | ("+" | "+."), Pexp_constant(Const_float _) -> mkexp desc
  | _ ->
      mkexp(Pexp_apply(mkoperator ("~" ^ name) 1, [Nolabel, arg]))
99

100 101 102 103 104 105 106
let mkexp_cons consloc args loc =
  Exp.mk ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args))

let mkpat_cons consloc args loc =
  Pat.mk ~loc (Ppat_construct(mkloc (Lident "::") consloc, Some args))

let rec mktailexp nilloc = function
107
    [] ->
108 109 110
      let loc = { nilloc with loc_ghost = true } in
      let nil = { txt = Lident "[]"; loc = loc } in
      Exp.mk ~loc (Pexp_construct (nil, None))
111
  | e1 :: el ->
112 113
      let exp_el = mktailexp nilloc el in
      let loc = {loc_start = e1.pexp_loc.loc_start;
114 115 116
               loc_end = exp_el.pexp_loc.loc_end;
               loc_ghost = true}
      in
117 118
      let arg = Exp.mk ~loc (Pexp_tuple [e1; exp_el]) in
      mkexp_cons {loc with loc_ghost = true} arg loc
119

120
let rec mktailpat nilloc = function
121
    [] ->
122 123 124
      let loc = { nilloc with loc_ghost = true } in
      let nil = { txt = Lident "[]"; loc = loc } in
      Pat.mk ~loc (Ppat_construct (nil, None))
125
  | p1 :: pl ->
126 127
      let pat_pl = mktailpat nilloc pl in
      let loc = {loc_start = p1.ppat_loc.loc_start;
128 129 130
               loc_end = pat_pl.ppat_loc.loc_end;
               loc_ghost = true}
      in
131 132
      let arg = Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in
      mkpat_cons {loc with loc_ghost = true} arg loc
133

134 135
let mkstrexp e attrs =
  { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc }
136

137 138 139 140 141
let mkexp_constraint e (t1, t2) =
  match t1, t2 with
  | Some t, None -> ghexp(Pexp_constraint(e, t))
  | _, Some t -> ghexp(Pexp_coerce(e, t1, t))
  | None, None -> assert false
142

143 144 145 146 147 148 149 150
let mkexp_opt_constraint e = function
  | None -> e
  | Some constraint_ -> mkexp_constraint e constraint_

let mkpat_opt_constraint p = function
  | None -> p
  | Some typ -> mkpat (Ppat_constraint(p, typ))

151 152 153
let array_function par assign=
  let op = if assign then par^"<-" else par in
  ghloc ( Lident op )
154 155 156 157 158 159 160 161

let syntax_error () =
  raise Syntaxerr.Escape_error

let unclosed opening_name opening_num closing_name closing_num =
  raise(Syntaxerr.Error(Syntaxerr.Unclosed(rhs_loc opening_num, opening_name,
                                           rhs_loc closing_num, closing_name)))

162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
let expecting pos nonterm =
    raise Syntaxerr.(Error(Expecting(rhs_loc pos, nonterm)))

let not_expecting pos nonterm =
    raise Syntaxerr.(Error(Not_expecting(rhs_loc pos, nonterm)))

let bigarray_function order assign =
  let op =
    match order with
      | 1 -> ".{}"
      | 2 -> ".{,}"
      | 3 -> ".{,,}"
      | _ -> ".{,..,}"
  in
  let op= if assign then op^"<-" else op in
  ghloc ( Lident op )
178 179

let bigarray_untuplify = function
180
    { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
181 182 183
  | exp -> [exp]

let bigarray_get arr arg =
184
  let get order = bigarray_function order false in
185 186
  match bigarray_untuplify arg with
    [c1] ->
187 188
      mkexp(Pexp_apply(ghexp(Pexp_ident(get 1)),
                       [Nolabel, arr; Nolabel, c1]))
189
  | [c1;c2] ->
190 191
      mkexp(Pexp_apply(ghexp(Pexp_ident(get 2)),
                       [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
192
  | [c1;c2;c3] ->
193 194
      mkexp(Pexp_apply(ghexp(Pexp_ident(get 3)),
                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
195
  | coords ->
196 197
      mkexp(Pexp_apply(ghexp(Pexp_ident(get 0)),
                       [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
198 199

let bigarray_set arr arg newval =
200
  let set order = bigarray_function order true in
201 202
  match bigarray_untuplify arg with
    [c1] ->
203 204
      mkexp(Pexp_apply(ghexp(Pexp_ident(set 1)),
                       [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
205
  | [c1;c2] ->
206 207 208
      mkexp(Pexp_apply(ghexp(Pexp_ident(set 2)),
                       [Nolabel, arr; Nolabel, c1; Nolabel, c2;
                        Nolabel, newval]))
209
  | [c1;c2;c3] ->
210 211 212
      mkexp(Pexp_apply(ghexp(Pexp_ident(set 3)),
                       [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3;
                        Nolabel, newval]))
213
  | coords ->
214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
      mkexp(Pexp_apply(ghexp(Pexp_ident(set 0)),
                       [Nolabel, arr;
                        Nolabel, ghexp(Pexp_array coords);
                        Nolabel, newval]))

let lapply p1 p2 =
  if !Clflags.applicative_functors
  then Lapply(p1, p2)
  else raise (Syntaxerr.Error(Syntaxerr.Applicative_path (symbol_rloc())))

let exp_of_label lbl pos =
  mkexp (Pexp_ident(mkrhs (Lident(Longident.last lbl)) pos))

let pat_of_label lbl pos =
  mkpat (Ppat_var (mkrhs (Longident.last lbl) pos))

let check_variable vl loc v =
  if List.mem v vl then
    raise Syntaxerr.(Error(Variable_in_scope(loc,v)))

let varify_constructors var_names t =
  let rec loop t =
    let desc =
      match t.ptyp_desc with
      | Ptyp_any -> Ptyp_any
      | Ptyp_var x ->
          check_variable var_names t.ptyp_loc x;
          Ptyp_var x
      | Ptyp_arrow (label,core_type,core_type') ->
          Ptyp_arrow(label, loop core_type, loop core_type')
      | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst)
      | Ptyp_constr( { txt = Lident s }, []) when List.mem s var_names ->
          Ptyp_var s
      | Ptyp_constr(longident, lst) ->
          Ptyp_constr(longident, List.map loop lst)
      | Ptyp_object (lst, o) ->
          Ptyp_object
            (List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o)
      | Ptyp_class (longident, lst) ->
          Ptyp_class (longident, List.map loop lst)
      | Ptyp_alias(core_type, string) ->
          check_variable var_names t.ptyp_loc string;
          Ptyp_alias(loop core_type, string)
      | Ptyp_variant(row_field_list, flag, lbl_lst_option) ->
          Ptyp_variant(List.map loop_row_field row_field_list,
                       flag, lbl_lst_option)
      | Ptyp_poly(string_lst, core_type) ->
          List.iter (check_variable var_names t.ptyp_loc) string_lst;
          Ptyp_poly(string_lst, loop core_type)
      | Ptyp_package(longident,lst) ->
          Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst)
      | Ptyp_extension (s, arg) ->
          Ptyp_extension (s, arg)
    in
    {t with ptyp_desc = desc}
  and loop_row_field  =
    function
      | Rtag(label,attrs,flag,lst) ->
          Rtag(label,attrs,flag,List.map loop lst)
      | Rinherit t ->
          Rinherit (loop t)
  in
  loop t

let mk_newtypes newtypes exp =
  List.fold_right (fun newtype exp -> mkexp (Pexp_newtype (newtype, exp)))
    newtypes exp

let wrap_type_annotation newtypes core_type body =
  let exp = mkexp(Pexp_constraint(body,core_type)) in
  let exp = mk_newtypes newtypes exp in
  (exp, ghtyp(Ptyp_poly(newtypes,varify_constructors newtypes core_type)))

let wrap_exp_attrs body (ext, attrs) =
  (* todo: keep exact location for the entire attribute *)
  let body = {body with pexp_attributes = attrs @ body.pexp_attributes} in
  match ext with
  | None -> body
  | Some id -> ghexp(Pexp_extension (id, PStr [mkstrexp body []]))

let mkexp_attrs d attrs =
  wrap_exp_attrs (mkexp d) attrs

let text_str pos = Str.text (rhs_text pos)
let text_sig pos = Sig.text (rhs_text pos)
let text_cstr pos = Cf.text (rhs_text pos)
let text_csig pos = Ctf.text (rhs_text pos)
let text_def pos = [Ptop_def (Str.text (rhs_text pos))]

let extra_text text pos items =
  let pre_extras = rhs_pre_extra_text pos in
  let post_extras = rhs_post_extra_text pos in
    text pre_extras @ items @ text post_extras

let extra_str pos items = extra_text Str.text pos items
let extra_sig pos items = extra_text Sig.text pos items
let extra_cstr pos items = extra_text Cf.text pos items
let extra_csig pos items = extra_text Ctf.text pos items
let extra_def pos items =
  extra_text (fun txt -> [Ptop_def (Str.text txt)]) pos items

type let_binding =
  { lb_pattern: pattern;
    lb_expression: expression;
    lb_attributes: attributes;
    lb_docs: docs Lazy.t;
    lb_text: text Lazy.t;
    lb_loc: Location.t; }

type let_bindings =
  { lbs_bindings: let_binding list;
    lbs_rec: rec_flag;
    lbs_extension: string Asttypes.loc option;
    lbs_attributes: attributes;
    lbs_loc: Location.t }

let mklb (p, e) attrs =
  { lb_pattern = p;
    lb_expression = e;
    lb_attributes = attrs;
    lb_docs = symbol_docs_lazy ();
    lb_text = symbol_text_lazy ();
    lb_loc = symbol_rloc (); }

let mklbs (ext, attrs) rf lb =
  { lbs_bindings = [lb];
    lbs_rec = rf;
    lbs_extension = ext ;
    lbs_attributes = attrs;
    lbs_loc = symbol_rloc (); }

let addlb lbs lb =
  { lbs with lbs_bindings = lb :: lbs.lbs_bindings }

let val_of_let_bindings lbs =
  let str =
    match lbs.lbs_bindings with
    | [ {lb_pattern = { ppat_desc = Ppat_any; ppat_loc = _ }; _} as lb ] ->
        let exp = wrap_exp_attrs lb.lb_expression
                    (None, lbs.lbs_attributes) in
        mkstr (Pstr_eval (exp, lb.lb_attributes))
    | bindings ->
        if lbs.lbs_attributes <> [] then
          raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
        let bindings =
          List.map
            (fun lb ->
               Vb.mk ~loc:lb.lb_loc ~attrs:lb.lb_attributes
                 ~docs:(Lazy.force lb.lb_docs)
                 ~text:(Lazy.force lb.lb_text)
                 lb.lb_pattern lb.lb_expression)
            bindings
        in
        mkstr(Pstr_value(lbs.lbs_rec, List.rev bindings))
  in
  match lbs.lbs_extension with
  | None -> str
  | Some id -> ghstr (Pstr_extension((id, PStr [str]), []))

let expr_of_let_bindings lbs body =
  let bindings =
    List.map
      (fun lb ->
         if lb.lb_attributes <> [] then
           raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
         Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
      lbs.lbs_bindings
  in
    mkexp_attrs (Pexp_let(lbs.lbs_rec, List.rev bindings, body))
      (lbs.lbs_extension, lbs.lbs_attributes)

let class_of_let_bindings lbs body =
  let bindings =
    List.map
      (fun lb ->
         if lb.lb_attributes <> [] then
           raise Syntaxerr.(Error(Not_expecting(lb.lb_loc, "item attribute")));
         Vb.mk ~loc:lb.lb_loc lb.lb_pattern lb.lb_expression)
      lbs.lbs_bindings
  in
    if lbs.lbs_extension <> None then
      raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "extension")));
    if lbs.lbs_attributes <> [] then
      raise Syntaxerr.(Error(Not_expecting(lbs.lbs_loc, "attributes")));
    mkclass(Pcl_let (lbs.lbs_rec, List.rev bindings, body))

400 401 402
%}
%start implementation
%start interface
403 404 405
%start parse_core_type
%start parse_expression
%start parse_pattern
406 407
%start toplevel_phrase
%start use_file
408 409
%token AMPERAMPER
%token AMPERSAND
410 411
%token AND
%token AS
412 413 414
%token ASSERT
%token BACKQUOTE
%token BANG
415 416
%token BAR
%token BARBAR
417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437
%token BARRBRACKET
%token BEGIN
%token <char> CHAR
%token CLASS
%token COLON
%token COLONCOLON
%token COLONEQUAL
%token COLONGREATER
%token COMMA
%token <string * Location.t> COMMENT
%token CONSTRAINT
%token DO
%token <Docstrings.docstring> DOCSTRING
%token DONE
%token DOT
%token DOTDOT
%token DOWNTO
%token ELSE
%token END
%token EOF
%token EOL
438
%token EQUAL
439 440 441 442 443 444 445 446 447 448 449 450 451 452 453
%token EXCEPTION
%token EXTERNAL
%token FALSE
%token <string> FLOAT
%token FOR
%token FUN
%token FUNCTION
%token FUNCTOR
%token GREATER
%token GREATERRBRACE
%token GREATERRBRACKET
%token IF
%token IN
%token INCLUDE
%token <string> INFIXOP0
454
%token <string> INFIXOP1
455 456 457 458 459 460 461 462 463 464 465 466 467
%token <string> INFIXOP2
%token <string> INFIXOP3
%token <string> INFIXOP4
%token INHERIT
%token INITIALIZER
%token <int> INT
%token <int32> INT32
%token <int64> INT64
%token <string> LABEL
%token LAZY
%token LBRACE
%token LBRACELESS
%token LBRACKET
468 469
%token LBRACKETAT
%token LBRACKETATAT
470 471 472 473 474 475 476 477 478 479 480 481 482
%token LBRACKETATATAT
%token LBRACKETBAR
%token LBRACKETGREATER
%token LBRACKETLESS
%token LBRACKETPERCENT
%token LBRACKETPERCENTPERCENT
%token LESS
%token LESSMINUS
%token LET
%token <string> LIDENT
%token LPAREN
%token MATCH
%token METHOD
483
%token MINUS
484 485 486 487 488 489 490 491 492 493 494 495
%token MINUSDOT
%token MINUSGREATER
%token MODULE
%token MUTABLE
%token <nativeint> NATIVEINT
%token NEW
%token NONREC
%token OBJECT
%token OF
%token OPEN
%token <string> OPTLABEL
%token OR
496
%token PERCENT
497 498 499 500 501 502 503 504 505 506 507 508 509
%token PLUS
%token PLUSDOT
%token PLUSEQ
%token <string> PREFIXOP
%token PRIVATE
%token QUESTION
%token QUOTE
%token RBRACE
%token RBRACKET
%token REC
%token RPAREN
%token SEMI
%token SEMISEMI
510
%token SHARP
511
%token <string> SHARPOP
512 513
%token SIG
%token STAR
514
%token <string * string option> STRING
515 516 517 518 519 520 521 522 523 524 525 526 527 528
%token STRUCT
%token THEN
%token TILDE
%token TO
%token TRUE
%token TRY
%token TYPE
%token <string> UIDENT
%token UNDERSCORE
%token VAL
%token VIRTUAL
%token WHEN
%token WHILE
%token WITH
529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565
%nonassoc IN
%nonassoc below_SEMI
%nonassoc SEMI
%nonassoc LET
%nonassoc below_WITH
%nonassoc FUNCTION WITH
%nonassoc AND
%nonassoc THEN
%nonassoc ELSE
%nonassoc LESSMINUS
%right COLONEQUAL
%nonassoc AS
%left BAR
%nonassoc below_COMMA
%left COMMA
%right MINUSGREATER
%right BARBAR OR
%right AMPERAMPER AMPERSAND
%nonassoc below_EQUAL
%left EQUAL GREATER INFIXOP0 LESS
%right INFIXOP1
%nonassoc below_LBRACKETAT
%nonassoc LBRACKETAT
%nonassoc LBRACKETATAT
%right COLONCOLON
%left INFIXOP2 MINUS MINUSDOT PLUS PLUSDOT PLUSEQ
%left INFIXOP3 PERCENT STAR
%right INFIXOP4
%nonassoc prec_unary_minus prec_unary_plus
%nonassoc prec_constant_constructor
%nonassoc prec_constr_appl
%nonassoc below_SHARP
%nonassoc SHARP
%left SHARPOP
%nonassoc below_DOT
%nonassoc DOT
%nonassoc BACKQUOTE BANG BEGIN CHAR FALSE FLOAT INT INT32 INT64 LBRACE LBRACELESS LBRACKET LBRACKETBAR LBRACKETPERCENT LBRACKETPERCENTPERCENT LIDENT LPAREN NATIVEINT NEW PREFIXOP STRING TRUE UIDENT
566 567
%type <Parsetree.structure> implementation
%type <Parsetree.signature> interface
568 569 570
%type <Parsetree.core_type> parse_core_type
%type <Parsetree.expression> parse_expression
%type <Parsetree.pattern> parse_pattern
571 572 573 574 575
%type <Parsetree.toplevel_phrase> toplevel_phrase
%type <Parsetree.toplevel_phrase list> use_file
%%

implementation:
576
  _1 = structure _2 = EOF
577
    {                                         ( extra_str 1 _1 )}
578 579

interface:
580
  _1 = signature _2 = EOF
581
    {                                         ( extra_sig 1 _1 )}
582 583

toplevel_phrase:
584
  _1 = top_structure _2 = SEMISEMI
585
    {                                         ( Ptop_def (extra_str 1 _1) )}
586 587 588 589
| _1 = toplevel_directive _2 = SEMISEMI
    {                                         ( _1 )}
| _1 = EOF
    {                                         ( raise End_of_file )}
590 591

top_structure:
592
  _1 = seq_expr _2 = post_item_attributes
593 594 595 596 597
    {      ( (text_str 1) @ [mkstrexp _1 _2] )}
| _1 = top_structure_tail
    {      ( _1 )}

top_structure_tail:
598
  
599 600 601
    {                                         ( [] )}
| _1 = structure_item _2 = top_structure_tail
    {                                         ( (text_str 1) @ _1 :: _2 )}
602 603

use_file:
604
  _1 = use_file_body
605 606 607
    {                                         ( extra_def 1 _1 )}

use_file_body:
608
  _1 = use_file_tail
609
    {                                         ( _1 )}
610 611
| _1 = seq_expr _2 = post_item_attributes _3 = use_file_tail
    {      ( (text_def 1) @ Ptop_def[mkstrexp _1 _2] :: _3 )}
612 613

use_file_tail:
614
  _1 = EOF
615
    {      ( [] )}
616
| _1 = SEMISEMI _2 = EOF
617 618 619 620
    {      ( text_def 1 )}
| _1 = SEMISEMI _2 = seq_expr _3 = post_item_attributes _4 = use_file_tail
    {      (  mark_rhs_docs 2 3;
        (text_def 1) @ (text_def 2) @ Ptop_def[mkstrexp _2 _3] :: _4 )}
621
| _1 = SEMISEMI _2 = structure_item _3 = use_file_tail
622
    {      ( (text_def 1) @ (text_def 2) @ Ptop_def[_2] :: _3 )}
623
| _1 = SEMISEMI _2 = toplevel_directive _3 = use_file_tail
624 625
    {      (  mark_rhs_docs 2 3;
        (text_def 1) @ (text_def 2) @ _2 :: _3 )}
626
| _1 = structure_item _2 = use_file_tail
627
    {      ( (text_def 1) @ Ptop_def[_1] :: _2 )}
628
| _1 = toplevel_directive _2 = use_file_tail
629 630 631 632
    {      ( mark_rhs_docs 1 1;
        (text_def 1) @ _1 :: _2 )}

parse_core_type:
633
  _1 = core_type _2 = EOF
634 635 636
    {                  ( _1 )}

parse_expression:
637
  _1 = seq_expr _2 = EOF
638 639 640
    {                 ( _1 )}

parse_pattern:
641
  _1 = pattern _2 = EOF
642 643 644
    {                ( _1 )}

functor_arg:
645
  _1 = LPAREN _2 = RPAREN
646 647 648 649 650
    {      ( mkrhs "*" 2, None )}
| _1 = LPAREN _2 = functor_arg_name _3 = COLON _4 = module_type _5 = RPAREN
    {      ( mkrhs _2 2, Some _4 )}

functor_arg_name:
651
  _1 = UIDENT
652 653 654 655 656
    {               ( _1 )}
| _1 = UNDERSCORE
    {               ( "_" )}

functor_args:
657
  _1 = functor_args _2 = functor_arg
658 659 660
    {      ( _2 :: _1 )}
| _1 = functor_arg
    {      ( [ _1 ] )}
661 662

module_expr:
663
  _1 = mod_longident
664
    {      ( mkmod(Pmod_ident (mkrhs _1 1)) )}
665
| _1 = STRUCT _2 = structure _3 = END
666
    {      ( mkmod(Pmod_structure(extra_str 2 _2)) )}
667 668
| _1 = STRUCT _2 = structure _3 = error
    {      ( unclosed "struct" 1 "end" 3 )}
669 670 671
| _1 = FUNCTOR _2 = functor_args _3 = MINUSGREATER _4 = module_expr
    {      ( List.fold_left (fun acc (n, t) -> mkmod(Pmod_functor(n, t, acc)))
                       _4 _2 )}
672 673
| _1 = module_expr _2 = LPAREN _3 = module_expr _4 = RPAREN
    {      ( mkmod(Pmod_apply(_1, _3)) )}
674 675
| _1 = module_expr _2 = LPAREN _3 = RPAREN
    {      ( mkmod(Pmod_apply(_1, mkmod (Pmod_structure []))) )}
676 677 678 679 680 681 682 683 684 685
| _1 = module_expr _2 = LPAREN _3 = module_expr _4 = error
    {      ( unclosed "(" 2 ")" 4 )}
| _1 = LPAREN _2 = module_expr _3 = COLON _4 = module_type _5 = RPAREN
    {      ( mkmod(Pmod_constraint(_2, _4)) )}
| _1 = LPAREN _2 = module_expr _3 = COLON _4 = module_type _5 = error
    {      ( unclosed "(" 1 ")" 5 )}
| _1 = LPAREN _2 = module_expr _3 = RPAREN
    {      ( _2 )}
| _1 = LPAREN _2 = module_expr _3 = error
    {      ( unclosed "(" 1 ")" 3 )}
686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707
| _1 = LPAREN _2 = VAL _3 = expr _4 = RPAREN
    {      ( mkmod(Pmod_unpack _3) )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = COLON _5 = package_type _6 = RPAREN
    {      ( mkmod(Pmod_unpack(
              ghexp(Pexp_constraint(_3, ghtyp(Ptyp_package _5))))) )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = COLON _5 = package_type _6 = COLONGREATER _7 = package_type _8 = RPAREN
    {      ( mkmod(Pmod_unpack(
              ghexp(Pexp_coerce(_3, Some(ghtyp(Ptyp_package _5)),
                                    ghtyp(Ptyp_package _7))))) )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = COLONGREATER _5 = package_type _6 = RPAREN
    {      ( mkmod(Pmod_unpack(
              ghexp(Pexp_coerce(_3, None, ghtyp(Ptyp_package _5))))) )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = COLON _5 = error
    {      ( unclosed "(" 1 ")" 5 )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = COLONGREATER _5 = error
    {      ( unclosed "(" 1 ")" 5 )}
| _1 = LPAREN _2 = VAL _3 = expr _4 = error
    {      ( unclosed "(" 1 ")" 4 )}
| _1 = module_expr _2 = attribute
    {      ( Mod.attr _1 _2 )}
| _1 = extension
    {      ( mkmod(Pmod_extension _1) )}
708 709

structure:
710
  _1 = seq_expr _2 = post_item_attributes _3 = structure_tail
711 712
    {      ( mark_rhs_docs 1 2;
        (text_str 1) @ mkstrexp _1 _2 :: _3 )}
713
| _1 = structure_tail
714
    {                   ( _1 )}
715 716

structure_tail:
717
  
718 719 720
    {                         ( [] )}
| _1 = SEMISEMI _2 = structure
    {                         ( (text_str 1) @ _2 )}
721
| _1 = structure_item _2 = structure_tail
722
    {                                  ( (text_str 1) @ _1 :: _2 )}
723 724

structure_item:
725
  _1 = let_bindings
726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757
    {      ( val_of_let_bindings _1 )}
| _1 = primitive_declaration
    {      ( mkstr (Pstr_primitive _1) )}
| _1 = value_description
    {      ( mkstr (Pstr_primitive _1) )}
| _1 = type_declarations
    {      ( let (nr, l) = _1 in mkstr(Pstr_type (nr, List.rev l)) )}
| _1 = str_type_extension
    {      ( mkstr(Pstr_typext _1) )}
| _1 = str_exception_declaration
    {      ( mkstr(Pstr_exception _1) )}
| _1 = module_binding
    {      ( mkstr(Pstr_module _1) )}
| _1 = rec_module_bindings
    {      ( mkstr(Pstr_recmodule(List.rev _1)) )}
| _1 = module_type_declaration
    {      ( mkstr(Pstr_modtype _1) )}
| _1 = open_statement
    {                   ( mkstr(Pstr_open _1) )}
| _1 = class_declarations
    {      ( mkstr(Pstr_class (List.rev _1)) )}
| _1 = class_type_declarations
    {      ( mkstr(Pstr_class_type (List.rev _1)) )}
| _1 = str_include_statement
    {      ( mkstr(Pstr_include _1) )}
| _1 = item_extension _2 = post_item_attributes
    {      ( mkstr(Pstr_extension (_1, (add_docs_attrs (symbol_docs ()) _2))) )}
| _1 = floating_attribute
    {      ( mark_symbol_docs ();
        mkstr(Pstr_attribute _1) )}

str_include_statement:
758
  _1 = INCLUDE _2 = module_expr _3 = post_item_attributes
759 760 761 762
    {      ( Incl.mk _2 ~attrs:_3
                ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

module_binding_body:
763
  _1 = EQUAL _2 = module_expr
764 765 766
    {      ( _2 )}
| _1 = COLON _2 = module_type _3 = EQUAL _4 = module_expr
    {      ( mkmod(Pmod_constraint(_4, _2)) )}
767 768
| _1 = functor_arg _2 = module_binding_body
    {      ( mkmod(Pmod_functor(fst _1, snd _1, _2)) )}
769

770
module_binding:
771
  _1 = MODULE _2 = UIDENT _3 = module_binding_body _4 = post_item_attributes
772 773 774 775
    {      ( Mb.mk (mkrhs _2 2) _3 ~attrs:_4
              ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) )}

rec_module_bindings:
776
  _1 = rec_module_binding
777
    {                                                  ( [_1] )}
778 779 780 781
| _1 = rec_module_bindings _2 = and_module_binding
    {                                                  ( _2 :: _1 )}

rec_module_binding:
782
  _1 = MODULE _2 = REC _3 = UIDENT _4 = module_binding_body _5 = post_item_attributes
783 784
    {      ( Mb.mk (mkrhs _3 3) _4 ~attrs:_5
              ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) )}
785

786
and_module_binding:
787
  _1 = AND _2 = UIDENT _3 = module_binding_body _4 = post_item_attributes
788 789
    {      ( Mb.mk (mkrhs _2 2) _3 ~attrs:_4 ~loc:(symbol_rloc ())
               ~text:(symbol_text ()) ~docs:(symbol_docs ()) )}
790 791

module_type:
792
  _1 = mty_longident
793
    {      ( mkmty(Pmty_ident (mkrhs _1 1)) )}
794
| _1 = SIG _2 = signature _3 = END
795
    {      ( mkmty(Pmty_signature (extra_sig 2 _2)) )}
796 797
| _1 = SIG _2 = signature _3 = error
    {      ( unclosed "sig" 1 "end" 3 )}
798
| _1 = FUNCTOR _2 = functor_args _3 = MINUSGREATER _4 = module_type %prec below_WITH
799 800 801 802 803 804
    {      ( List.fold_left
          (fun acc (n, t) ->
           mkmty(Pmty_functor(n, t, acc)))
        _4 _2 )}
| _1 = module_type _2 = MINUSGREATER _3 = module_type %prec below_WITH
    {      ( mkmty(Pmty_functor(mknoloc "_", Some _1, _3)) )}
805 806
| _1 = module_type _2 = WITH _3 = with_constraints
    {      ( mkmty(Pmty_with(_1, List.rev _3)) )}
807 808
| _1 = MODULE _2 = TYPE _3 = OF _4 = module_expr %prec below_LBRACKETAT
    {      ( mkmty(Pmty_typeof _4) )}
809 810 811 812
| _1 = LPAREN _2 = module_type _3 = RPAREN
    {      ( _2 )}
| _1 = LPAREN _2 = module_type _3 = error
    {      ( unclosed "(" 1 ")" 3 )}
813 814 815 816
| _1 = extension
    {      ( mkmty(Pmty_extension _1) )}
| _1 = module_type _2 = attribute
    {      ( Mty.attr _1 _2 )}
817 818

signature:
819
  
820 821 822 823 824
    {                         ( [] )}
| _1 = SEMISEMI _2 = signature
    {                         ( (text_sig 1) @ _2 )}
| _1 = signature_item _2 = signature
    {                             ( (text_sig 1) @ _1 :: _2 )}
825 826

signature_item:
827
  _1 = value_description
828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859
    {      ( mksig(Psig_value _1) )}
| _1 = primitive_declaration
    {      ( mksig(Psig_value _1) )}
| _1 = type_declarations
    {      ( let (nr, l) = _1 in mksig(Psig_type (nr, List.rev l)) )}
| _1 = sig_type_extension
    {      ( mksig(Psig_typext _1) )}
| _1 = sig_exception_declaration
    {      ( mksig(Psig_exception _1) )}
| _1 = module_declaration
    {      ( mksig(Psig_module _1) )}
| _1 = module_alias
    {      ( mksig(Psig_module _1) )}
| _1 = rec_module_declarations
    {      ( mksig(Psig_recmodule (List.rev _1)) )}
| _1 = module_type_declaration
    {      ( mksig(Psig_modtype _1) )}
| _1 = open_statement
    {      ( mksig(Psig_open _1) )}
| _1 = sig_include_statement
    {      ( mksig(Psig_include _1) )}
| _1 = class_descriptions
    {      ( mksig(Psig_class (List.rev _1)) )}
| _1 = class_type_declarations
    {      ( mksig(Psig_class_type (List.rev _1)) )}
| _1 = item_extension _2 = post_item_attributes
    {      ( mksig(Psig_extension (_1, (add_docs_attrs (symbol_docs ()) _2))) )}
| _1 = floating_attribute
    {      ( mark_symbol_docs ();
        mksig(Psig_attribute _1) )}

open_statement:
860
  _1 = OPEN _2 = override_flag _3 = mod_longident _4 = post_item_attributes
861 862 863 864
    {      ( Opn.mk (mkrhs _3 3) ~override:_2 ~attrs:_4
          ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

sig_include_statement:
865
  _1 = INCLUDE _2 = module_type _3 = post_item_attributes %prec below_WITH
866 867 868 869
    {      ( Incl.mk _2 ~attrs:_3
                ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

module_declaration_body:
870
  _1 = COLON _2 = module_type
871
    {      ( _2 )}
872 873 874 875
| _1 = LPAREN _2 = UIDENT _3 = COLON _4 = module_type _5 = RPAREN _6 = module_declaration_body
    {      ( mkmty(Pmty_functor(mkrhs _2 2, Some _4, _6)) )}
| _1 = LPAREN _2 = RPAREN _3 = module_declaration_body
    {      ( mkmty(Pmty_functor(mkrhs "*" 1, None, _3)) )}
876

877
module_declaration:
878
  _1 = MODULE _2 = UIDENT _3 = module_declaration_body _4 = post_item_attributes
879 880 881 882
    {      ( Md.mk (mkrhs _2 2) _3 ~attrs:_4
          ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

module_alias:
883
  _1 = MODULE _2 = UIDENT _3 = EQUAL _4 = mod_longident _5 = post_item_attributes
884 885 886 887 888
    {      ( Md.mk (mkrhs _2 2)
          (Mty.alias ~loc:(rhs_loc 4) (mkrhs _4 4)) ~attrs:_5
             ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

rec_module_declarations:
889
  _1 = rec_module_declaration
890 891 892 893 894
    {                                                    ( [_1] )}
| _1 = rec_module_declarations _2 = and_module_declaration
    {                                                    ( _2 :: _1 )}

rec_module_declaration:
895
  _1 = MODULE _2 = REC _3 = UIDENT _4 = COLON _5 = module_type _6 = post_item_attributes
896 897 898 899
    {      ( Md.mk (mkrhs _3 3) _5 ~attrs:_6
              ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}

and_module_declaration:
900
  _1 = AND _2 = UIDENT _3 = COLON _4 = module_type _5 = post_item_attributes
901 902 903 904
    {      ( Md.mk (mkrhs _2 2) _4 ~attrs:_5 ~loc:(symbol_rloc())
              ~text:(symbol_text()) ~docs:(symbol_docs()) )}

module_type_declaration_body:
905
  
906 907 908
    {                              ( None )}
| _1 = EQUAL _2 = module_type
    {                              ( Some _2 )}
909

910
module_type_declaration:
911
  _1 = MODULE _2 = TYPE _3 = ident _4 = module_type_declaration_body _5 = post_item_attributes
912 913
    {      ( Mtd.mk (mkrhs _3 3) ?typ:_4 ~attrs:_5
          ~loc:(symbol_rloc()) ~docs:(symbol_docs ()) )}
914 915

class_declarations:
916
  _1 = class_declaration
917
    {                                                ( [_1] )}
918 919
| _1 = class_declarations _2 = and_class_declaration
    {                                                ( _2 :: _1 )}
920 921

class_declaration:
922
  _1 = CLASS _2 = virtual_flag _3 = class_type_parameters _4 = LIDENT _5 = class_fun_binding _6 = post_item_attributes
923 924 925 926
    {      ( Ci.mk (mkrhs _4 4) _5 ~virt:_2 ~params:_3 ~attrs:_6
              ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) )}

and_class_declaration:
927
  _1 = AND _2 = virtual_flag _3 = class_type_parameters _4 = LIDENT _5 = class_fun_binding _6 = post_item_attributes
928 929 930
    {      ( Ci.mk (mkrhs _4 4) _5 ~virt:_2 ~params:_3
         ~attrs:_6 ~loc:(symbol_rloc ())
         ~text:(symbol_text ()) ~docs:(symbol_docs ()) )}
931 932

class_fun_binding:
933
  _1 = EQUAL _2 = class_expr
934 935 936 937 938
    {      ( _2 )}
| _1 = COLON _2 = class_type _3 = EQUAL _4 = class_expr
    {      ( mkclass(Pcl_constraint(_4, _2)) )}
| _1 = labeled_simple_pattern _2 = class_fun_binding
    {      ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _2)) )}
939 940

class_type_parameters:
941
  
942
    {                                                ( [] )}
943
| _1 = LBRACKET _2 = type_parameter_list _3 = RBRACKET
944
    {                                                ( List.rev _2 )}
945 946

class_fun_def:
947
  _1 = labeled_simple_pattern _2 = MINUSGREATER _3 = class_expr
948 949 950
    {      ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _3)) )}
| _1 = labeled_simple_pattern _2 = class_fun_def
    {      ( let (l,o,p) = _1 in mkclass(Pcl_fun(l, o, p, _2)) )}
951 952

class_expr:
953
  _1 = class_simple_expr
954 955 956 957 958
    {      ( _1 )}
| _1 = FUN _2 = class_fun_def
    {      ( _2 )}
| _1 = class_simple_expr _2 = simple_labeled_expr_list
    {      ( mkclass(Pcl_apply(_1, List.rev _2)) )}
959 960 961 962 963 964
| _1 = let_bindings _2 = IN _3 = class_expr
    {      ( class_of_let_bindings _1 _3 )}
| _1 = class_expr _2 = attribute
    {      ( Cl.attr _1 _2 )}
| _1 = extension
    {      ( mkclass(Pcl_extension _1) )}
965 966

class_simple_expr:
967
  _1 = LBRACKET _2 = core_type_comma_list _3 = RBRACKET _4 = class_longident
968
    {      ( mkclass(Pcl_constr(mkloc _4 (rhs_loc 4), List.rev _2)) )}
969
| _1 = class_longident
970
    {      ( mkclass(Pcl_constr(mkrhs _1 1, [])) )}
971
| _1 = OBJECT _2 = class_structure _3 = END
972
    {      ( mkclass(Pcl_structure _2) )}
973 974 975 976 977 978 979 980 981 982
| _1 = OBJECT _2 = class_structure _3 = error
    {      ( unclosed "object" 1 "end" 3 )}
| _1 = LPAREN _2 = class_expr _3 = COLON _4 = class_type _5 = RPAREN
    {      ( mkclass(Pcl_constraint(_2, _4)) )}
| _1 = LPAREN _2 = class_expr _3 = COLON _4 = class_type _5 = error
    {      ( unclosed "(" 1 ")" 5 )}
| _1 = LPAREN _2 = class_expr _3 = RPAREN
    {      ( _2 )}
| _1 = LPAREN _2 = class_expr _3 = error
    {      ( unclosed "(" 1 ")" 3 )}
983 984

class_structure:
985
  _1 = class_self_pattern _2 = class_fields
986
    {       ( Cstr.mk _1 (extra_cstr 2 (List.rev _2)) )}
987 988

class_self_pattern:
989
  _1 = LPAREN _2 = pattern _3 = RPAREN
990 991 992
    {      ( reloc_pat _2 )}
| _1 = LPAREN _2 = pattern _3 = COLON _4 = core_type _5 = RPAREN
    {      ( mkpat(Ppat_constraint(_2, _4)) )}
993
| 
994
    {      ( ghpat(Ppat_any) )}
995 996

class_fields:
997
  
998
    {      ( [] )}
999 1000 1001 1002
| _1 = class_fields _2 = class_field
    {      ( _2 :: (text_cstr 2) @ _1 )}

class_field:
1003
  _1 = INHERIT _2 = override_flag _3 = class_expr _4 = parent_binder _5 = post_item_attributes
1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017
    {      ( mkcf (Pcf_inherit (_2, _3, _4)) ~attrs:_5 ~docs:(symbol_docs ()) )}
| _1 = VAL _2 = value _3 = post_item_attributes
    {      ( mkcf (Pcf_val _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = METHOD _2 = method_ _3 = post_item_attributes
    {      ( mkcf (Pcf_method _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = CONSTRAINT _2 = constrain_field _3 = post_item_attributes
    {      ( mkcf (Pcf_constraint _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = INITIALIZER _2 = seq_expr _3 = post_item_attributes
    {      ( mkcf (Pcf_initializer _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = item_extension _2 = post_item_attributes
    {      ( mkcf (Pcf_extension _1) ~attrs:_2 ~docs:(symbol_docs ()) )}
| _1 = floating_attribute
    {      ( mark_symbol_docs ();
        mkcf (Pcf_attribute _1) )}
1018 1019

parent_binder:
1020
  _1 = AS _2 = LIDENT
1021
    {          ( Some _2 )}
1022
| 
1023
    {          ( None )}
1024 1025

value:
1026
  _1 = override_flag _2 = MUTABLE _3 = VIRTUAL _4 = label _5 = COLON _6 = core_type
1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039
    {      ( if _1 = Override then syntax_error ();
        mkloc _4 (rhs_loc 4), Mutable, Cfk_virtual _6 )}
| _1 = VIRTUAL _2 = mutable_flag _3 = label _4 = COLON _5 = core_type
    {      ( mkrhs _3 3, _2, Cfk_virtual _5 )}
| _1 = override_flag _2 = mutable_flag _3 = label _4 = EQUAL _5 = seq_expr
    {      ( mkrhs _3 3, _2, Cfk_concrete (_1, _5) )}
| _1 = override_flag _2 = mutable_flag _3 = label _4 = type_constraint _5 = EQUAL _6 = seq_expr
    {      (
       let e = mkexp_constraint _6 _4 in
       mkrhs _3 3, _2, Cfk_concrete (_1, e)
      )}

method_:
1040
  _1 = override_flag _2 = PRIVATE _3 = VIRTUAL _4 = label _5 = COLON _6 = poly_type
1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055
    {      ( if _1 = Override then syntax_error ();
        mkloc _4 (rhs_loc 4), Private, Cfk_virtual _6 )}
| _1 = override_flag _2 = VIRTUAL _3 = private_flag _4 = label _5 = COLON _6 = poly_type
    {      ( if _1 = Override then syntax_error ();
        mkloc _4 (rhs_loc 4), _3, Cfk_virtual _6 )}
| _1 = override_flag _2 = private_flag _3 = label _4 = strict_binding
    {      ( mkloc _3 (rhs_loc 3), _2,
        Cfk_concrete (_1, ghexp(Pexp_poly (_4, None))) )}
| _1 = override_flag _2 = private_flag _3 = label _4 = COLON _5 = poly_type _6 = EQUAL _7 = seq_expr
    {      ( mkloc _3 (rhs_loc 3), _2,
        Cfk_concrete (_1, ghexp(Pexp_poly(_7, Some _5))) )}
| _1 = override_flag _2 = private_flag _3 = label _4 = COLON _5 = TYPE _6 = lident_list _7 = DOT _8 = core_type _9 = EQUAL _10 = seq_expr
    {      ( let exp, poly = wrap_type_annotation _6 _8 _10 in
        mkloc _3 (rhs_loc 3), _2,
        Cfk_concrete (_1, ghexp(Pexp_poly(exp, Some poly))) )}
1056 1057

class_type:
1058
  _1 = class_signature
1059 1060
    {      ( _1 )}
| _1 = QUESTION _2 = LIDENT _3 = COLON _4 = simple_core_type_or_tuple _5 = MINUSGREATER _6 = class_type
1061
    {      ( mkcty(Pcty_arrow(Optional _2 , _4, _6)) )}
1062
| _1 = OPTLABEL _2 = simple_core_type_or_tuple _3 = MINUSGREATER _4 = class_type
1063
    {      ( mkcty(Pcty_arrow(Optional _1, _2, _4)) )}
1064
| _1 = LIDENT _2 = COLON _3 = simple_core_type_or_tuple _4 = MINUSGREATER _5 = class_type
1065
    {      ( mkcty(Pcty_arrow(Labelled _1, _3, _5)) )}
1066
| _1 = simple_core_type_or_tuple _2 = MINUSGREATER _3 = class_type
1067
    {      ( mkcty(Pcty_arrow(Nolabel, _1, _3)) )}
1068 1069

class_signature:
1070
  _1 = LBRACKET _2 = core_type_comma_list _3 = RBRACKET _4 = clty_longident
1071
    {      ( mkcty(Pcty_constr (mkloc _4 (rhs_loc 4), List.rev _2)) )}
1072
| _1 = clty_longident
1073
    {      ( mkcty(Pcty_constr (mkrhs _1 1, [])) )}
1074 1075 1076 1077
| _1 = OBJECT _2 = class_sig_body _3 = END
    {      ( mkcty(Pcty_signature _2) )}
| _1 = OBJECT _2 = class_sig_body _3 = error
    {      ( unclosed "object" 1 "end" 3 )}
1078 1079 1080 1081
| _1 = class_signature _2 = attribute
    {      ( Cty.attr _1 _2 )}
| _1 = extension
    {      ( mkcty(Pcty_extension _1) )}
1082 1083

class_sig_body:
1084
  _1 = class_self_type _2 = class_sig_fields
1085
    {      ( Csig.mk _1 (extra_csig 2 (List.rev _2)) )}
1086 1087

class_self_type:
1088
  _1 = LPAREN _2 = core_type _3 = RPAREN
1089
    {      ( _2 )}
1090
| 
1091
    {      ( mktyp(Ptyp_any) )}
1092 1093

class_sig_fields:
1094
  
1095
    {                                                ( [] )}
1096 1097 1098 1099
| _1 = class_sig_fields _2 = class_sig_field
    {                                       ( _2 :: (text_csig 2) @ _1 )}

class_sig_field:
1100
  _1 = INHERIT _2 = class_signature _3 = post_item_attributes
1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115
    {      ( mkctf (Pctf_inherit _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = VAL _2 = value_type _3 = post_item_attributes
    {      ( mkctf (Pctf_val _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = METHOD _2 = private_virtual_flags _3 = label _4 = COLON _5 = poly_type _6 = post_item_attributes
    {      (
       let (p, v) = _2 in
       mkctf (Pctf_method (_3, p, v, _5)) ~attrs:_6 ~docs:(symbol_docs ())
      )}
| _1 = CONSTRAINT _2 = constrain_field _3 = post_item_attributes
    {      ( mkctf (Pctf_constraint _2) ~attrs:_3 ~docs:(symbol_docs ()) )}
| _1 = item_extension _2 = post_item_attributes
    {      ( mkctf (Pctf_extension _1) ~attrs:_2 ~docs:(symbol_docs ()) )}
| _1 = floating_attribute
    {      ( mark_symbol_docs ();
        mkctf(Pctf_attribute _1) )}
1116 1117

value_type:
1118
  _1 = VIRTUAL _2 = mutable_flag _3 = label _4 = COLON _5 = core_type
1119 1120 1121 1122 1123
    {      ( _3, _2, Virtual, _5 )}
| _1 = MUTABLE _2 = virtual_flag _3 = label _4 = COLON _5 = core_type
    {      ( _3, Mutable, _2, _5 )}
| _1 = label _2 = COLON _3 = core_type
    {      ( _1, Immutable, Concrete, _3 )}
1124 1125

constrain:
1126
  _1 = core_type _2 = EQUAL _3 = core_type
1127 1128 1129
    {                                           ( _1, _3, symbol_rloc() )}

constrain_field:
1130
  _1 = core_type _2 = EQUAL _3 = core_type
1131
    {                                           ( _1, _3 )}
1132 1133

class_descriptions:
1134
  _1 = class_description
1135
    {                                                ( [_1] )}
1136 1137
| _1 = class_descriptions _2 = and_class_description
    {                                                ( _2 :: _1 )}
1138 1139

class_description:
1140
  _1 = CLASS _2 = virtual_flag _3 = class_type_parameters _4 = LIDENT _5 = COLON _6 = class_type _7 = post_item_attributes
1141 1142 1143 1144
    {      ( Ci.mk (mkrhs _4 4) _6 ~virt:_2 ~params:_3 ~attrs:_7
              ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) )}

and_class_description:
1145
  _1 = AND _2 = virtual_flag _3 = class_type_parameters _4 = LIDENT _5 = COLON _6 = class_type _7 = post_item_attributes
1146 1147 1148
    {      ( Ci.mk (mkrhs _4 4) _6 ~virt:_2 ~params:_3
              ~attrs:_7 ~loc:(symbol_rloc ())
              ~text:(symbol_text ()) ~docs:(symbol_docs ()) )}
1149 1150

class_type_declarations:
1151
  _1 = class_type_declaration
1152
    {                                                        ( [_1] )}
1153 1154
| _1 = class_type_declarations _2 = and_class_type_declaration
    {                                                        ( _2 :: _1 )}
1155 1156

class_type_declaration:
1157
  _1 = CLASS _2 = TYPE _3 = virtual_flag _4 = class_type_parameters _5 = LIDENT _6 = EQUAL _7 = class_signature _8 = post_item_attributes
1158 1159 1160 1161
    {      ( Ci.mk (mkrhs _5 5) _7 ~virt:_3 ~params:_4 ~attrs:_8
              ~loc:(symbol_rloc ()) ~docs:(symbol_docs ()) )}

and_class_type_declaration:
1162
  _1 = AND _2 = virtual_flag _3 = class_type_parameters _4 = LIDENT _5 = EQUAL _6 = class_signature _7 = post_item_attributes
1163 1164 1165
    {      ( Ci.mk (mkrhs _4 4) _6 ~virt:_2 ~params:_3
         ~attrs:_7 ~loc:(symbol_rloc ())
         ~text:(symbol_text ()) ~docs:(symbol_docs ()) )}
1166 1167

seq_expr:
1168
  _1 = expr %prec below_SEMI
1169