Source file ast_502.ml

module Asttypes = struct
  type constant (*IF_CURRENT = Asttypes.constant *) =
      Const_int of int
    | Const_char of char
    | Const_string of string * Location.t * string option
    | Const_float of string
    | Const_int32 of int32
    | Const_int64 of int64
    | Const_nativeint of nativeint

  type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive

  type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto

  (* Order matters, used in polymorphic comparison *)
  type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public

  type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable

  type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete

  type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh

  type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open

  type label = string

  type arg_label (*IF_CURRENT = Asttypes.arg_label *) =
      Nolabel
    | Labelled of string (** [label:T -> ...] *)
    | Optional of string (** [?label:T -> ...] *)

  type 'a loc = 'a Location.loc = {
    txt : 'a;
    loc : Location.t;
  }

  type variance (*IF_CURRENT = Asttypes.variance *) =
    | Covariant
    | Contravariant
    | NoVariance

  type injectivity (*IF_CURRENT = Asttypes.injectivity *) =
    | Injective
    | NoInjectivity
end

module Parsetree = struct
  open Asttypes

  type constant (*IF_CURRENT = Parsetree.constant *) =
    | Pconst_integer of string * char option
        (** Integer constants such as [3] [3l] [3L] [3n].

            Suffixes [[g-z][G-Z]] are accepted by the parser.
            Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker
    *)
    | Pconst_char of char  (** Character such as ['c']. *)
    | Pconst_string of string * Location.t * string option
        (** Constant string such as ["constant"] or
            [{delim|other constant|delim}].

            The location span the content of the string, without the delimiters.
    *)
    | Pconst_float of string * char option
        (** Float constant such as [3.4], [2e5] or [1.4e-4].

            Suffixes [g-z][G-Z] are accepted by the parser.
            Suffixes are rejected by the typechecker.
    *)

  type location_stack = Location.t list

  (** {1 Extension points} *)

  type attribute (*IF_CURRENT = Parsetree.attribute *) = {
    attr_name : string loc;
    attr_payload : payload;
    attr_loc : Location.t;
  }
  (** Attributes such as [[\@id ARG]] and [[\@\@id ARG]].

     Metadata containers passed around within the AST.
     The compiler ignores unknown attributes.
  *)

  and extension = string loc * payload
  (** Extension points such as [[%id ARG] and [%%id ARG]].

     Sub-language placeholder -- rejected by the typechecker.
  *)

  and attributes = attribute list

  and payload (*IF_CURRENT = Parsetree.payload *) =
    | PStr of structure
    | PSig of signature  (** [: SIG] in an attribute or an extension point *)
    | PTyp of core_type  (** [: T] in an attribute or an extension point *)
    | PPat of pattern * expression option
        (** [? P]  or  [? P when E], in an attribute or an extension point *)

  (** {1 Core language} *)
  (** {2 Type expressions} *)

  and core_type (*IF_CURRENT = Parsetree.core_type *) =
    {
      ptyp_desc: core_type_desc;
      ptyp_loc: Location.t;
      ptyp_loc_stack: location_stack;
      ptyp_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
    }

  and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) =
    | Ptyp_any  (** [_] *)
    | Ptyp_var of string  (** A type variable such as ['a] *)
    | Ptyp_arrow of arg_label * core_type * core_type
        (** [Ptyp_arrow(lbl, T1, T2)] represents:
              - [T1 -> T2]    when [lbl] is
                                       {{!Asttypes.arg_label.Nolabel}[Nolabel]},
              - [~l:T1 -> T2] when [lbl] is
                                       {{!Asttypes.arg_label.Labelled}[Labelled]},
              - [?l:T1 -> T2] when [lbl] is
                                       {{!Asttypes.arg_label.Optional}[Optional]}.
           *)
    | Ptyp_tuple of core_type list
        (** [Ptyp_tuple([T1 ; ... ; Tn])]
            represents a product type [T1 * ... * Tn].

             Invariant: [n >= 2].
          *)
    | Ptyp_constr of Longident.t loc * core_type list
        (** [Ptyp_constr(lident, l)] represents:
              - [tconstr]               when [l=[]],
              - [T tconstr]             when [l=[T]],
              - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]].
           *)
    | Ptyp_object of object_field list * closed_flag
        (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents:
              - [< l1:T1; ...; ln:Tn >]     when [flag] is
                                         {{!Asttypes.closed_flag.Closed}[Closed]},
              - [< l1:T1; ...; ln:Tn; .. >] when [flag] is
                                             {{!Asttypes.closed_flag.Open}[Open]}.
           *)
    | Ptyp_class of Longident.t loc * core_type list
        (** [Ptyp_class(tconstr, l)] represents:
              - [#tconstr]               when [l=[]],
              - [T #tconstr]             when [l=[T]],
              - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]].
           *)
    | Ptyp_alias of core_type * string loc  (** [T as 'a]. *)
    | Ptyp_variant of row_field list * closed_flag * label list option
        (** [Ptyp_variant([`A;`B], flag, labels)] represents:
              - [[ `A|`B ]]
                        when [flag]   is {{!Asttypes.closed_flag.Closed}[Closed]},
                         and [labels] is [None],
              - [[> `A|`B ]]
                        when [flag]   is {{!Asttypes.closed_flag.Open}[Open]},
                         and [labels] is [None],
              - [[< `A|`B ]]
                        when [flag]   is {{!Asttypes.closed_flag.Closed}[Closed]},
                         and [labels] is [Some []],
              - [[< `A|`B > `X `Y ]]
                        when [flag]   is {{!Asttypes.closed_flag.Closed}[Closed]},
                         and [labels] is [Some ["X";"Y"]].
           *)
    | Ptyp_poly of string loc list * core_type
        (** ['a1 ... 'an. T]

           Can only appear in the following context:

             - As the {!core_type} of a
            {{!pattern_desc.Ppat_constraint}[Ppat_constraint]} node corresponding
               to a constraint on a let-binding:

            {[let x : 'a1 ... 'an. T = e ...]}
             - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods
            (not values).

             - As the {!core_type} of a
             {{!class_type_field_desc.Pctf_method}[Pctf_method]} node.

             - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]}
             node.

             - As the {{!label_declaration.pld_type}[pld_type]} field of a
             {!label_declaration}.

             - As a {!core_type} of a {{!core_type_desc.Ptyp_object}[Ptyp_object]}
             node.

             - As the {{!value_description.pval_type}[pval_type]} field of a
             {!value_description}.
           *)
    | Ptyp_package of package_type  (** [(module S)]. *)
    | Ptyp_open of Longident.t loc * core_type (** [M.(T)] *)
    | Ptyp_extension of extension  (** [[%id]]. *)

  and package_type = Longident.t loc * (Longident.t loc * core_type) list
  (** As {!package_type} typed values:
           - [(S, [])] represents [(module S)],
           - [(S, [(t1, T1) ; ... ; (tn, Tn)])]
            represents [(module S with type t1 = T1 and ... and tn = Tn)].
         *)

  and row_field (*IF_CURRENT = Parsetree.row_field *) = {
    prf_desc : row_field_desc;
    prf_loc : Location.t;
    prf_attributes : attributes;
  }

  and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) =
    | Rtag of label loc * bool * core_type list
        (** [Rtag(`A, b, l)] represents:
             - [`A]                   when [b] is [true]  and [l] is [[]],
             - [`A of T]              when [b] is [false] and [l] is [[T]],
             - [`A of T1 & .. & Tn]   when [b] is [false] and [l] is [[T1;...Tn]],
             - [`A of & T1 & .. & Tn] when [b] is [true]  and [l] is [[T1;...Tn]].

            - The [bool] field is true if the tag contains a
              constant (empty) constructor.
            - [&] occurs when several types are used for the same constructor
              (see 4.2 in the manual)
          *)
    | Rinherit of core_type  (** [[ | t ]] *)

  and object_field (*IF_CURRENT = Parsetree.object_field *) = {
    pof_desc : object_field_desc;
    pof_loc : Location.t;
    pof_attributes : attributes;
  }

  and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) =
    | Otag of label loc * core_type
    | Oinherit of core_type

  (** {2 Patterns} *)

  and pattern (*IF_CURRENT = Parsetree.pattern *) =
    {
      ppat_desc: pattern_desc;
      ppat_loc: Location.t;
      ppat_loc_stack: location_stack;
      ppat_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
    }

  and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) =
    | Ppat_any  (** The pattern [_]. *)
    | Ppat_var of string loc  (** A variable pattern such as [x] *)
    | Ppat_alias of pattern * string loc
        (** An alias pattern such as [P as 'a] *)
    | Ppat_constant of constant
        (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *)
    | Ppat_interval of constant * constant
        (** Patterns such as ['a'..'z'].

             Other forms of interval are recognized by the parser
             but rejected by the type-checker. *)
    | Ppat_tuple of pattern list
        (** Patterns [(P1, ..., Pn)].

             Invariant: [n >= 2]
          *)
    | Ppat_construct of Longident.t loc * (string loc list * pattern) option
        (** [Ppat_construct(C, args)] represents:
              - [C]               when [args] is [None],
              - [C P]             when [args] is [Some ([], P)]
              - [C (P1, ..., Pn)] when [args] is
                                             [Some ([], Ppat_tuple [P1; ...; Pn])]
              - [C (type a b) P]  when [args] is [Some ([a; b], P)]
           *)
    | Ppat_variant of label * pattern option
        (** [Ppat_variant(`A, pat)] represents:
              - [`A]   when [pat] is [None],
              - [`A P] when [pat] is [Some P]
           *)
    | Ppat_record of (Longident.t loc * pattern) list * closed_flag
        (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents:
              - [{ l1=P1; ...; ln=Pn }]
                   when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}
              - [{ l1=P1; ...; ln=Pn; _}]
                   when [flag] is {{!Asttypes.closed_flag.Open}[Open]}

           Invariant: [n > 0]
           *)
    | Ppat_array of pattern list  (** Pattern [[| P1; ...; Pn |]] *)
    | Ppat_or of pattern * pattern  (** Pattern [P1 | P2] *)
    | Ppat_constraint of pattern * core_type  (** Pattern [(P : T)] *)
    | Ppat_type of Longident.t loc  (** Pattern [#tconst] *)
    | Ppat_lazy of pattern  (** Pattern [lazy P] *)
    | Ppat_unpack of string option loc
        (** [Ppat_unpack(s)] represents:
              - [(module P)] when [s] is [Some "P"]
              - [(module _)] when [s] is [None]

             Note: [(module P : S)] is represented as
             [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)]
           *)
    | Ppat_exception of pattern  (** Pattern [exception P] *)
    | Ppat_extension of extension  (** Pattern [[%id]] *)
    | Ppat_open of Longident.t loc * pattern  (** Pattern [M.(P)] *)

  (** {2 Value expressions} *)

  and expression (*IF_CURRENT = Parsetree.expression *) =
      {
       pexp_desc: expression_desc;
       pexp_loc: Location.t;
       pexp_loc_stack: location_stack;
       pexp_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
      }

  and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) =
    | Pexp_ident of Longident.t loc
        (** Identifiers such as [x] and [M.x]
           *)
    | Pexp_constant of constant
        (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l],
              [1L], [1n] *)
    | Pexp_let of rec_flag * value_binding list * expression
        (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents:
              - [let P1 = E1 and ... and Pn = EN in E]
                 when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
              - [let rec P1 = E1 and ... and Pn = EN in E]
                 when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
           *)
    | Pexp_function of
        function_param list * type_constraint option * function_body
    (** [Pexp_function ([P1; ...; Pn], C, body)] represents any construct
        involving [fun] or [function], including:
        - [fun P1 ... Pn -> E]
          when [body = Pfunction_body E]
        - [fun P1 ... Pn -> function p1 -> e1 | ... | pm -> em]
          when [body = Pfunction_cases [ p1 -> e1; ...; pm -> em ]]
        [C] represents a type constraint or coercion placed immediately before the
        arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)].
        A function must have parameters. [Pexp_function (params, _, body)] must
        have non-empty [params] or a [Pfunction_cases _] body.
    *)
    | Pexp_apply of expression * (arg_label * expression) list
          (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])]
                represents [E0 ~l1:E1 ... ~ln:En]

                [li] can be
                  {{!Asttypes.arg_label.Nolabel}[Nolabel]}   (non labeled argument),
                  {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or
                  {{!Asttypes.arg_label.Optional}[Optional]} (optional argument).

               Invariant: [n > 0]
             *)
    | Pexp_match of expression * case list
        (** [match E0 with P1 -> E1 | ... | Pn -> En] *)
    | Pexp_try of expression * case list
        (** [try E0 with P1 -> E1 | ... | Pn -> En] *)
    | Pexp_tuple of expression list
        (** Expressions [(E1, ..., En)]

             Invariant: [n >= 2]
          *)
    | Pexp_construct of Longident.t loc * expression option
        (** [Pexp_construct(C, exp)] represents:
             - [C]               when [exp] is [None],
             - [C E]             when [exp] is [Some E],
             - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])]
          *)
    | Pexp_variant of label * expression option
        (** [Pexp_variant(`A, exp)] represents
              - [`A]   when [exp] is [None]
              - [`A E] when [exp] is [Some E]
           *)
    | Pexp_record of (Longident.t loc * expression) list * expression option
        (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents
              - [{ l1=P1; ...; ln=Pn }]         when [exp0] is [None]
              - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0]

             Invariant: [n > 0]
           *)
    | Pexp_field of expression * Longident.t loc  (** [E.l] *)
    | Pexp_setfield of expression * Longident.t loc * expression
        (** [E1.l <- E2] *)
    | Pexp_array of expression list  (** [[| E1; ...; En |]] *)
    | Pexp_ifthenelse of expression * expression * expression option
        (** [if E1 then E2 else E3] *)
    | Pexp_sequence of expression * expression  (** [E1; E2] *)
    | Pexp_while of expression * expression  (** [while E1 do E2 done] *)
    | Pexp_for of pattern * expression * expression * direction_flag * expression
        (** [Pexp_for(i, E1, E2, direction, E3)] represents:
              - [for i = E1 to E2 do E3 done]
                   when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]}
              - [for i = E1 downto E2 do E3 done]
                   when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]}
           *)
    | Pexp_constraint of expression * core_type  (** [(E : T)] *)
    | Pexp_coerce of expression * core_type option * core_type
        (** [Pexp_coerce(E, from, T)] represents
              - [(E :> T)]      when [from] is [None],
              - [(E : T0 :> T)] when [from] is [Some T0].
           *)
    | Pexp_send of expression * label loc  (** [E # m] *)
    | Pexp_new of Longident.t loc  (** [new M.c] *)
    | Pexp_setinstvar of label loc * expression  (** [x <- 2] *)
    | Pexp_override of (label loc * expression) list
        (** [{< x1 = E1; ...; xn = En >}] *)
    | Pexp_letmodule of string option loc * module_expr * expression
        (** [let module M = ME in E] *)
    | Pexp_letexception of extension_constructor * expression
        (** [let exception C in E] *)
    | Pexp_assert of expression
        (** [assert E].

             Note: [assert false] is treated in a special way by the
             type-checker. *)
    | Pexp_lazy of expression  (** [lazy E] *)
    | Pexp_poly of expression * core_type option
        (** Used for method bodies.

             Can only be used as the expression under
             {{!class_field_kind.Cfk_concrete}[Cfk_concrete]} for methods (not
             values). *)
    | Pexp_object of class_structure  (** [object ... end] *)
    | Pexp_newtype of string loc * expression  (** [fun (type t) -> E] *)
    | Pexp_pack of module_expr
        (** [(module ME)].

             [(module ME : S)] is represented as
             [Pexp_constraint(Pexp_pack ME, Ptyp_package S)] *)
    | Pexp_open of open_declaration * expression
        (** - [M.(E)]
              - [let open M in E]
              - [let open! M in E] *)
    | Pexp_letop of letop
        (** - [let* P = E0 in E1]
              - [let* P0 = E00 and* P1 = E01 in E1] *)
    | Pexp_extension of extension  (** [[%id]] *)
    | Pexp_unreachable  (** [.] *)

  and case (*IF_CURRENT = Parsetree.case *) =
    {
      pc_lhs: pattern;
      pc_guard: expression option;
      pc_rhs: expression;
    }
  (** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *)

  and letop (*IF_CURRENT = Parsetree.letop *) =
    {
      let_ : binding_op;
      ands : binding_op list;
      body : expression;
    }

  and binding_op (*IF_CURRENT = Parsetree.binding_op *) =
    {
      pbop_op : string loc;
      pbop_pat : pattern;
      pbop_exp : expression;
      pbop_loc : Location.t;
    }

  and function_param_desc (*IF_CURRENT = Parsetree.function_param_desc *) =
    | Pparam_val of arg_label * expression option * pattern
    (** [Pparam_val (lbl, exp0, P)] represents the parameter:
        - [P]
          when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
          and [exp0] is [None]
        - [~l:P]
          when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}
          and [exp0] is [None]
        - [?l:P]
          when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
          and [exp0] is [None]
        - [?l:(P = E0)]
          when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}
          and [exp0] is [Some E0]

        Note: If [E0] is provided, only
        {{!Asttypes.arg_label.Optional}[Optional]} is allowed.
    *)
    | Pparam_newtype of string loc
    (** [Pparam_newtype x] represents the parameter [(type x)].
        [x] carries the location of the identifier, whereas the [pparam_loc]
        on the enclosing [function_param] node is the location of the [(type x)]
        as a whole.

        Multiple parameters [(type a b c)] are represented as multiple
        [Pparam_newtype] nodes, let's say:

        {[ [ { pparam_kind = Pparam_newtype a; pparam_loc = loc1 };
             { pparam_kind = Pparam_newtype b; pparam_loc = loc2 };
             { pparam_kind = Pparam_newtype c; pparam_loc = loc3 };
           ]
        ]}

        Here, the first loc [loc1] is the location of [(type a b c)], and the
        subsequent locs [loc2] and [loc3] are the same as [loc1], except marked as
        ghost locations. The locations on [a], [b], [c], correspond to the
        variables [a], [b], and [c] in the source code.
    *)

  and function_param (*IF_CURRENT = Parsetree.function_param *) =
    { pparam_loc : Location.t;
      pparam_desc : function_param_desc;
    }

  and function_body (*IF_CURRENT = Parsetree.function_body *) =
    | Pfunction_body of expression
    | Pfunction_cases of case list * Location.t * attributes
    (** In [Pfunction_cases (_, loc, attrs)], the location extends from the
        start of the [function] keyword to the end of the last case. The compiler
        will only use typechecking-related attributes from [attrs], e.g. enabling
        or disabling a warning.
    *)
  (** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)

  and type_constraint (*IF_CURRENT = Parsetree.type_constraint *) =
    | Pconstraint of core_type
    | Pcoerce of core_type option * core_type
  (** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *)

  (** {2 Value descriptions} *)

  and value_description (*IF_CURRENT = Parsetree.value_description *) =
    {
      pval_name: string loc;
      pval_type: core_type;
      pval_prim: string list;
      pval_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
      pval_loc: Location.t;
    }
  (** Values of type {!value_description} represents:
      - [val x: T],
              when {{!value_description.pval_prim}[pval_prim]} is [[]]
      - [external x: T = "s1" ... "sn"]
              when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]]
  *)

  (** {2 Type declarations} *)

  and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) =
    {
      ptype_name: string loc;
      ptype_params: (core_type * (variance * injectivity)) list;
      (** [('a1,...'an) t] *)
      ptype_cstrs: (core_type * core_type * Location.t) list;
      (** [... constraint T1=T1'  ... constraint Tn=Tn'] *)
      ptype_kind: type_kind;
      ptype_private: private_flag;  (** for [= private ...] *)
      ptype_manifest: core_type option;  (** represents [= T] *)
      ptype_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
      ptype_loc: Location.t;
    }
  (**
     Here are type declarations and their representation,
     for various {{!type_declaration.ptype_kind}[ptype_kind]}
             and {{!type_declaration.ptype_manifest}[ptype_manifest]} values:
   - [type t]   when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
                 and [manifest]  is [None],
   - [type t = T0]
                when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]},
                 and [manifest]  is [Some T0],
   - [type t = C of T | ...]
                when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
                 and [manifest]  is [None],
   - [type t = T0 = C of T | ...]
                when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]},
                 and [manifest]  is [Some T0],
   - [type t = {l: T; ...}]
                when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
                 and [manifest]  is [None],
   - [type t = T0 = {l : T; ...}]
                when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]},
                 and [manifest]  is [Some T0],
   - [type t = ..]
                when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]},
                 and [manifest]  is [None].
  *)

  and type_kind (*IF_CURRENT = Parsetree.type_kind *) =
    | Ptype_abstract
    | Ptype_variant of constructor_declaration list
    | Ptype_record of label_declaration list  (** Invariant: non-empty list *)
    | Ptype_open

  and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) =
    {
      pld_name: string loc;
      pld_mutable: mutable_flag;
      pld_type: core_type;
      pld_loc: Location.t;
      pld_attributes: attributes;  (** [l : T [\@id1] [\@id2]] *)
    }
  (**
     - [{ ...; l: T; ... }]
                             when {{!label_declaration.pld_mutable}[pld_mutable]}
                               is {{!Asttypes.mutable_flag.Immutable}[Immutable]},
     - [{ ...; mutable l: T; ... }]
                             when {{!label_declaration.pld_mutable}[pld_mutable]}
                               is {{!Asttypes.mutable_flag.Mutable}[Mutable]}.

     Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}.
  *)

  and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) =
    {
      pcd_name: string loc;
      pcd_vars: string loc list;
      pcd_args: constructor_arguments;
      pcd_res: core_type option;
      pcd_loc: Location.t;
      pcd_attributes: attributes;  (** [C of ... [\@id1] [\@id2]] *)
    }

  and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) =
    | Pcstr_tuple of core_type list
    | Pcstr_record of label_declaration list
        (** Values of type {!constructor_declaration}
      represents the constructor arguments of:
    - [C of T1 * ... * Tn]     when [res = None],
                                and [args = Pcstr_tuple [T1; ... ; Tn]],
    - [C: T0]                  when [res = Some T0],
                                and [args = Pcstr_tuple []],
    - [C: T1 * ... * Tn -> T0] when [res = Some T0],
                                and [args = Pcstr_tuple [T1; ... ; Tn]],
    - [C of {...}]             when [res = None],
                                and [args = Pcstr_record [...]],
    - [C: {...} -> T0]         when [res = Some T0],
                                and [args = Pcstr_record [...]].
  *)

  and type_extension (*IF_CURRENT = Parsetree.type_extension *) =
    {
      ptyext_path: Longident.t loc;
      ptyext_params: (core_type * (variance * injectivity)) list;
      ptyext_constructors: extension_constructor list;
      ptyext_private: private_flag;
      ptyext_loc: Location.t;
      ptyext_attributes: attributes;  (** ... [\@\@id1] [\@\@id2] *)
    }
  (**
     Definition of new extensions constructors for the extensive sum type [t]
     ([type t += ...]).
  *)

  and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) =
    {
      pext_name: string loc;
      pext_kind: extension_constructor_kind;
      pext_loc: Location.t;
      pext_attributes: attributes;  (** [C of ... [\@id1] [\@id2]] *)
    }

  and type_exception (*IF_CURRENT = Parsetree.type_exception *) =
    {
      ptyexn_constructor : extension_constructor;
      ptyexn_loc : Location.t;
      ptyexn_attributes : attributes;  (** [... [\@\@id1] [\@\@id2]] *)
    }
  (** Definition of a new exception ([exception E]). *)

  and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) =
    | Pext_decl of string loc list * constructor_arguments * core_type option
        (** [Pext_decl(existentials, c_args, t_opt)]
            describes a new extension constructor. It can be:
            - [C of T1 * ... * Tn] when:
                 {ul {- [existentials] is [[]],}
                     {- [c_args] is [[T1; ...; Tn]],}
                     {- [t_opt] is [None].}}
            - [C: T0] when
                 {ul {- [existentials] is [[]],}
                     {- [c_args] is [[]],}
                     {- [t_opt] is [Some T0].}}
            - [C: T1 * ... * Tn -> T0] when
                 {ul {- [existentials] is [[]],}
                     {- [c_args] is [[T1; ...; Tn]],}
                     {- [t_opt] is [Some T0].}}
            - [C: 'a... . T1 * ... * Tn -> T0] when
                 {ul {- [existentials] is [['a;...]],}
                     {- [c_args] is [[T1; ... ; Tn]],}
                     {- [t_opt] is [Some T0].}}
         *)
    | Pext_rebind of Longident.t loc
    (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *)

  (** {1 Class language} *)
  (** {2 Type expressions for the class language} *)

  and class_type (*IF_CURRENT = Parsetree.class_type *) =
    {
      pcty_desc: class_type_desc;
      pcty_loc: Location.t;
      pcty_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
    }

  and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) =
    | Pcty_constr of Longident.t loc * core_type list
        (** - [c]
              - [['a1, ..., 'an] c] *)
    | Pcty_signature of class_signature  (** [object ... end] *)
    | Pcty_arrow of arg_label * core_type * class_type
        (** [Pcty_arrow(lbl, T, CT)] represents:
              - [T -> CT]
                       when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]},
              - [~l:T -> CT]
                       when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]},
              - [?l:T -> CT]
                       when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}.
           *)
    | Pcty_extension of extension  (** [%id] *)
    | Pcty_open of open_description * class_type  (** [let open M in CT] *)

  and class_signature (*IF_CURRENT = Parsetree.class_signature *) =
    {
      pcsig_self: core_type;
      pcsig_fields: class_type_field list;
    }
  (** Values of type [class_signature] represents:
      - [object('selfpat) ... end]
      - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]}
                           is {{!core_type_desc.Ptyp_any}[Ptyp_any]}
  *)

  and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) =
    {
      pctf_desc: class_type_field_desc;
      pctf_loc: Location.t;
      pctf_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
    }

  and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) =
    | Pctf_inherit of class_type  (** [inherit CT] *)
    | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type)
        (** [val x: T] *)
    | Pctf_method of (label loc * private_flag * virtual_flag * core_type)
        (** [method x: T]

              Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}.
          *)
    | Pctf_constraint of (core_type * core_type)  (** [constraint T1 = T2] *)
    | Pctf_attribute of attribute  (** [[\@\@\@id]] *)
    | Pctf_extension of extension  (** [[%%id]] *)

  and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) =
    {
      pci_virt: virtual_flag;
      pci_params: (core_type * (variance * injectivity)) list;
      pci_name: string loc;
      pci_expr: 'a;
      pci_loc: Location.t;
      pci_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
    }
  (** Values of type [class_expr class_infos] represents:
      - [class c = ...]
      - [class ['a1,...,'an] c = ...]
      - [class virtual c = ...]

     They are also used for "class type" declaration.
  *)

  and class_description = class_type class_infos

  and class_type_declaration = class_type class_infos

  (** {2 Value expressions for the class language} *)

  and class_expr (*IF_CURRENT = Parsetree.class_expr *) =
      {
       pcl_desc: class_expr_desc;
       pcl_loc: Location.t;
       pcl_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
      }

  and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) =
    | Pcl_constr of Longident.t loc * core_type list
        (** [c] and [['a1, ..., 'an] c] *)
    | Pcl_structure of class_structure  (** [object ... end] *)
    | Pcl_fun of arg_label * expression option * pattern * class_expr
        (** [Pcl_fun(lbl, exp0, P, CE)] represents:
              - [fun P -> CE]
                       when [lbl]  is {{!Asttypes.arg_label.Nolabel}[Nolabel]}
                        and [exp0] is [None],
              - [fun ~l:P -> CE]
                       when [lbl]  is {{!Asttypes.arg_label.Labelled}[Labelled l]}
                        and [exp0] is [None],
              - [fun ?l:P -> CE]
                       when [lbl]  is {{!Asttypes.arg_label.Optional}[Optional l]}
                        and [exp0] is [None],
              - [fun ?l:(P = E0) -> CE]
                       when [lbl]  is {{!Asttypes.arg_label.Optional}[Optional l]}
                        and [exp0] is [Some E0].
          *)
    | Pcl_apply of class_expr * (arg_label * expression) list
        (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])]
              represents [CE ~l1:E1 ... ~ln:En].
              [li] can be empty (non labeled argument) or start with [?]
              (optional argument).

              Invariant: [n > 0]
          *)
    | Pcl_let of rec_flag * value_binding list * class_expr
        (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents:
              - [let P1 = E1 and ... and Pn = EN in CE]
                  when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
              - [let rec P1 = E1 and ... and Pn = EN in CE]
                  when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
          *)
    | Pcl_constraint of class_expr * class_type  (** [(CE : CT)] *)
    | Pcl_extension of extension  (** [[%id]] *)
    | Pcl_open of open_description * class_expr  (** [let open M in CE] *)

  and class_structure (*IF_CURRENT = Parsetree.class_structure *) =
    {
      pcstr_self: pattern;
      pcstr_fields: class_field list;
    }
  (** Values of type {!class_structure} represents:
      - [object(selfpat) ... end]
      - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]}
                           is {{!pattern_desc.Ppat_any}[Ppat_any]}
  *)

  and class_field (*IF_CURRENT = Parsetree.class_field *) =
    {
      pcf_desc: class_field_desc;
      pcf_loc: Location.t;
      pcf_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
    }

  and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) =
    | Pcf_inherit of override_flag * class_expr * string loc option
        (** [Pcf_inherit(flag, CE, s)] represents:
              - [inherit CE]
                      when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
                       and [s] is [None],
              - [inherit CE as x]
                     when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]}
                      and [s] is [Some x],
              - [inherit! CE]
                     when [flag] is {{!Asttypes.override_flag.Override}[Override]}
                      and [s] is [None],
              - [inherit! CE as x]
                     when [flag] is {{!Asttypes.override_flag.Override}[Override]}
                      and [s] is [Some x]
    *)
    | Pcf_val of (label loc * mutable_flag * class_field_kind)
        (** [Pcf_val(x,flag, kind)] represents:
              - [val x = E]
         when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
          and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
              - [val virtual x: T]
         when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]}
          and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
              - [val mutable x = E]
         when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
          and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]}
              - [val mutable virtual x: T]
         when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]}
          and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]}
    *)
    | Pcf_method of (label loc * private_flag * class_field_kind)
        (** - [method x = E]
                          ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]})
              - [method virtual x: T]
                          ([T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]})
    *)
    | Pcf_constraint of (core_type * core_type)  (** [constraint T1 = T2] *)
    | Pcf_initializer of expression  (** [initializer E] *)
    | Pcf_attribute of attribute  (** [[\@\@\@id]] *)
    | Pcf_extension of extension  (** [[%%id]] *)

  and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) =
    | Cfk_virtual of core_type
    | Cfk_concrete of override_flag * expression

  and class_declaration = class_expr class_infos

  (** {1 Module language} *)
  (** {2 Type expressions for the module language} *)

  and module_type (*IF_CURRENT = Parsetree.module_type *) =
    {
      pmty_desc: module_type_desc;
      pmty_loc: Location.t;
      pmty_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
    }

  and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) =
    | Pmty_ident of Longident.t loc  (** [Pmty_ident(S)] represents [S] *)
    | Pmty_signature of signature  (** [sig ... end] *)
    | Pmty_functor of functor_parameter * module_type
        (** [functor(X : MT1) -> MT2] *)
    | Pmty_with of module_type * with_constraint list  (** [MT with ...] *)
    | Pmty_typeof of module_expr  (** [module type of ME] *)
    | Pmty_extension of extension  (** [[%id]] *)
    | Pmty_alias of Longident.t loc  (** [(module M)] *)

  and functor_parameter (*IF_CURRENT = Parsetree.functor_parameter *) =
    | Unit  (** [()] *)
    | Named of string option loc * module_type
        (** [Named(name, MT)] represents:
              - [(X : MT)] when [name] is [Some X],
              - [(_ : MT)] when [name] is [None] *)

  and signature = signature_item list

  and signature_item (*IF_CURRENT = Parsetree.signature_item *) =
    {
      psig_desc: signature_item_desc;
      psig_loc: Location.t;
    }

  and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) =
    | Psig_value of value_description
        (** - [val x: T]
              - [external x: T = "s1" ... "sn"]
           *)
    | Psig_type of rec_flag * type_declaration list
        (** [type t1 = ... and ... and tn  = ...] *)
    | Psig_typesubst of type_declaration list
        (** [type t1 := ... and ... and tn := ...]  *)
    | Psig_typext of type_extension  (** [type t1 += ...] *)
    | Psig_exception of type_exception  (** [exception C of T] *)
    | Psig_module of module_declaration  (** [module X = M] and [module X : MT] *)
    | Psig_modsubst of module_substitution  (** [module X := M] *)
    | Psig_recmodule of module_declaration list
        (** [module rec X1 : MT1 and ... and Xn : MTn] *)
    | Psig_modtype of module_type_declaration
        (** [module type S = MT] and [module type S] *)
    | Psig_modtypesubst of module_type_declaration
        (** [module type S :=  ...]  *)
    | Psig_open of open_description  (** [open X] *)
    | Psig_include of include_description  (** [include MT] *)
    | Psig_class of class_description list
        (** [class c1 : ... and ... and cn : ...] *)
    | Psig_class_type of class_type_declaration list
        (** [class type ct1 = ... and ... and ctn = ...] *)
    | Psig_attribute of attribute  (** [[\@\@\@id]] *)
    | Psig_extension of extension * attributes  (** [[%%id]] *)

  and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) =
    {
      pmd_name: string option loc;
      pmd_type: module_type;
      pmd_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
      pmd_loc: Location.t;
    }
  (** Values of type [module_declaration] represents [S : MT] *)

  and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) =
    {
      pms_name: string loc;
      pms_manifest: Longident.t loc;
      pms_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
      pms_loc: Location.t;
    }
  (** Values of type [module_substitution] represents [S := M] *)

  and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) =
    {
      pmtd_name: string loc;
      pmtd_type: module_type option;
      pmtd_attributes: attributes;  (** [... [\@\@id1] [\@\@id2]] *)
      pmtd_loc: Location.t;
    }
  (** Values of type [module_type_declaration] represents:
     - [S = MT],
     - [S] for abstract module type declaration,
       when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None].
  *)

  and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) =
    {
      popen_expr: 'a;
      popen_override: override_flag;
      popen_loc: Location.t;
      popen_attributes: attributes;
    }
  (** Values of type ['a open_infos] represents:
      - [open! X] when {{!open_infos.popen_override}[popen_override]}
                    is {{!Asttypes.override_flag.Override}[Override]}
      (silences the "used identifier shadowing" warning)
      - [open  X] when {{!open_infos.popen_override}[popen_override]}
                    is {{!Asttypes.override_flag.Fresh}[Fresh]}
  *)

  and open_description = Longident.t loc open_infos
  (** Values of type [open_description] represents:
      - [open M.N]
      - [open M(N).O] *)

  and open_declaration = module_expr open_infos
  (** Values of type [open_declaration] represents:
      - [open M.N]
      - [open M(N).O]
      - [open struct ... end] *)

  and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) =
    {
      pincl_mod: 'a;
      pincl_loc: Location.t;
      pincl_attributes: attributes;
    }

  and include_description = module_type include_infos
  (** Values of type [include_description] represents [include MT] *)

  and include_declaration = module_expr include_infos
  (** Values of type [include_declaration] represents [include ME] *)

  and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) =
    | Pwith_type of Longident.t loc * type_declaration
        (** [with type X.t = ...]

            Note: the last component of the longident must match
            the name of the type_declaration. *)
    | Pwith_module of Longident.t loc * Longident.t loc
        (** [with module X.Y = Z] *)
    | Pwith_modtype of Longident.t loc * module_type
        (** [with module type X.Y = Z] *)
    | Pwith_modtypesubst of Longident.t loc * module_type
        (** [with module type X.Y := sig end] *)
    | Pwith_typesubst of Longident.t loc * type_declaration
        (** [with type X.t := ..., same format as [Pwith_type]] *)
    | Pwith_modsubst of Longident.t loc * Longident.t loc
        (** [with module X.Y := Z] *)

  (** {2 Value expressions for the module language} *)

  and module_expr (*IF_CURRENT = Parsetree.module_expr *) =
    {
      pmod_desc: module_expr_desc;
      pmod_loc: Location.t;
      pmod_attributes: attributes;  (** [... [\@id1] [\@id2]] *)
    }

  and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) =
    | Pmod_ident of Longident.t loc  (** [X] *)
    | Pmod_structure of structure  (** [struct ... end] *)
    | Pmod_functor of functor_parameter * module_expr
        (** [functor(X : MT1) -> ME] *)
    | Pmod_apply of module_expr * module_expr  (** [ME1(ME2)] *)
    | Pmod_apply_unit of module_expr (** [ME1()] *)
    | Pmod_constraint of module_expr * module_type  (** [(ME : MT)] *)
    | Pmod_unpack of expression  (** [(val E)] *)
    | Pmod_extension of extension  (** [[%id]] *)

  and structure = structure_item list

  and structure_item (*IF_CURRENT = Parsetree.structure_item *) =
    {
      pstr_desc: structure_item_desc;
      pstr_loc: Location.t;
    }

  and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) =
    | Pstr_eval of expression * attributes  (** [E] *)
    | Pstr_value of rec_flag * value_binding list
        (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents:
              - [let P1 = E1 and ... and Pn = EN]
                  when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]},
              - [let rec P1 = E1 and ... and Pn = EN ]
                  when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}.
          *)
    | Pstr_primitive of value_description
        (** - [val x: T]
              - [external x: T = "s1" ... "sn" ]*)
    | Pstr_type of rec_flag * type_declaration list
        (** [type t1 = ... and ... and tn = ...] *)
    | Pstr_typext of type_extension  (** [type t1 += ...] *)
    | Pstr_exception of type_exception
        (** - [exception C of T]
              - [exception C = M.X] *)
    | Pstr_module of module_binding  (** [module X = ME] *)
    | Pstr_recmodule of module_binding list
        (** [module rec X1 = ME1 and ... and Xn = MEn] *)
    | Pstr_modtype of module_type_declaration  (** [module type S = MT] *)
    | Pstr_open of open_declaration  (** [open X] *)
    | Pstr_class of class_declaration list
        (** [class c1 = ... and ... and cn = ...] *)
    | Pstr_class_type of class_type_declaration list
        (** [class type ct1 = ... and ... and ctn = ...] *)
    | Pstr_include of include_declaration  (** [include ME] *)
    | Pstr_attribute of attribute  (** [[\@\@\@id]] *)
    | Pstr_extension of extension * attributes  (** [[%%id]] *)

  and value_constraint (*IF_CURRENT = Parsetree.value_constraint *) =
    | Pvc_constraint of {
      locally_abstract_univars:string loc list;
      typ:core_type;
      }
    | Pvc_coercion of {ground:core_type option; coercion:core_type }

  and value_binding (*IF_CURRENT = Parsetree.value_binding *) =
    {
      pvb_pat: pattern;
      pvb_expr: expression;
      pvb_constraint: value_constraint option;
      pvb_attributes: attributes;
      pvb_loc: Location.t;
    }

  and module_binding (*IF_CURRENT = Parsetree.module_binding *) =
    {
      pmb_name: string option loc;
      pmb_expr: module_expr;
      pmb_attributes: attributes;
      pmb_loc: Location.t;
    }
  (** Values of type [module_binding] represents [module X = ME] *)

  (** {1 Toplevel} *)

  (** {2 Toplevel phrases} *)

  type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) =
    | Ptop_def of structure
    | Ptop_dir of toplevel_directive  (** [#use], [#load] ... *)

  and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) =
    {
      pdir_name: string loc;
      pdir_arg: directive_argument option;
      pdir_loc: Location.t;
    }

  and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) =
    {
      pdira_desc: directive_argument_desc;
      pdira_loc: Location.t;
    }

  and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) =
    | Pdir_string of string
    | Pdir_int of string * char option
    | Pdir_ident of Longident.t
    | Pdir_bool of bool
end

module Config = struct
  let ast_impl_magic_number = "Caml1999M034"
  let ast_intf_magic_number = "Caml1999N034"
end