diff --git a/.github/workflows/trunk-build.yml b/.github/workflows/trunk-build.yml index 7256536fb..4ed60885d 100644 --- a/.github/workflows/trunk-build.yml +++ b/.github/workflows/trunk-build.yml @@ -28,7 +28,7 @@ jobs: - name: Install OCaml compiler uses: ocaml/setup-ocaml@v3 with: - ocaml-compiler: 'ocaml-variants.5.4.0+trunk' + ocaml-compiler: 'ocaml-variants.5.5.0+trunk' dune-cache: true cache-prefix: ${{ steps.setup.outputs.cache_prefix }} diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore index ea0aebccb..e60a568a8 100644 --- a/.ocamlformat-ignore +++ b/.ocamlformat-ignore @@ -21,6 +21,7 @@ astlib/ast_501.ml astlib/ast_502.ml astlib/ast_503.ml astlib/ast_504.ml +astlib/ast_505.ml # Files that use cinaps to generate code blocks from other code blocks work well, # but files that inject freely formatted code via cinaps must be excluded diff --git a/ast/supported_version/supported_version.ml b/ast/supported_version/supported_version.ml index d0a1aa3d9..6110527ee 100644 --- a/ast/supported_version/supported_version.ml +++ b/ast/supported_version/supported_version.ml @@ -14,6 +14,7 @@ let all = (5, 2); (5, 3); (5, 4); + (5, 5); ] let to_string (a, b) = diff --git a/ast/versions.ml b/ast/versions.ml index a2312f4aa..5f9b2ebc3 100644 --- a/ast/versions.ml +++ b/ast/versions.ml @@ -654,6 +654,13 @@ module OCaml_504 = struct let string_version = "5.4" end let ocaml_504 : OCaml_504.types ocaml_version = (module OCaml_504) +module OCaml_505 = struct + module Ast = Astlib.Ast_505 + include Make_witness(Astlib.Ast_505) + let version = 505 + let string_version = "5.5" +end +let ocaml_505 : OCaml_505.types ocaml_version = (module OCaml_505) (*$*) let all_versions : (module OCaml_version) list = [ @@ -671,6 +678,7 @@ let all_versions : (module OCaml_version) list = [ (module OCaml_502 : OCaml_version); (module OCaml_503 : OCaml_version); (module OCaml_504 : OCaml_version); +(module OCaml_505 : OCaml_version); (*$*) ] @@ -701,6 +709,8 @@ include Register_migration(OCaml_502)(OCaml_503) (Astlib.Migrate_502_503)(Astlib.Migrate_503_502) include Register_migration(OCaml_503)(OCaml_504) (Astlib.Migrate_503_504)(Astlib.Migrate_504_503) +include Register_migration(OCaml_504)(OCaml_505) + (Astlib.Migrate_504_505)(Astlib.Migrate_505_504) (*$*) module OCaml_current = OCaml_OCAML_VERSION diff --git a/ast/versions.mli b/ast/versions.mli index 7a3b3a73d..fe63ed700 100644 --- a/ast/versions.mli +++ b/ast/versions.mli @@ -154,6 +154,7 @@ module OCaml_501 : OCaml_version with module Ast = Astlib.Ast_501 module OCaml_502 : OCaml_version with module Ast = Astlib.Ast_502 module OCaml_503 : OCaml_version with module Ast = Astlib.Ast_503 module OCaml_504 : OCaml_version with module Ast = Astlib.Ast_504 +module OCaml_505 : OCaml_version with module Ast = Astlib.Ast_505 (*$*) (* An alias to the current compiler version *) diff --git a/astlib/ast_505.ml b/astlib/ast_505.ml new file mode 100644 index 000000000..28df2ccc0 --- /dev/null +++ b/astlib/ast_505.ml @@ -0,0 +1,1179 @@ +module Longident = struct + type t = Longident_504.t = + | Lident of string + | Ldot of t Location.loc * string Location.loc + | Lapply of t Location.loc * t Location.loc +end + +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 + | Bivariant + + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity +end + +module Parsetree = struct + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = { + pconst_desc : constant_desc; + pconst_loc : Location.t; + } + + and constant_desc (*IF_CURRENT = Parsetree.constant_desc *) = + | 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 (string option * core_type) list + (** [Ptyp_tuple(tl)] represents a product type: + - [T1 * ... * Tn] + when [tl] is [(None, T1); ...; (None, Tn)] + - [L1:T1 * ... * Ln:Tn] + when [tl] is [(Some L1, T1); ...; (Some Ln, Tn)] + - A mix, e.g., [L1:T1 * T2] + when [tl] is [(Some L1, T1); (None, T2)] *) + | 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 (*IF_CURRENT = Parsetree.package_type *) = + { + ppt_path: Longident.t loc; + ppt_constraints: (Longident.t loc * core_type) list; + ppt_loc: Location.t; + ppt_attrs: attributes; + } + (** As {!package_type} typed values: + - [{ppt_path: S; ppt_constraints: []}] represents [(module S)], + - [{ppt_path: S; ppt_constraints: [(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 (string option * pattern) list * Asttypes.closed_flag + (** [Ppat_tuple(pl, Closed)] represents + - [(P1, ..., Pn)] + when [pl] is [(None, P1); ...; (None, Pn)] + - [(~L1:P1, ..., ~Ln:Pn)] + when [pl] is [(Some L1, P1); ...; (Some Ln, Pn)] + - A mix, e.g. [(~L1:P1, P2)] + when [pl] is [(Some L1, P1); (None, P2)] + + [Ppat_tuple(pl, Open)] is similar, but indicates the pattern + additionally ends in a [..]. + + Invariant: + - If Closed, [n >= 2]. + - If Open, [n >= 1]. + *) + | 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 * package_type option + (** [Ppat_unpack(s, ptyp)] represents: + - [(module P : S)] when [s] is [Some "P"] and [ptyp] is [Some "S"] + - [(module _ : S)] when [s] is [None] and [ptyp] is [Some "S"] + - [(module P)] when [s] is [Some "P"] and [ptyp] is [None] + - [(module _)] when [s] is [None] and [ptyp] is [None] + *) + | Ppat_exception of pattern (** Pattern [exception P] *) + | Ppat_effect of pattern * pattern (* Pattern [effect P 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 (string option * expression) list + (** [Pexp_tuple(el)] represents + - [(E1, ..., En)] + when [el] is [(None, E1); ...; (None, En)] + - [(~L1:E1, ..., ~Ln:En)] + when [el] is [(Some L1, E1); ...; (Some Ln, En)] + - A mix, e.g., [(~L1:E1, E2)] + when [el] is [(Some L1, E1); (None, E2)] + *) + | 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_struct_item of structure_item * expression + (** [let SI 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 * package_type option + (** [(module ME)] or [(module ME : S)]. *) + | 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_constraints: (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 + | Ptype_external of string + + 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 } + (** + - [Pvc_constraint { locally_abstract_univars=[]; typ}] + is a simple type constraint on a value binding: [ let x : typ] + - More generally, in [Pvc_constraint { locally_abstract_univars; typ}] + [locally_abstract_univars] is the list of locally abstract type + variables in [ let x: type a ... . typ ] + - [Pvc_coercion { ground=None; coercion }] represents [let x :> typ] + - [Pvc_coercion { ground=Some g; coercion }] represents [let x : g :> typ] + *) + + 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; + }(** [let pat : type_constraint = exp] *) + + 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 = "Caml1999M037" + let ast_intf_magic_number = "Caml1999N037" +end diff --git a/astlib/astlib.ml b/astlib/astlib.ml index 88deef006..b75607110 100644 --- a/astlib/astlib.ml +++ b/astlib/astlib.ml @@ -34,6 +34,7 @@ module Ast_501 = Ast_501 module Ast_502 = Ast_502 module Ast_503 = Ast_503 module Ast_504 = Ast_504 +module Ast_505 = Ast_505 (*$*) (* Manual migration between versions *) @@ -64,6 +65,8 @@ module Migrate_502_503 = Migrate_502_503 module Migrate_503_502 = Migrate_503_502 module Migrate_503_504 = Migrate_503_504 module Migrate_504_503 = Migrate_504_503 +module Migrate_504_505 = Migrate_504_505 +module Migrate_505_504 = Migrate_505_504 (*$*) (* Compiler modules *) diff --git a/astlib/cinaps/astlib_cinaps_helpers.ml b/astlib/cinaps/astlib_cinaps_helpers.ml index 23afa5eb4..494eb4846 100644 --- a/astlib/cinaps/astlib_cinaps_helpers.ml +++ b/astlib/cinaps/astlib_cinaps_helpers.ml @@ -19,6 +19,7 @@ let supported_versions = ("502", "5.02"); ("503", "5.03"); ("504", "5.04"); + ("505", "5.05"); ] let foreach_version f = diff --git a/astlib/config/gen.ml b/astlib/config/gen.ml index a23114b87..84033c7cf 100644 --- a/astlib/config/gen.ml +++ b/astlib/config/gen.ml @@ -24,6 +24,7 @@ let () = | 5, 2 -> "502" | 5, 3 -> "503" | 5, 4 -> "504" + | 5, 5 -> "505" | _ -> Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str; exit 1) diff --git a/astlib/migrate_504_505.ml b/astlib/migrate_504_505.ml new file mode 100644 index 000000000..d7cf74dfb --- /dev/null +++ b/astlib/migrate_504_505.ml @@ -0,0 +1,1355 @@ +open Stdlib0 +module From = Ast_504 +module To = Ast_505 + +let copy_location x = x + +let rec copy_longident : Ast_504.Longident.t -> Ast_505.Longident.t = function + | Ast_504.Longident.Lident x0 -> Ast_505.Longident.Lident x0 + | Ast_504.Longident.Ldot (x0, x1) -> + Ast_505.Longident.Ldot + (copy_loc copy_longident x0, copy_loc (fun x -> x) x1) + | Ast_504.Longident.Lapply (x0, x1) -> + Ast_505.Longident.Lapply + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_asttypes_constant : + Ast_504.Asttypes.constant -> Ast_505.Asttypes.constant = function + | Ast_504.Asttypes.Const_int x0 -> Ast_505.Asttypes.Const_int x0 + | Ast_504.Asttypes.Const_char x0 -> Ast_505.Asttypes.Const_char x0 + | Ast_504.Asttypes.Const_string (x0, x1, x2) -> + Ast_505.Asttypes.Const_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_504.Asttypes.Const_float x0 -> Ast_505.Asttypes.Const_float x0 + | Ast_504.Asttypes.Const_int32 x0 -> Ast_505.Asttypes.Const_int32 x0 + | Ast_504.Asttypes.Const_int64 x0 -> Ast_505.Asttypes.Const_int64 x0 + | Ast_504.Asttypes.Const_nativeint x0 -> Ast_505.Asttypes.Const_nativeint x0 + +and copy_rec_flag : Ast_504.Asttypes.rec_flag -> Ast_505.Asttypes.rec_flag = + function + | Ast_504.Asttypes.Nonrecursive -> Ast_505.Asttypes.Nonrecursive + | Ast_504.Asttypes.Recursive -> Ast_505.Asttypes.Recursive + +and copy_direction_flag : + Ast_504.Asttypes.direction_flag -> Ast_505.Asttypes.direction_flag = + function + | Ast_504.Asttypes.Upto -> Ast_505.Asttypes.Upto + | Ast_504.Asttypes.Downto -> Ast_505.Asttypes.Downto + +and copy_private_flag : + Ast_504.Asttypes.private_flag -> Ast_505.Asttypes.private_flag = function + | Ast_504.Asttypes.Private -> Ast_505.Asttypes.Private + | Ast_504.Asttypes.Public -> Ast_505.Asttypes.Public + +and copy_mutable_flag : + Ast_504.Asttypes.mutable_flag -> Ast_505.Asttypes.mutable_flag = function + | Ast_504.Asttypes.Immutable -> Ast_505.Asttypes.Immutable + | Ast_504.Asttypes.Mutable -> Ast_505.Asttypes.Mutable + +and copy_virtual_flag : + Ast_504.Asttypes.virtual_flag -> Ast_505.Asttypes.virtual_flag = function + | Ast_504.Asttypes.Virtual -> Ast_505.Asttypes.Virtual + | Ast_504.Asttypes.Concrete -> Ast_505.Asttypes.Concrete + +and copy_override_flag : + Ast_504.Asttypes.override_flag -> Ast_505.Asttypes.override_flag = function + | Ast_504.Asttypes.Override -> Ast_505.Asttypes.Override + | Ast_504.Asttypes.Fresh -> Ast_505.Asttypes.Fresh + +and copy_closed_flag : + Ast_504.Asttypes.closed_flag -> Ast_505.Asttypes.closed_flag = function + | Ast_504.Asttypes.Closed -> Ast_505.Asttypes.Closed + | Ast_504.Asttypes.Open -> Ast_505.Asttypes.Open + +and copy_label : Ast_504.Asttypes.label -> Ast_505.Asttypes.label = fun x -> x + +and copy_arg_label : Ast_504.Asttypes.arg_label -> Ast_505.Asttypes.arg_label = + function + | Ast_504.Asttypes.Nolabel -> Ast_505.Asttypes.Nolabel + | Ast_504.Asttypes.Labelled x0 -> Ast_505.Asttypes.Labelled x0 + | Ast_504.Asttypes.Optional x0 -> Ast_505.Asttypes.Optional x0 + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_504.Asttypes.loc -> 'g0 Ast_505.Asttypes.loc = + fun f0 { Ast_504.Asttypes.txt; Ast_504.Asttypes.loc } -> + { Ast_505.Asttypes.txt = f0 txt; Ast_505.Asttypes.loc = copy_location loc } + +and copy_variance : Ast_504.Asttypes.variance -> Ast_505.Asttypes.variance = + function + | Ast_504.Asttypes.Covariant -> Ast_505.Asttypes.Covariant + | Ast_504.Asttypes.Contravariant -> Ast_505.Asttypes.Contravariant + | Ast_504.Asttypes.NoVariance -> Ast_505.Asttypes.NoVariance + | Ast_504.Asttypes.Bivariant -> Ast_505.Asttypes.Bivariant + +and copy_injectivity : + Ast_504.Asttypes.injectivity -> Ast_505.Asttypes.injectivity = function + | Ast_504.Asttypes.Injective -> Ast_505.Asttypes.Injective + | Ast_504.Asttypes.NoInjectivity -> Ast_505.Asttypes.NoInjectivity + +and copy_constant : Ast_504.Parsetree.constant -> Ast_505.Parsetree.constant = + fun { Ast_504.Parsetree.pconst_desc; Ast_504.Parsetree.pconst_loc } -> + { + Ast_505.Parsetree.pconst_desc = copy_constant_desc pconst_desc; + Ast_505.Parsetree.pconst_loc = copy_location pconst_loc; + } + +and copy_constant_desc : + Ast_504.Parsetree.constant_desc -> Ast_505.Parsetree.constant_desc = + function + | Ast_504.Parsetree.Pconst_integer (x0, x1) -> + Ast_505.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_504.Parsetree.Pconst_char x0 -> Ast_505.Parsetree.Pconst_char x0 + | Ast_504.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_505.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_504.Parsetree.Pconst_float (x0, x1) -> + Ast_505.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + +and copy_location_stack : + Ast_504.Parsetree.location_stack -> Ast_505.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_attribute : Ast_504.Parsetree.attribute -> Ast_505.Parsetree.attribute + = + fun { + Ast_504.Parsetree.attr_name; + Ast_504.Parsetree.attr_payload; + Ast_504.Parsetree.attr_loc; + } -> + { + Ast_505.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_505.Parsetree.attr_payload = copy_payload attr_payload; + Ast_505.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_extension : Ast_504.Parsetree.extension -> Ast_505.Parsetree.extension + = + fun x -> + let x0, x1 = x in + (copy_loc (fun x -> x) x0, copy_payload x1) + +and copy_attributes : + Ast_504.Parsetree.attributes -> Ast_505.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_payload : Ast_504.Parsetree.payload -> Ast_505.Parsetree.payload = + function + | Ast_504.Parsetree.PStr x0 -> Ast_505.Parsetree.PStr (copy_structure x0) + | Ast_504.Parsetree.PSig x0 -> Ast_505.Parsetree.PSig (copy_signature x0) + | Ast_504.Parsetree.PTyp x0 -> Ast_505.Parsetree.PTyp (copy_core_type x0) + | Ast_504.Parsetree.PPat (x0, x1) -> + Ast_505.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_core_type : Ast_504.Parsetree.core_type -> Ast_505.Parsetree.core_type + = + fun { + Ast_504.Parsetree.ptyp_desc; + Ast_504.Parsetree.ptyp_loc; + Ast_504.Parsetree.ptyp_loc_stack; + Ast_504.Parsetree.ptyp_attributes; + } -> + { + Ast_505.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_505.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_505.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_505.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_core_type_desc : + Ast_504.Parsetree.core_type_desc -> Ast_505.Parsetree.core_type_desc = + function + | Ast_504.Parsetree.Ptyp_any -> Ast_505.Parsetree.Ptyp_any + | Ast_504.Parsetree.Ptyp_var x0 -> Ast_505.Parsetree.Ptyp_var x0 + | Ast_504.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_505.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_504.Parsetree.Ptyp_tuple x0 -> + Ast_505.Parsetree.Ptyp_tuple + (List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_core_type x1)) + x0) + | Ast_504.Parsetree.Ptyp_constr (x0, x1) -> + Ast_505.Parsetree.Ptyp_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Ptyp_object (x0, x1) -> + Ast_505.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_504.Parsetree.Ptyp_class (x0, x1) -> + Ast_505.Parsetree.Ptyp_class + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Ptyp_alias (x0, x1) -> + Ast_505.Parsetree.Ptyp_alias (copy_core_type x0, copy_loc (fun x -> x) x1) + | Ast_504.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_505.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (List.map copy_label) x2 ) + | Ast_504.Parsetree.Ptyp_poly (x0, x1) -> + Ast_505.Parsetree.Ptyp_poly + (List.map (copy_loc (fun x -> x)) x0, copy_core_type x1) + | Ast_504.Parsetree.Ptyp_package x0 -> + Ast_505.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_504.Parsetree.Ptyp_open (x0, x1) -> + Ast_505.Parsetree.Ptyp_open (copy_loc copy_longident x0, copy_core_type x1) + | Ast_504.Parsetree.Ptyp_extension x0 -> + Ast_505.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_504.Parsetree.package_type -> Ast_505.Parsetree.package_type = + fun { + Ast_504.Parsetree.ppt_path; + Ast_504.Parsetree.ppt_cstrs; + Ast_504.Parsetree.ppt_loc; + Ast_504.Parsetree.ppt_attrs; + } -> + { + Ast_505.Parsetree.ppt_path = copy_loc copy_longident ppt_path; + Ast_505.Parsetree.ppt_constraints = + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_core_type x1)) + ppt_cstrs; + Ast_505.Parsetree.ppt_loc = copy_location ppt_loc; + Ast_505.Parsetree.ppt_attrs = copy_attributes ppt_attrs; + } + +and copy_row_field : Ast_504.Parsetree.row_field -> Ast_505.Parsetree.row_field + = + fun { + Ast_504.Parsetree.prf_desc; + Ast_504.Parsetree.prf_loc; + Ast_504.Parsetree.prf_attributes; + } -> + { + Ast_505.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_505.Parsetree.prf_loc = copy_location prf_loc; + Ast_505.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_504.Parsetree.row_field_desc -> Ast_505.Parsetree.row_field_desc = + function + | Ast_504.Parsetree.Rtag (x0, x1, x2) -> + Ast_505.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_504.Parsetree.Rinherit x0 -> + Ast_505.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_504.Parsetree.object_field -> Ast_505.Parsetree.object_field = + fun { + Ast_504.Parsetree.pof_desc; + Ast_504.Parsetree.pof_loc; + Ast_504.Parsetree.pof_attributes; + } -> + { + Ast_505.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_505.Parsetree.pof_loc = copy_location pof_loc; + Ast_505.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_object_field_desc : + Ast_504.Parsetree.object_field_desc -> Ast_505.Parsetree.object_field_desc = + function + | Ast_504.Parsetree.Otag (x0, x1) -> + Ast_505.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_504.Parsetree.Oinherit x0 -> + Ast_505.Parsetree.Oinherit (copy_core_type x0) + +and copy_pattern : Ast_504.Parsetree.pattern -> Ast_505.Parsetree.pattern = + fun { + Ast_504.Parsetree.ppat_desc; + Ast_504.Parsetree.ppat_loc; + Ast_504.Parsetree.ppat_loc_stack; + Ast_504.Parsetree.ppat_attributes; + } -> + { + Ast_505.Parsetree.ppat_desc = copy_pattern_desc ppat_desc; + Ast_505.Parsetree.ppat_loc = copy_location ppat_loc; + Ast_505.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_505.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc : + Ast_504.Parsetree.pattern_desc -> Ast_505.Parsetree.pattern_desc = function + | Ast_504.Parsetree.Ppat_any -> Ast_505.Parsetree.Ppat_any + | Ast_504.Parsetree.Ppat_var x0 -> + Ast_505.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_504.Parsetree.Ppat_alias (x0, x1) -> + Ast_505.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_504.Parsetree.Ppat_constant x0 -> + Ast_505.Parsetree.Ppat_constant (copy_constant x0) + | Ast_504.Parsetree.Ppat_interval (x0, x1) -> + Ast_505.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1) + | Ast_504.Parsetree.Ppat_tuple (x0, x1) -> + Ast_505.Parsetree.Ppat_tuple + ( List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_504.Parsetree.Ppat_construct (x0, x1) -> + Ast_505.Parsetree.Ppat_construct + ( copy_loc copy_longident x0, + Option.map + (fun x -> + let x0, x1 = x in + (List.map (copy_loc (fun x -> x)) x0, copy_pattern x1)) + x1 ) + | Ast_504.Parsetree.Ppat_variant (x0, x1) -> + Ast_505.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_504.Parsetree.Ppat_record (x0, x1) -> + Ast_505.Parsetree.Ppat_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_504.Parsetree.Ppat_array x0 -> + Ast_505.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_504.Parsetree.Ppat_or (x0, x1) -> + Ast_505.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_504.Parsetree.Ppat_constraint (x0, x1) -> + Ast_505.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_504.Parsetree.Ppat_type x0 -> + Ast_505.Parsetree.Ppat_type (copy_loc copy_longident x0) + | Ast_504.Parsetree.Ppat_lazy x0 -> + Ast_505.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_504.Parsetree.Ppat_unpack x0 -> + Ast_505.Parsetree.Ppat_unpack (copy_loc (Option.map (fun x -> x)) x0, None) + | Ast_504.Parsetree.Ppat_exception x0 -> + Ast_505.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_504.Parsetree.Ppat_effect (x0, x1) -> + Ast_505.Parsetree.Ppat_effect (copy_pattern x0, copy_pattern x1) + | Ast_504.Parsetree.Ppat_extension x0 -> + Ast_505.Parsetree.Ppat_extension (copy_extension x0) + | Ast_504.Parsetree.Ppat_open (x0, x1) -> + Ast_505.Parsetree.Ppat_open (copy_loc copy_longident x0, copy_pattern x1) + +and copy_expression : + Ast_504.Parsetree.expression -> Ast_505.Parsetree.expression = + fun { + Ast_504.Parsetree.pexp_desc; + Ast_504.Parsetree.pexp_loc; + Ast_504.Parsetree.pexp_loc_stack; + Ast_504.Parsetree.pexp_attributes; + } -> + { + Ast_505.Parsetree.pexp_desc = copy_expression_desc pexp_desc; + Ast_505.Parsetree.pexp_loc = copy_location pexp_loc; + Ast_505.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_505.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_504.Parsetree.expression_desc -> Ast_505.Parsetree.expression_desc = + function + | Ast_504.Parsetree.Pexp_ident x0 -> + Ast_505.Parsetree.Pexp_ident (copy_loc copy_longident x0) + | Ast_504.Parsetree.Pexp_constant x0 -> + Ast_505.Parsetree.Pexp_constant (copy_constant x0) + | Ast_504.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_505.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_504.Parsetree.Pexp_function (x0, x1, x2) -> + Ast_505.Parsetree.Pexp_function + ( List.map copy_function_param x0, + Option.map copy_type_constraint x1, + copy_function_body x2 ) + | Ast_504.Parsetree.Pexp_apply (x0, x1) -> + Ast_505.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_504.Parsetree.Pexp_match (x0, x1) -> + Ast_505.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_504.Parsetree.Pexp_try (x0, x1) -> + Ast_505.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_504.Parsetree.Pexp_tuple x0 -> + Ast_505.Parsetree.Pexp_tuple + (List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_expression x1)) + x0) + | Ast_504.Parsetree.Pexp_construct (x0, x1) -> + Ast_505.Parsetree.Pexp_construct + (copy_loc copy_longident x0, Option.map copy_expression x1) + | Ast_504.Parsetree.Pexp_variant (x0, x1) -> + Ast_505.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_504.Parsetree.Pexp_record (x0, x1) -> + Ast_505.Parsetree.Pexp_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_expression x1)) + x0, + Option.map copy_expression x1 ) + | Ast_504.Parsetree.Pexp_field (x0, x1) -> + Ast_505.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_longident x1) + | Ast_504.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_505.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_longident x1, copy_expression x2) + | Ast_504.Parsetree.Pexp_array x0 -> + Ast_505.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_504.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_505.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_504.Parsetree.Pexp_sequence (x0, x1) -> + Ast_505.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_while (x0, x1) -> + Ast_505.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_505.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_504.Parsetree.Pexp_constraint (x0, x1) -> + Ast_505.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_504.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_505.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_504.Parsetree.Pexp_send (x0, x1) -> + Ast_505.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_504.Parsetree.Pexp_new x0 -> + Ast_505.Parsetree.Pexp_new (copy_loc copy_longident x0) + | Ast_504.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_505.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_override x0 -> + Ast_505.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_504.Parsetree.Pexp_letmodule (x0, x1, x2) -> + let letmodule : Ast_505.Parsetree.structure_item = + let module_binding_location : Location.t = + { + loc_start = x0.loc.loc_start; + loc_end = x1.pmod_loc.loc_end; + loc_ghost = false; + } + in + let mb : Ast_505.Parsetree.module_binding = + { + pmb_name = copy_loc (Option.map (fun x -> x)) x0; + pmb_expr = copy_module_expr x1; + pmb_loc = module_binding_location; + pmb_attributes = []; + } + in + let pstr_desc = Ast_505.Parsetree.Pstr_module mb in + Ast_505.Parsetree.{ pstr_desc; pstr_loc = module_binding_location } + in + Ast_505.Parsetree.Pexp_struct_item (letmodule, copy_expression x2) + | Ast_504.Parsetree.Pexp_letexception (x0, x1) -> + let tyexception : Ast_505.Parsetree.structure_item = + let exn : Ast_505.Parsetree.type_exception = + { + ptyexn_constructor = copy_extension_constructor x0; + ptyexn_loc = copy_location x0.pext_loc; + ptyexn_attributes = []; + } + in + let pstr_desc = Ast_505.Parsetree.Pstr_exception exn in + Ast_505.Parsetree.{ pstr_desc; pstr_loc = copy_location x0.pext_loc } + in + Ast_505.Parsetree.Pexp_struct_item (tyexception, copy_expression x1) + | Ast_504.Parsetree.Pexp_assert x0 -> + Ast_505.Parsetree.Pexp_assert (copy_expression x0) + | Ast_504.Parsetree.Pexp_lazy x0 -> + Ast_505.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_504.Parsetree.Pexp_poly (x0, x1) -> + Ast_505.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_504.Parsetree.Pexp_object x0 -> + Ast_505.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_504.Parsetree.Pexp_newtype (x0, x1) -> + Ast_505.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_pack (x0, x1) -> + Ast_505.Parsetree.Pexp_pack + (copy_module_expr x0, Option.map copy_package_type x1) + | Ast_504.Parsetree.Pexp_open (x0, x1) -> + let opendecl : Ast_505.Parsetree.structure_item = + let pstr_desc = + Ast_505.Parsetree.Pstr_open (copy_open_declaration x0) + in + Ast_505.Parsetree.{ pstr_desc; pstr_loc = copy_location x0.popen_loc } + in + Ast_505.Parsetree.Pexp_struct_item (opendecl, copy_expression x1) + | Ast_504.Parsetree.Pexp_letop x0 -> + Ast_505.Parsetree.Pexp_letop (copy_letop x0) + | Ast_504.Parsetree.Pexp_extension x0 -> + Ast_505.Parsetree.Pexp_extension (copy_extension x0) + | Ast_504.Parsetree.Pexp_unreachable -> Ast_505.Parsetree.Pexp_unreachable + +and copy_case : Ast_504.Parsetree.case -> Ast_505.Parsetree.case = + fun { + Ast_504.Parsetree.pc_lhs; + Ast_504.Parsetree.pc_guard; + Ast_504.Parsetree.pc_rhs; + } -> + { + Ast_505.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_505.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_505.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_letop : Ast_504.Parsetree.letop -> Ast_505.Parsetree.letop = + fun { Ast_504.Parsetree.let_; Ast_504.Parsetree.ands; Ast_504.Parsetree.body } -> + { + Ast_505.Parsetree.let_ = copy_binding_op let_; + Ast_505.Parsetree.ands = List.map copy_binding_op ands; + Ast_505.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_504.Parsetree.binding_op -> Ast_505.Parsetree.binding_op = + fun { + Ast_504.Parsetree.pbop_op; + Ast_504.Parsetree.pbop_pat; + Ast_504.Parsetree.pbop_exp; + Ast_504.Parsetree.pbop_loc; + } -> + { + Ast_505.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_505.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_505.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_505.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_function_param_desc : + Ast_504.Parsetree.function_param_desc -> + Ast_505.Parsetree.function_param_desc = function + | Ast_504.Parsetree.Pparam_val (x0, x1, x2) -> + Ast_505.Parsetree.Pparam_val + (copy_arg_label x0, Option.map copy_expression x1, copy_pattern x2) + | Ast_504.Parsetree.Pparam_newtype x0 -> + Ast_505.Parsetree.Pparam_newtype (copy_loc (fun x -> x) x0) + +and copy_function_param : + Ast_504.Parsetree.function_param -> Ast_505.Parsetree.function_param = + fun { Ast_504.Parsetree.pparam_loc; Ast_504.Parsetree.pparam_desc } -> + { + Ast_505.Parsetree.pparam_loc = copy_location pparam_loc; + Ast_505.Parsetree.pparam_desc = copy_function_param_desc pparam_desc; + } + +and copy_function_body : + Ast_504.Parsetree.function_body -> Ast_505.Parsetree.function_body = + function + | Ast_504.Parsetree.Pfunction_body x0 -> + Ast_505.Parsetree.Pfunction_body (copy_expression x0) + | Ast_504.Parsetree.Pfunction_cases (x0, x1, x2) -> + Ast_505.Parsetree.Pfunction_cases + (List.map copy_case x0, copy_location x1, copy_attributes x2) + +and copy_type_constraint : + Ast_504.Parsetree.type_constraint -> Ast_505.Parsetree.type_constraint = + function + | Ast_504.Parsetree.Pconstraint x0 -> + Ast_505.Parsetree.Pconstraint (copy_core_type x0) + | Ast_504.Parsetree.Pcoerce (x0, x1) -> + Ast_505.Parsetree.Pcoerce (Option.map copy_core_type x0, copy_core_type x1) + +and copy_value_description : + Ast_504.Parsetree.value_description -> Ast_505.Parsetree.value_description = + fun { + Ast_504.Parsetree.pval_name; + Ast_504.Parsetree.pval_type; + Ast_504.Parsetree.pval_prim; + Ast_504.Parsetree.pval_attributes; + Ast_504.Parsetree.pval_loc; + } -> + { + Ast_505.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_505.Parsetree.pval_type = copy_core_type pval_type; + Ast_505.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_505.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_505.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_type_declaration : + Ast_504.Parsetree.type_declaration -> Ast_505.Parsetree.type_declaration = + fun { + Ast_504.Parsetree.ptype_name; + Ast_504.Parsetree.ptype_params; + Ast_504.Parsetree.ptype_cstrs; + Ast_504.Parsetree.ptype_kind; + Ast_504.Parsetree.ptype_private; + Ast_504.Parsetree.ptype_manifest; + Ast_504.Parsetree.ptype_attributes; + Ast_504.Parsetree.ptype_loc; + } -> + { + Ast_505.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_505.Parsetree.ptype_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptype_params; + Ast_505.Parsetree.ptype_constraints = + List.map + (fun x -> + let x0, x1, x2 = x in + (copy_core_type x0, copy_core_type x1, copy_location x2)) + ptype_cstrs; + Ast_505.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_505.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_505.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_505.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_505.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_type_kind : Ast_504.Parsetree.type_kind -> Ast_505.Parsetree.type_kind + = function + | Ast_504.Parsetree.Ptype_abstract -> Ast_505.Parsetree.Ptype_abstract + | Ast_504.Parsetree.Ptype_variant x0 -> + Ast_505.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_504.Parsetree.Ptype_record x0 -> + Ast_505.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_504.Parsetree.Ptype_open -> Ast_505.Parsetree.Ptype_open + +and copy_label_declaration : + Ast_504.Parsetree.label_declaration -> Ast_505.Parsetree.label_declaration = + fun { + Ast_504.Parsetree.pld_name; + Ast_504.Parsetree.pld_mutable; + Ast_504.Parsetree.pld_type; + Ast_504.Parsetree.pld_loc; + Ast_504.Parsetree.pld_attributes; + } -> + { + Ast_505.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_505.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_505.Parsetree.pld_type = copy_core_type pld_type; + Ast_505.Parsetree.pld_loc = copy_location pld_loc; + Ast_505.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_constructor_declaration : + Ast_504.Parsetree.constructor_declaration -> + Ast_505.Parsetree.constructor_declaration = + fun { + Ast_504.Parsetree.pcd_name; + Ast_504.Parsetree.pcd_vars; + Ast_504.Parsetree.pcd_args; + Ast_504.Parsetree.pcd_res; + Ast_504.Parsetree.pcd_loc; + Ast_504.Parsetree.pcd_attributes; + } -> + { + Ast_505.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_505.Parsetree.pcd_vars = List.map (copy_loc (fun x -> x)) pcd_vars; + Ast_505.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_505.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_505.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_505.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_504.Parsetree.constructor_arguments -> + Ast_505.Parsetree.constructor_arguments = function + | Ast_504.Parsetree.Pcstr_tuple x0 -> + Ast_505.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_504.Parsetree.Pcstr_record x0 -> + Ast_505.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_type_extension : + Ast_504.Parsetree.type_extension -> Ast_505.Parsetree.type_extension = + fun { + Ast_504.Parsetree.ptyext_path; + Ast_504.Parsetree.ptyext_params; + Ast_504.Parsetree.ptyext_constructors; + Ast_504.Parsetree.ptyext_private; + Ast_504.Parsetree.ptyext_loc; + Ast_504.Parsetree.ptyext_attributes; + } -> + { + Ast_505.Parsetree.ptyext_path = copy_loc copy_longident ptyext_path; + Ast_505.Parsetree.ptyext_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptyext_params; + Ast_505.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_505.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_505.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_505.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_504.Parsetree.extension_constructor -> + Ast_505.Parsetree.extension_constructor = + fun { + Ast_504.Parsetree.pext_name; + Ast_504.Parsetree.pext_kind; + Ast_504.Parsetree.pext_loc; + Ast_504.Parsetree.pext_attributes; + } -> + { + Ast_505.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_505.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_505.Parsetree.pext_loc = copy_location pext_loc; + Ast_505.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_type_exception : + Ast_504.Parsetree.type_exception -> Ast_505.Parsetree.type_exception = + fun { + Ast_504.Parsetree.ptyexn_constructor; + Ast_504.Parsetree.ptyexn_loc; + Ast_504.Parsetree.ptyexn_attributes; + } -> + { + Ast_505.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_505.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_505.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_extension_constructor_kind : + Ast_504.Parsetree.extension_constructor_kind -> + Ast_505.Parsetree.extension_constructor_kind = function + | Ast_504.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_505.Parsetree.Pext_decl + ( List.map (copy_loc (fun x -> x)) x0, + copy_constructor_arguments x1, + Option.map copy_core_type x2 ) + | Ast_504.Parsetree.Pext_rebind x0 -> + Ast_505.Parsetree.Pext_rebind (copy_loc copy_longident x0) + +and copy_class_type : + Ast_504.Parsetree.class_type -> Ast_505.Parsetree.class_type = + fun { + Ast_504.Parsetree.pcty_desc; + Ast_504.Parsetree.pcty_loc; + Ast_504.Parsetree.pcty_attributes; + } -> + { + Ast_505.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_505.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_505.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_504.Parsetree.class_type_desc -> Ast_505.Parsetree.class_type_desc = + function + | Ast_504.Parsetree.Pcty_constr (x0, x1) -> + Ast_505.Parsetree.Pcty_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Pcty_signature x0 -> + Ast_505.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_504.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_505.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_504.Parsetree.Pcty_extension x0 -> + Ast_505.Parsetree.Pcty_extension (copy_extension x0) + | Ast_504.Parsetree.Pcty_open (x0, x1) -> + Ast_505.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_504.Parsetree.class_signature -> Ast_505.Parsetree.class_signature = + fun { Ast_504.Parsetree.pcsig_self; Ast_504.Parsetree.pcsig_fields } -> + { + Ast_505.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_505.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_504.Parsetree.class_type_field -> Ast_505.Parsetree.class_type_field = + fun { + Ast_504.Parsetree.pctf_desc; + Ast_504.Parsetree.pctf_loc; + Ast_504.Parsetree.pctf_attributes; + } -> + { + Ast_505.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_505.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_505.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_504.Parsetree.class_type_field_desc -> + Ast_505.Parsetree.class_type_field_desc = function + | Ast_504.Parsetree.Pctf_inherit x0 -> + Ast_505.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_504.Parsetree.Pctf_val x0 -> + Ast_505.Parsetree.Pctf_val + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_mutable_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_504.Parsetree.Pctf_method x0 -> + Ast_505.Parsetree.Pctf_method + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_private_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_504.Parsetree.Pctf_constraint x0 -> + Ast_505.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_504.Parsetree.Pctf_attribute x0 -> + Ast_505.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pctf_extension x0 -> + Ast_505.Parsetree.Pctf_extension (copy_extension x0) + +and copy_class_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_504.Parsetree.class_infos -> + 'g0 Ast_505.Parsetree.class_infos = + fun f0 + { + Ast_504.Parsetree.pci_virt; + Ast_504.Parsetree.pci_params; + Ast_504.Parsetree.pci_name; + Ast_504.Parsetree.pci_expr; + Ast_504.Parsetree.pci_loc; + Ast_504.Parsetree.pci_attributes; + } -> + { + Ast_505.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_505.Parsetree.pci_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + pci_params; + Ast_505.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_505.Parsetree.pci_expr = f0 pci_expr; + Ast_505.Parsetree.pci_loc = copy_location pci_loc; + Ast_505.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_class_description : + Ast_504.Parsetree.class_description -> Ast_505.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type_declaration : + Ast_504.Parsetree.class_type_declaration -> + Ast_505.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_expr : + Ast_504.Parsetree.class_expr -> Ast_505.Parsetree.class_expr = + fun { + Ast_504.Parsetree.pcl_desc; + Ast_504.Parsetree.pcl_loc; + Ast_504.Parsetree.pcl_attributes; + } -> + { + Ast_505.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_505.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_505.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_504.Parsetree.class_expr_desc -> Ast_505.Parsetree.class_expr_desc = + function + | Ast_504.Parsetree.Pcl_constr (x0, x1) -> + Ast_505.Parsetree.Pcl_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Pcl_structure x0 -> + Ast_505.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_504.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_505.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_504.Parsetree.Pcl_apply (x0, x1) -> + Ast_505.Parsetree.Pcl_apply + ( copy_class_expr x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_504.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_505.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_504.Parsetree.Pcl_constraint (x0, x1) -> + Ast_505.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_504.Parsetree.Pcl_extension x0 -> + Ast_505.Parsetree.Pcl_extension (copy_extension x0) + | Ast_504.Parsetree.Pcl_open (x0, x1) -> + Ast_505.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_504.Parsetree.class_structure -> Ast_505.Parsetree.class_structure = + fun { Ast_504.Parsetree.pcstr_self; Ast_504.Parsetree.pcstr_fields } -> + { + Ast_505.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_505.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_504.Parsetree.class_field -> Ast_505.Parsetree.class_field = + fun { + Ast_504.Parsetree.pcf_desc; + Ast_504.Parsetree.pcf_loc; + Ast_504.Parsetree.pcf_attributes; + } -> + { + Ast_505.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_505.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_505.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_504.Parsetree.class_field_desc -> Ast_505.Parsetree.class_field_desc = + function + | Ast_504.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_505.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (copy_loc (fun x -> x)) x2 ) + | Ast_504.Parsetree.Pcf_val x0 -> + Ast_505.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_504.Parsetree.Pcf_method x0 -> + Ast_505.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_504.Parsetree.Pcf_constraint x0 -> + Ast_505.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_504.Parsetree.Pcf_initializer x0 -> + Ast_505.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_504.Parsetree.Pcf_attribute x0 -> + Ast_505.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pcf_extension x0 -> + Ast_505.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_504.Parsetree.class_field_kind -> Ast_505.Parsetree.class_field_kind = + function + | Ast_504.Parsetree.Cfk_virtual x0 -> + Ast_505.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_504.Parsetree.Cfk_concrete (x0, x1) -> + Ast_505.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_class_declaration : + Ast_504.Parsetree.class_declaration -> Ast_505.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_module_type : + Ast_504.Parsetree.module_type -> Ast_505.Parsetree.module_type = + fun { + Ast_504.Parsetree.pmty_desc; + Ast_504.Parsetree.pmty_loc; + Ast_504.Parsetree.pmty_attributes; + } -> + { + Ast_505.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_505.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_505.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_504.Parsetree.module_type_desc -> Ast_505.Parsetree.module_type_desc = + function + | Ast_504.Parsetree.Pmty_ident x0 -> + Ast_505.Parsetree.Pmty_ident (copy_loc copy_longident x0) + | Ast_504.Parsetree.Pmty_signature x0 -> + Ast_505.Parsetree.Pmty_signature (copy_signature x0) + | Ast_504.Parsetree.Pmty_functor (x0, x1) -> + Ast_505.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_504.Parsetree.Pmty_with (x0, x1) -> + Ast_505.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_504.Parsetree.Pmty_typeof x0 -> + Ast_505.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_504.Parsetree.Pmty_extension x0 -> + Ast_505.Parsetree.Pmty_extension (copy_extension x0) + | Ast_504.Parsetree.Pmty_alias x0 -> + Ast_505.Parsetree.Pmty_alias (copy_loc copy_longident x0) + +and copy_functor_parameter : + Ast_504.Parsetree.functor_parameter -> Ast_505.Parsetree.functor_parameter = + function + | Ast_504.Parsetree.Unit -> Ast_505.Parsetree.Unit + | Ast_504.Parsetree.Named (x0, x1) -> + Ast_505.Parsetree.Named + (copy_loc (Option.map (fun x -> x)) x0, copy_module_type x1) + +and copy_signature : Ast_504.Parsetree.signature -> Ast_505.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_504.Parsetree.signature_item -> Ast_505.Parsetree.signature_item = + fun { Ast_504.Parsetree.psig_desc; Ast_504.Parsetree.psig_loc } -> + { + Ast_505.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_505.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_504.Parsetree.signature_item_desc -> + Ast_505.Parsetree.signature_item_desc = function + | Ast_504.Parsetree.Psig_value x0 -> + Ast_505.Parsetree.Psig_value (copy_value_description x0) + | Ast_504.Parsetree.Psig_type (x0, x1) -> + Ast_505.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_504.Parsetree.Psig_typesubst x0 -> + Ast_505.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_504.Parsetree.Psig_typext x0 -> + Ast_505.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_504.Parsetree.Psig_exception x0 -> + Ast_505.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_504.Parsetree.Psig_module x0 -> + Ast_505.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_504.Parsetree.Psig_modsubst x0 -> + Ast_505.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_504.Parsetree.Psig_recmodule x0 -> + Ast_505.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_504.Parsetree.Psig_modtype x0 -> + Ast_505.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_504.Parsetree.Psig_modtypesubst x0 -> + Ast_505.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_504.Parsetree.Psig_open x0 -> + Ast_505.Parsetree.Psig_open (copy_open_description x0) + | Ast_504.Parsetree.Psig_include x0 -> + Ast_505.Parsetree.Psig_include (copy_include_description x0) + | Ast_504.Parsetree.Psig_class x0 -> + Ast_505.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_504.Parsetree.Psig_class_type x0 -> + Ast_505.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_504.Parsetree.Psig_attribute x0 -> + Ast_505.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_504.Parsetree.Psig_extension (x0, x1) -> + Ast_505.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_module_declaration : + Ast_504.Parsetree.module_declaration -> Ast_505.Parsetree.module_declaration + = + fun { + Ast_504.Parsetree.pmd_name; + Ast_504.Parsetree.pmd_type; + Ast_504.Parsetree.pmd_attributes; + Ast_504.Parsetree.pmd_loc; + } -> + { + Ast_505.Parsetree.pmd_name = copy_loc (Option.map (fun x -> x)) pmd_name; + Ast_505.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_505.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_505.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_module_substitution : + Ast_504.Parsetree.module_substitution -> + Ast_505.Parsetree.module_substitution = + fun { + Ast_504.Parsetree.pms_name; + Ast_504.Parsetree.pms_manifest; + Ast_504.Parsetree.pms_attributes; + Ast_504.Parsetree.pms_loc; + } -> + { + Ast_505.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_505.Parsetree.pms_manifest = copy_loc copy_longident pms_manifest; + Ast_505.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_505.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_type_declaration : + Ast_504.Parsetree.module_type_declaration -> + Ast_505.Parsetree.module_type_declaration = + fun { + Ast_504.Parsetree.pmtd_name; + Ast_504.Parsetree.pmtd_type; + Ast_504.Parsetree.pmtd_attributes; + Ast_504.Parsetree.pmtd_loc; + } -> + { + Ast_505.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_505.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_505.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_505.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_open_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_504.Parsetree.open_infos -> + 'g0 Ast_505.Parsetree.open_infos = + fun f0 + { + Ast_504.Parsetree.popen_expr; + Ast_504.Parsetree.popen_override; + Ast_504.Parsetree.popen_loc; + Ast_504.Parsetree.popen_attributes; + } -> + { + Ast_505.Parsetree.popen_expr = f0 popen_expr; + Ast_505.Parsetree.popen_override = copy_override_flag popen_override; + Ast_505.Parsetree.popen_loc = copy_location popen_loc; + Ast_505.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_open_description : + Ast_504.Parsetree.open_description -> Ast_505.Parsetree.open_description = + fun x -> copy_open_infos (copy_loc copy_longident) x + +and copy_open_declaration : + Ast_504.Parsetree.open_declaration -> Ast_505.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_504.Parsetree.include_infos -> + 'g0 Ast_505.Parsetree.include_infos = + fun f0 + { + Ast_504.Parsetree.pincl_mod; + Ast_504.Parsetree.pincl_loc; + Ast_504.Parsetree.pincl_attributes; + } -> + { + Ast_505.Parsetree.pincl_mod = f0 pincl_mod; + Ast_505.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_505.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_include_description : + Ast_504.Parsetree.include_description -> + Ast_505.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_declaration : + Ast_504.Parsetree.include_declaration -> + Ast_505.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_with_constraint : + Ast_504.Parsetree.with_constraint -> Ast_505.Parsetree.with_constraint = + function + | Ast_504.Parsetree.Pwith_type (x0, x1) -> + Ast_505.Parsetree.Pwith_type + (copy_loc copy_longident x0, copy_type_declaration x1) + | Ast_504.Parsetree.Pwith_module (x0, x1) -> + Ast_505.Parsetree.Pwith_module + (copy_loc copy_longident x0, copy_loc copy_longident x1) + | Ast_504.Parsetree.Pwith_modtype (x0, x1) -> + Ast_505.Parsetree.Pwith_modtype + (copy_loc copy_longident x0, copy_module_type x1) + | Ast_504.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_505.Parsetree.Pwith_modtypesubst + (copy_loc copy_longident x0, copy_module_type x1) + | Ast_504.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_505.Parsetree.Pwith_typesubst + (copy_loc copy_longident x0, copy_type_declaration x1) + | Ast_504.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_505.Parsetree.Pwith_modsubst + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_module_expr : + Ast_504.Parsetree.module_expr -> Ast_505.Parsetree.module_expr = + fun { + Ast_504.Parsetree.pmod_desc; + Ast_504.Parsetree.pmod_loc; + Ast_504.Parsetree.pmod_attributes; + } -> + { + Ast_505.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_505.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_505.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_504.Parsetree.module_expr_desc -> Ast_505.Parsetree.module_expr_desc = + function + | Ast_504.Parsetree.Pmod_ident x0 -> + Ast_505.Parsetree.Pmod_ident (copy_loc copy_longident x0) + | Ast_504.Parsetree.Pmod_structure x0 -> + Ast_505.Parsetree.Pmod_structure (copy_structure x0) + | Ast_504.Parsetree.Pmod_functor (x0, x1) -> + Ast_505.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_504.Parsetree.Pmod_apply (x0, x1) -> + Ast_505.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_504.Parsetree.Pmod_apply_unit x0 -> + Ast_505.Parsetree.Pmod_apply_unit (copy_module_expr x0) + | Ast_504.Parsetree.Pmod_constraint (x0, x1) -> + Ast_505.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_504.Parsetree.Pmod_unpack x0 -> + Ast_505.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_504.Parsetree.Pmod_extension x0 -> + Ast_505.Parsetree.Pmod_extension (copy_extension x0) + +and copy_structure : Ast_504.Parsetree.structure -> Ast_505.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_504.Parsetree.structure_item -> Ast_505.Parsetree.structure_item = + fun { Ast_504.Parsetree.pstr_desc; Ast_504.Parsetree.pstr_loc } -> + { + Ast_505.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_505.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_504.Parsetree.structure_item_desc -> + Ast_505.Parsetree.structure_item_desc = function + | Ast_504.Parsetree.Pstr_eval (x0, x1) -> + Ast_505.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_504.Parsetree.Pstr_value (x0, x1) -> + Ast_505.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_504.Parsetree.Pstr_primitive x0 -> + Ast_505.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_504.Parsetree.Pstr_type (x0, x1) -> + Ast_505.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_504.Parsetree.Pstr_typext x0 -> + Ast_505.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_504.Parsetree.Pstr_exception x0 -> + Ast_505.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_504.Parsetree.Pstr_module x0 -> + Ast_505.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_504.Parsetree.Pstr_recmodule x0 -> + Ast_505.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_504.Parsetree.Pstr_modtype x0 -> + Ast_505.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_504.Parsetree.Pstr_open x0 -> + Ast_505.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_504.Parsetree.Pstr_class x0 -> + Ast_505.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_504.Parsetree.Pstr_class_type x0 -> + Ast_505.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_504.Parsetree.Pstr_include x0 -> + Ast_505.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_504.Parsetree.Pstr_attribute x0 -> + Ast_505.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pstr_extension (x0, x1) -> + Ast_505.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_value_constraint : + Ast_504.Parsetree.value_constraint -> Ast_505.Parsetree.value_constraint = + function + | Ast_504.Parsetree.Pvc_constraint { locally_abstract_univars; typ } -> + Ast_505.Parsetree.Pvc_constraint + { + locally_abstract_univars = + List.map (copy_loc (fun x -> x)) locally_abstract_univars; + typ = copy_core_type typ; + } + | Ast_504.Parsetree.Pvc_coercion { ground; coercion } -> + Ast_505.Parsetree.Pvc_coercion + { + ground = Option.map copy_core_type ground; + coercion = copy_core_type coercion; + } + +and copy_value_binding : + Ast_504.Parsetree.value_binding -> Ast_505.Parsetree.value_binding = + fun { + Ast_504.Parsetree.pvb_pat; + Ast_504.Parsetree.pvb_expr; + Ast_504.Parsetree.pvb_constraint; + Ast_504.Parsetree.pvb_attributes; + Ast_504.Parsetree.pvb_loc; + } -> + { + Ast_505.Parsetree.pvb_pat = copy_pattern pvb_pat; + Ast_505.Parsetree.pvb_expr = copy_expression pvb_expr; + Ast_505.Parsetree.pvb_constraint = + Option.map copy_value_constraint pvb_constraint; + Ast_505.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_505.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_module_binding : + Ast_504.Parsetree.module_binding -> Ast_505.Parsetree.module_binding = + fun { + Ast_504.Parsetree.pmb_name; + Ast_504.Parsetree.pmb_expr; + Ast_504.Parsetree.pmb_attributes; + Ast_504.Parsetree.pmb_loc; + } -> + { + Ast_505.Parsetree.pmb_name = copy_loc (Option.map (fun x -> x)) pmb_name; + Ast_505.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_505.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_505.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_toplevel_phrase : + Ast_504.Parsetree.toplevel_phrase -> Ast_505.Parsetree.toplevel_phrase = + function + | Ast_504.Parsetree.Ptop_def x0 -> + Ast_505.Parsetree.Ptop_def (copy_structure x0) + | Ast_504.Parsetree.Ptop_dir x0 -> + Ast_505.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_504.Parsetree.toplevel_directive -> Ast_505.Parsetree.toplevel_directive + = + fun { + Ast_504.Parsetree.pdir_name; + Ast_504.Parsetree.pdir_arg; + Ast_504.Parsetree.pdir_loc; + } -> + { + Ast_505.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_505.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_505.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_504.Parsetree.directive_argument -> Ast_505.Parsetree.directive_argument + = + fun { Ast_504.Parsetree.pdira_desc; Ast_504.Parsetree.pdira_loc } -> + { + Ast_505.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_505.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_504.Parsetree.directive_argument_desc -> + Ast_505.Parsetree.directive_argument_desc = function + | Ast_504.Parsetree.Pdir_string x0 -> Ast_505.Parsetree.Pdir_string x0 + | Ast_504.Parsetree.Pdir_int (x0, x1) -> + Ast_505.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_504.Parsetree.Pdir_ident x0 -> + Ast_505.Parsetree.Pdir_ident (copy_longident x0) + | Ast_504.Parsetree.Pdir_bool x0 -> Ast_505.Parsetree.Pdir_bool x0 diff --git a/astlib/migrate_505_504.ml b/astlib/migrate_505_504.ml new file mode 100644 index 000000000..2d8852df6 --- /dev/null +++ b/astlib/migrate_505_504.ml @@ -0,0 +1,1358 @@ +open Stdlib0 +module From = Ast_505 +module To = Ast_504 + +let copy_location x = x + +let rec copy_longident : Ast_505.Longident.t -> Ast_504.Longident.t = function + | Ast_505.Longident.Lident x0 -> Ast_504.Longident.Lident x0 + | Ast_505.Longident.Ldot (x0, x1) -> + Ast_504.Longident.Ldot + (copy_loc copy_longident x0, copy_loc (fun x -> x) x1) + | Ast_505.Longident.Lapply (x0, x1) -> + Ast_504.Longident.Lapply + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_asttypes_constant : + Ast_505.Asttypes.constant -> Ast_504.Asttypes.constant = function + | Ast_505.Asttypes.Const_int x0 -> Ast_504.Asttypes.Const_int x0 + | Ast_505.Asttypes.Const_char x0 -> Ast_504.Asttypes.Const_char x0 + | Ast_505.Asttypes.Const_string (x0, x1, x2) -> + Ast_504.Asttypes.Const_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_505.Asttypes.Const_float x0 -> Ast_504.Asttypes.Const_float x0 + | Ast_505.Asttypes.Const_int32 x0 -> Ast_504.Asttypes.Const_int32 x0 + | Ast_505.Asttypes.Const_int64 x0 -> Ast_504.Asttypes.Const_int64 x0 + | Ast_505.Asttypes.Const_nativeint x0 -> Ast_504.Asttypes.Const_nativeint x0 + +and copy_rec_flag : Ast_505.Asttypes.rec_flag -> Ast_504.Asttypes.rec_flag = + function + | Ast_505.Asttypes.Nonrecursive -> Ast_504.Asttypes.Nonrecursive + | Ast_505.Asttypes.Recursive -> Ast_504.Asttypes.Recursive + +and copy_direction_flag : + Ast_505.Asttypes.direction_flag -> Ast_504.Asttypes.direction_flag = + function + | Ast_505.Asttypes.Upto -> Ast_504.Asttypes.Upto + | Ast_505.Asttypes.Downto -> Ast_504.Asttypes.Downto + +and copy_private_flag : + Ast_505.Asttypes.private_flag -> Ast_504.Asttypes.private_flag = function + | Ast_505.Asttypes.Private -> Ast_504.Asttypes.Private + | Ast_505.Asttypes.Public -> Ast_504.Asttypes.Public + +and copy_mutable_flag : + Ast_505.Asttypes.mutable_flag -> Ast_504.Asttypes.mutable_flag = function + | Ast_505.Asttypes.Immutable -> Ast_504.Asttypes.Immutable + | Ast_505.Asttypes.Mutable -> Ast_504.Asttypes.Mutable + +and copy_virtual_flag : + Ast_505.Asttypes.virtual_flag -> Ast_504.Asttypes.virtual_flag = function + | Ast_505.Asttypes.Virtual -> Ast_504.Asttypes.Virtual + | Ast_505.Asttypes.Concrete -> Ast_504.Asttypes.Concrete + +and copy_override_flag : + Ast_505.Asttypes.override_flag -> Ast_504.Asttypes.override_flag = function + | Ast_505.Asttypes.Override -> Ast_504.Asttypes.Override + | Ast_505.Asttypes.Fresh -> Ast_504.Asttypes.Fresh + +and copy_closed_flag : + Ast_505.Asttypes.closed_flag -> Ast_504.Asttypes.closed_flag = function + | Ast_505.Asttypes.Closed -> Ast_504.Asttypes.Closed + | Ast_505.Asttypes.Open -> Ast_504.Asttypes.Open + +and copy_label : Ast_505.Asttypes.label -> Ast_504.Asttypes.label = fun x -> x + +and copy_arg_label : Ast_505.Asttypes.arg_label -> Ast_504.Asttypes.arg_label = + function + | Ast_505.Asttypes.Nolabel -> Ast_504.Asttypes.Nolabel + | Ast_505.Asttypes.Labelled x0 -> Ast_504.Asttypes.Labelled x0 + | Ast_505.Asttypes.Optional x0 -> Ast_504.Asttypes.Optional x0 + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_505.Asttypes.loc -> 'g0 Ast_504.Asttypes.loc = + fun f0 { Ast_505.Asttypes.txt; Ast_505.Asttypes.loc } -> + { Ast_504.Asttypes.txt = f0 txt; Ast_504.Asttypes.loc = copy_location loc } + +and copy_variance : Ast_505.Asttypes.variance -> Ast_504.Asttypes.variance = + function + | Ast_505.Asttypes.Covariant -> Ast_504.Asttypes.Covariant + | Ast_505.Asttypes.Contravariant -> Ast_504.Asttypes.Contravariant + | Ast_505.Asttypes.NoVariance -> Ast_504.Asttypes.NoVariance + | Ast_505.Asttypes.Bivariant -> Ast_504.Asttypes.Bivariant + +and copy_injectivity : + Ast_505.Asttypes.injectivity -> Ast_504.Asttypes.injectivity = function + | Ast_505.Asttypes.Injective -> Ast_504.Asttypes.Injective + | Ast_505.Asttypes.NoInjectivity -> Ast_504.Asttypes.NoInjectivity + +and copy_constant : Ast_505.Parsetree.constant -> Ast_504.Parsetree.constant = + fun { Ast_505.Parsetree.pconst_desc; Ast_505.Parsetree.pconst_loc } -> + { + Ast_504.Parsetree.pconst_desc = copy_constant_desc pconst_desc; + Ast_504.Parsetree.pconst_loc = copy_location pconst_loc; + } + +and copy_constant_desc : + Ast_505.Parsetree.constant_desc -> Ast_504.Parsetree.constant_desc = + function + | Ast_505.Parsetree.Pconst_integer (x0, x1) -> + Ast_504.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_505.Parsetree.Pconst_char x0 -> Ast_504.Parsetree.Pconst_char x0 + | Ast_505.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_504.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_505.Parsetree.Pconst_float (x0, x1) -> + Ast_504.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + +and copy_location_stack : + Ast_505.Parsetree.location_stack -> Ast_504.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_attribute : Ast_505.Parsetree.attribute -> Ast_504.Parsetree.attribute + = + fun { + Ast_505.Parsetree.attr_name; + Ast_505.Parsetree.attr_payload; + Ast_505.Parsetree.attr_loc; + } -> + { + Ast_504.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_504.Parsetree.attr_payload = copy_payload attr_payload; + Ast_504.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_extension : Ast_505.Parsetree.extension -> Ast_504.Parsetree.extension + = + fun x -> + let x0, x1 = x in + (copy_loc (fun x -> x) x0, copy_payload x1) + +and copy_attributes : + Ast_505.Parsetree.attributes -> Ast_504.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_payload : Ast_505.Parsetree.payload -> Ast_504.Parsetree.payload = + function + | Ast_505.Parsetree.PStr x0 -> Ast_504.Parsetree.PStr (copy_structure x0) + | Ast_505.Parsetree.PSig x0 -> Ast_504.Parsetree.PSig (copy_signature x0) + | Ast_505.Parsetree.PTyp x0 -> Ast_504.Parsetree.PTyp (copy_core_type x0) + | Ast_505.Parsetree.PPat (x0, x1) -> + Ast_504.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_core_type : Ast_505.Parsetree.core_type -> Ast_504.Parsetree.core_type + = + fun { + Ast_505.Parsetree.ptyp_desc; + Ast_505.Parsetree.ptyp_loc; + Ast_505.Parsetree.ptyp_loc_stack; + Ast_505.Parsetree.ptyp_attributes; + } -> + { + Ast_504.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_504.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_504.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_504.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_core_type_desc : + Ast_505.Parsetree.core_type_desc -> Ast_504.Parsetree.core_type_desc = + function + | Ast_505.Parsetree.Ptyp_any -> Ast_504.Parsetree.Ptyp_any + | Ast_505.Parsetree.Ptyp_var x0 -> Ast_504.Parsetree.Ptyp_var x0 + | Ast_505.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_504.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_505.Parsetree.Ptyp_tuple x0 -> + Ast_504.Parsetree.Ptyp_tuple + (List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_core_type x1)) + x0) + | Ast_505.Parsetree.Ptyp_constr (x0, x1) -> + Ast_504.Parsetree.Ptyp_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_505.Parsetree.Ptyp_object (x0, x1) -> + Ast_504.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_505.Parsetree.Ptyp_class (x0, x1) -> + Ast_504.Parsetree.Ptyp_class + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_505.Parsetree.Ptyp_alias (x0, x1) -> + Ast_504.Parsetree.Ptyp_alias (copy_core_type x0, copy_loc (fun x -> x) x1) + | Ast_505.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_504.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (List.map copy_label) x2 ) + | Ast_505.Parsetree.Ptyp_poly (x0, x1) -> + Ast_504.Parsetree.Ptyp_poly + (List.map (copy_loc (fun x -> x)) x0, copy_core_type x1) + | Ast_505.Parsetree.Ptyp_package x0 -> + Ast_504.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_505.Parsetree.Ptyp_open (x0, x1) -> + Ast_504.Parsetree.Ptyp_open (copy_loc copy_longident x0, copy_core_type x1) + | Ast_505.Parsetree.Ptyp_extension x0 -> + Ast_504.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_505.Parsetree.package_type -> Ast_504.Parsetree.package_type = + fun { + Ast_505.Parsetree.ppt_path; + Ast_505.Parsetree.ppt_constraints; + Ast_505.Parsetree.ppt_loc; + Ast_505.Parsetree.ppt_attrs; + } -> + { + Ast_504.Parsetree.ppt_path = copy_loc copy_longident ppt_path; + Ast_504.Parsetree.ppt_cstrs = + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_core_type x1)) + ppt_constraints; + Ast_504.Parsetree.ppt_loc = copy_location ppt_loc; + Ast_504.Parsetree.ppt_attrs = copy_attributes ppt_attrs; + } + +and copy_row_field : Ast_505.Parsetree.row_field -> Ast_504.Parsetree.row_field + = + fun { + Ast_505.Parsetree.prf_desc; + Ast_505.Parsetree.prf_loc; + Ast_505.Parsetree.prf_attributes; + } -> + { + Ast_504.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_504.Parsetree.prf_loc = copy_location prf_loc; + Ast_504.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_505.Parsetree.row_field_desc -> Ast_504.Parsetree.row_field_desc = + function + | Ast_505.Parsetree.Rtag (x0, x1, x2) -> + Ast_504.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_505.Parsetree.Rinherit x0 -> + Ast_504.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_505.Parsetree.object_field -> Ast_504.Parsetree.object_field = + fun { + Ast_505.Parsetree.pof_desc; + Ast_505.Parsetree.pof_loc; + Ast_505.Parsetree.pof_attributes; + } -> + { + Ast_504.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_504.Parsetree.pof_loc = copy_location pof_loc; + Ast_504.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_object_field_desc : + Ast_505.Parsetree.object_field_desc -> Ast_504.Parsetree.object_field_desc = + function + | Ast_505.Parsetree.Otag (x0, x1) -> + Ast_504.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_505.Parsetree.Oinherit x0 -> + Ast_504.Parsetree.Oinherit (copy_core_type x0) + +and copy_pattern : Ast_505.Parsetree.pattern -> Ast_504.Parsetree.pattern = + fun { + Ast_505.Parsetree.ppat_desc; + Ast_505.Parsetree.ppat_loc; + Ast_505.Parsetree.ppat_loc_stack; + Ast_505.Parsetree.ppat_attributes; + } -> + { + Ast_504.Parsetree.ppat_desc = copy_pattern_desc ppat_desc; + Ast_504.Parsetree.ppat_loc = copy_location ppat_loc; + Ast_504.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_504.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc : + Ast_505.Parsetree.pattern_desc -> Ast_504.Parsetree.pattern_desc = function + | Ast_505.Parsetree.Ppat_any -> Ast_504.Parsetree.Ppat_any + | Ast_505.Parsetree.Ppat_var x0 -> + Ast_504.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_505.Parsetree.Ppat_alias (x0, x1) -> + Ast_504.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_505.Parsetree.Ppat_constant x0 -> + Ast_504.Parsetree.Ppat_constant (copy_constant x0) + | Ast_505.Parsetree.Ppat_interval (x0, x1) -> + Ast_504.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1) + | Ast_505.Parsetree.Ppat_tuple (x0, x1) -> + Ast_504.Parsetree.Ppat_tuple + ( List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_505.Parsetree.Ppat_construct (x0, x1) -> + Ast_504.Parsetree.Ppat_construct + ( copy_loc copy_longident x0, + Option.map + (fun x -> + let x0, x1 = x in + (List.map (copy_loc (fun x -> x)) x0, copy_pattern x1)) + x1 ) + | Ast_505.Parsetree.Ppat_variant (x0, x1) -> + Ast_504.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_505.Parsetree.Ppat_record (x0, x1) -> + Ast_504.Parsetree.Ppat_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_505.Parsetree.Ppat_array x0 -> + Ast_504.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_505.Parsetree.Ppat_or (x0, x1) -> + Ast_504.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_505.Parsetree.Ppat_constraint (x0, x1) -> + Ast_504.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_505.Parsetree.Ppat_type x0 -> + Ast_504.Parsetree.Ppat_type (copy_loc copy_longident x0) + | Ast_505.Parsetree.Ppat_lazy x0 -> + Ast_504.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_505.Parsetree.Ppat_unpack (x0, x1) -> ( + let unpack = + Ast_504.Parsetree.Ppat_unpack (copy_loc (Option.map (fun x -> x)) x0) + in + match x1 with + | None -> unpack + | Some c -> + let ghost_loc loc = { loc with Location.loc_ghost = true } in + let unpack_pattern : Ast_504.Parsetree.pattern = + { + ppat_desc = unpack; + ppat_loc = ghost_loc Location.none; + ppat_attributes = []; + ppat_loc_stack = []; + } + in + let package_type : Ast_504.Parsetree.core_type = + { + ptyp_desc = Ptyp_package (copy_package_type c); + ptyp_loc = ghost_loc Location.none; + ptyp_attributes = []; + ptyp_loc_stack = []; + } + in + Ast_504.Parsetree.Ppat_constraint (unpack_pattern, package_type)) + | Ast_505.Parsetree.Ppat_exception x0 -> + Ast_504.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_505.Parsetree.Ppat_effect (x0, x1) -> + Ast_504.Parsetree.Ppat_effect (copy_pattern x0, copy_pattern x1) + | Ast_505.Parsetree.Ppat_extension x0 -> + Ast_504.Parsetree.Ppat_extension (copy_extension x0) + | Ast_505.Parsetree.Ppat_open (x0, x1) -> + Ast_504.Parsetree.Ppat_open (copy_loc copy_longident x0, copy_pattern x1) + +and copy_expression : + Ast_505.Parsetree.expression -> Ast_504.Parsetree.expression = + fun { + Ast_505.Parsetree.pexp_desc; + Ast_505.Parsetree.pexp_loc; + Ast_505.Parsetree.pexp_loc_stack; + Ast_505.Parsetree.pexp_attributes; + } -> + { + Ast_504.Parsetree.pexp_desc = copy_expression_desc pexp_desc; + Ast_504.Parsetree.pexp_loc = copy_location pexp_loc; + Ast_504.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_504.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_505.Parsetree.expression_desc -> Ast_504.Parsetree.expression_desc = + function + | Ast_505.Parsetree.Pexp_ident x0 -> + Ast_504.Parsetree.Pexp_ident (copy_loc copy_longident x0) + | Ast_505.Parsetree.Pexp_constant x0 -> + Ast_504.Parsetree.Pexp_constant (copy_constant x0) + | Ast_505.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_505.Parsetree.Pexp_function (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_function + ( List.map copy_function_param x0, + Option.map copy_type_constraint x1, + copy_function_body x2 ) + | Ast_505.Parsetree.Pexp_apply (x0, x1) -> + Ast_504.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_505.Parsetree.Pexp_match (x0, x1) -> + Ast_504.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_505.Parsetree.Pexp_try (x0, x1) -> + Ast_504.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_505.Parsetree.Pexp_tuple x0 -> + Ast_504.Parsetree.Pexp_tuple + (List.map + (fun x -> + let x0, x1 = x in + (Option.map (fun x -> x) x0, copy_expression x1)) + x0) + | Ast_505.Parsetree.Pexp_construct (x0, x1) -> + Ast_504.Parsetree.Pexp_construct + (copy_loc copy_longident x0, Option.map copy_expression x1) + | Ast_505.Parsetree.Pexp_variant (x0, x1) -> + Ast_504.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_505.Parsetree.Pexp_record (x0, x1) -> + Ast_504.Parsetree.Pexp_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_longident x0, copy_expression x1)) + x0, + Option.map copy_expression x1 ) + | Ast_505.Parsetree.Pexp_field (x0, x1) -> + Ast_504.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_longident x1) + | Ast_505.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_longident x1, copy_expression x2) + | Ast_505.Parsetree.Pexp_array x0 -> + Ast_504.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_505.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_505.Parsetree.Pexp_sequence (x0, x1) -> + Ast_504.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_505.Parsetree.Pexp_while (x0, x1) -> + Ast_504.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_505.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_504.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_505.Parsetree.Pexp_constraint (x0, x1) -> + Ast_504.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_505.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_505.Parsetree.Pexp_send (x0, x1) -> + Ast_504.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_505.Parsetree.Pexp_new x0 -> + Ast_504.Parsetree.Pexp_new (copy_loc copy_longident x0) + | Ast_505.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_504.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_505.Parsetree.Pexp_override x0 -> + Ast_504.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_505.Parsetree.Pexp_struct_item (x0, x1) -> ( + match x0.pstr_desc with + | Pstr_open odecl -> + Ast_504.Parsetree.Pexp_open + (copy_open_declaration odecl, copy_expression x1) + | Pstr_exception tyexn -> + let ex_cstr = tyexn.ptyexn_constructor in + Ast_504.Parsetree.Pexp_letexception + (copy_extension_constructor ex_cstr, copy_expression x1) + | Pstr_module mb -> + let mname = mb.pmb_name in + let mexpr = mb.pmb_expr in + Ast_504.Parsetree.Pexp_letmodule + ( copy_loc (Option.map Fun.id) mname, + copy_module_expr mexpr, + copy_expression x1 ) + | _ -> + Location.raise_errorf ~loc:x0.pstr_loc + "Only structure items [open M], [exception C] and [module B = T] \ + are supported in [let SI in E].") + | Ast_505.Parsetree.Pexp_assert x0 -> + Ast_504.Parsetree.Pexp_assert (copy_expression x0) + | Ast_505.Parsetree.Pexp_lazy x0 -> + Ast_504.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_505.Parsetree.Pexp_poly (x0, x1) -> + Ast_504.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_505.Parsetree.Pexp_object x0 -> + Ast_504.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_505.Parsetree.Pexp_newtype (x0, x1) -> + Ast_504.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_505.Parsetree.Pexp_pack (x0, x1) -> + Ast_504.Parsetree.Pexp_pack + (copy_module_expr x0, Option.map copy_package_type x1) + | Ast_505.Parsetree.Pexp_letop x0 -> + Ast_504.Parsetree.Pexp_letop (copy_letop x0) + | Ast_505.Parsetree.Pexp_extension x0 -> + Ast_504.Parsetree.Pexp_extension (copy_extension x0) + | Ast_505.Parsetree.Pexp_unreachable -> Ast_504.Parsetree.Pexp_unreachable + +and copy_case : Ast_505.Parsetree.case -> Ast_504.Parsetree.case = + fun { + Ast_505.Parsetree.pc_lhs; + Ast_505.Parsetree.pc_guard; + Ast_505.Parsetree.pc_rhs; + } -> + { + Ast_504.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_504.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_504.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_letop : Ast_505.Parsetree.letop -> Ast_504.Parsetree.letop = + fun { Ast_505.Parsetree.let_; Ast_505.Parsetree.ands; Ast_505.Parsetree.body } -> + { + Ast_504.Parsetree.let_ = copy_binding_op let_; + Ast_504.Parsetree.ands = List.map copy_binding_op ands; + Ast_504.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_505.Parsetree.binding_op -> Ast_504.Parsetree.binding_op = + fun { + Ast_505.Parsetree.pbop_op; + Ast_505.Parsetree.pbop_pat; + Ast_505.Parsetree.pbop_exp; + Ast_505.Parsetree.pbop_loc; + } -> + { + Ast_504.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_504.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_504.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_504.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_function_param_desc : + Ast_505.Parsetree.function_param_desc -> + Ast_504.Parsetree.function_param_desc = function + | Ast_505.Parsetree.Pparam_val (x0, x1, x2) -> + Ast_504.Parsetree.Pparam_val + (copy_arg_label x0, Option.map copy_expression x1, copy_pattern x2) + | Ast_505.Parsetree.Pparam_newtype x0 -> + Ast_504.Parsetree.Pparam_newtype (copy_loc (fun x -> x) x0) + +and copy_function_param : + Ast_505.Parsetree.function_param -> Ast_504.Parsetree.function_param = + fun { Ast_505.Parsetree.pparam_loc; Ast_505.Parsetree.pparam_desc } -> + { + Ast_504.Parsetree.pparam_loc = copy_location pparam_loc; + Ast_504.Parsetree.pparam_desc = copy_function_param_desc pparam_desc; + } + +and copy_function_body : + Ast_505.Parsetree.function_body -> Ast_504.Parsetree.function_body = + function + | Ast_505.Parsetree.Pfunction_body x0 -> + Ast_504.Parsetree.Pfunction_body (copy_expression x0) + | Ast_505.Parsetree.Pfunction_cases (x0, x1, x2) -> + Ast_504.Parsetree.Pfunction_cases + (List.map copy_case x0, copy_location x1, copy_attributes x2) + +and copy_type_constraint : + Ast_505.Parsetree.type_constraint -> Ast_504.Parsetree.type_constraint = + function + | Ast_505.Parsetree.Pconstraint x0 -> + Ast_504.Parsetree.Pconstraint (copy_core_type x0) + | Ast_505.Parsetree.Pcoerce (x0, x1) -> + Ast_504.Parsetree.Pcoerce (Option.map copy_core_type x0, copy_core_type x1) + +and copy_value_description : + Ast_505.Parsetree.value_description -> Ast_504.Parsetree.value_description = + fun { + Ast_505.Parsetree.pval_name; + Ast_505.Parsetree.pval_type; + Ast_505.Parsetree.pval_prim; + Ast_505.Parsetree.pval_attributes; + Ast_505.Parsetree.pval_loc; + } -> + { + Ast_504.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_504.Parsetree.pval_type = copy_core_type pval_type; + Ast_504.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_504.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_504.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_type_declaration : + Ast_505.Parsetree.type_declaration -> Ast_504.Parsetree.type_declaration = + fun { + Ast_505.Parsetree.ptype_name; + Ast_505.Parsetree.ptype_params; + Ast_505.Parsetree.ptype_constraints; + Ast_505.Parsetree.ptype_kind; + Ast_505.Parsetree.ptype_private; + Ast_505.Parsetree.ptype_manifest; + Ast_505.Parsetree.ptype_attributes; + Ast_505.Parsetree.ptype_loc; + } -> + { + Ast_504.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_504.Parsetree.ptype_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptype_params; + Ast_504.Parsetree.ptype_cstrs = + List.map + (fun x -> + let x0, x1, x2 = x in + (copy_core_type x0, copy_core_type x1, copy_location x2)) + ptype_constraints; + Ast_504.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_504.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_504.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_504.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_504.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_type_kind : Ast_505.Parsetree.type_kind -> Ast_504.Parsetree.type_kind + = function + | Ast_505.Parsetree.Ptype_abstract -> Ast_504.Parsetree.Ptype_abstract + | Ast_505.Parsetree.Ptype_variant x0 -> + Ast_504.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_505.Parsetree.Ptype_record x0 -> + Ast_504.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_505.Parsetree.Ptype_open -> Ast_504.Parsetree.Ptype_open + | Ast_505.Parsetree.Ptype_external x0 -> + Location.raise_errorf "External types are not supported." + +and copy_label_declaration : + Ast_505.Parsetree.label_declaration -> Ast_504.Parsetree.label_declaration = + fun { + Ast_505.Parsetree.pld_name; + Ast_505.Parsetree.pld_mutable; + Ast_505.Parsetree.pld_type; + Ast_505.Parsetree.pld_loc; + Ast_505.Parsetree.pld_attributes; + } -> + { + Ast_504.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_504.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_504.Parsetree.pld_type = copy_core_type pld_type; + Ast_504.Parsetree.pld_loc = copy_location pld_loc; + Ast_504.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_constructor_declaration : + Ast_505.Parsetree.constructor_declaration -> + Ast_504.Parsetree.constructor_declaration = + fun { + Ast_505.Parsetree.pcd_name; + Ast_505.Parsetree.pcd_vars; + Ast_505.Parsetree.pcd_args; + Ast_505.Parsetree.pcd_res; + Ast_505.Parsetree.pcd_loc; + Ast_505.Parsetree.pcd_attributes; + } -> + { + Ast_504.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_504.Parsetree.pcd_vars = List.map (copy_loc (fun x -> x)) pcd_vars; + Ast_504.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_504.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_504.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_504.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_505.Parsetree.constructor_arguments -> + Ast_504.Parsetree.constructor_arguments = function + | Ast_505.Parsetree.Pcstr_tuple x0 -> + Ast_504.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_505.Parsetree.Pcstr_record x0 -> + Ast_504.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_type_extension : + Ast_505.Parsetree.type_extension -> Ast_504.Parsetree.type_extension = + fun { + Ast_505.Parsetree.ptyext_path; + Ast_505.Parsetree.ptyext_params; + Ast_505.Parsetree.ptyext_constructors; + Ast_505.Parsetree.ptyext_private; + Ast_505.Parsetree.ptyext_loc; + Ast_505.Parsetree.ptyext_attributes; + } -> + { + Ast_504.Parsetree.ptyext_path = copy_loc copy_longident ptyext_path; + Ast_504.Parsetree.ptyext_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptyext_params; + Ast_504.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_504.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_504.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_504.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_505.Parsetree.extension_constructor -> + Ast_504.Parsetree.extension_constructor = + fun { + Ast_505.Parsetree.pext_name; + Ast_505.Parsetree.pext_kind; + Ast_505.Parsetree.pext_loc; + Ast_505.Parsetree.pext_attributes; + } -> + { + Ast_504.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_504.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_504.Parsetree.pext_loc = copy_location pext_loc; + Ast_504.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_type_exception : + Ast_505.Parsetree.type_exception -> Ast_504.Parsetree.type_exception = + fun { + Ast_505.Parsetree.ptyexn_constructor; + Ast_505.Parsetree.ptyexn_loc; + Ast_505.Parsetree.ptyexn_attributes; + } -> + { + Ast_504.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_504.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_504.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_extension_constructor_kind : + Ast_505.Parsetree.extension_constructor_kind -> + Ast_504.Parsetree.extension_constructor_kind = function + | Ast_505.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_504.Parsetree.Pext_decl + ( List.map (copy_loc (fun x -> x)) x0, + copy_constructor_arguments x1, + Option.map copy_core_type x2 ) + | Ast_505.Parsetree.Pext_rebind x0 -> + Ast_504.Parsetree.Pext_rebind (copy_loc copy_longident x0) + +and copy_class_type : + Ast_505.Parsetree.class_type -> Ast_504.Parsetree.class_type = + fun { + Ast_505.Parsetree.pcty_desc; + Ast_505.Parsetree.pcty_loc; + Ast_505.Parsetree.pcty_attributes; + } -> + { + Ast_504.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_504.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_504.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_505.Parsetree.class_type_desc -> Ast_504.Parsetree.class_type_desc = + function + | Ast_505.Parsetree.Pcty_constr (x0, x1) -> + Ast_504.Parsetree.Pcty_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_505.Parsetree.Pcty_signature x0 -> + Ast_504.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_505.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_504.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_505.Parsetree.Pcty_extension x0 -> + Ast_504.Parsetree.Pcty_extension (copy_extension x0) + | Ast_505.Parsetree.Pcty_open (x0, x1) -> + Ast_504.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_505.Parsetree.class_signature -> Ast_504.Parsetree.class_signature = + fun { Ast_505.Parsetree.pcsig_self; Ast_505.Parsetree.pcsig_fields } -> + { + Ast_504.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_504.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_505.Parsetree.class_type_field -> Ast_504.Parsetree.class_type_field = + fun { + Ast_505.Parsetree.pctf_desc; + Ast_505.Parsetree.pctf_loc; + Ast_505.Parsetree.pctf_attributes; + } -> + { + Ast_504.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_504.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_504.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_505.Parsetree.class_type_field_desc -> + Ast_504.Parsetree.class_type_field_desc = function + | Ast_505.Parsetree.Pctf_inherit x0 -> + Ast_504.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_505.Parsetree.Pctf_val x0 -> + Ast_504.Parsetree.Pctf_val + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_mutable_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_505.Parsetree.Pctf_method x0 -> + Ast_504.Parsetree.Pctf_method + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_private_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_505.Parsetree.Pctf_constraint x0 -> + Ast_504.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_505.Parsetree.Pctf_attribute x0 -> + Ast_504.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_505.Parsetree.Pctf_extension x0 -> + Ast_504.Parsetree.Pctf_extension (copy_extension x0) + +and copy_class_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_505.Parsetree.class_infos -> + 'g0 Ast_504.Parsetree.class_infos = + fun f0 + { + Ast_505.Parsetree.pci_virt; + Ast_505.Parsetree.pci_params; + Ast_505.Parsetree.pci_name; + Ast_505.Parsetree.pci_expr; + Ast_505.Parsetree.pci_loc; + Ast_505.Parsetree.pci_attributes; + } -> + { + Ast_504.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_504.Parsetree.pci_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + pci_params; + Ast_504.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_504.Parsetree.pci_expr = f0 pci_expr; + Ast_504.Parsetree.pci_loc = copy_location pci_loc; + Ast_504.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_class_description : + Ast_505.Parsetree.class_description -> Ast_504.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type_declaration : + Ast_505.Parsetree.class_type_declaration -> + Ast_504.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_expr : + Ast_505.Parsetree.class_expr -> Ast_504.Parsetree.class_expr = + fun { + Ast_505.Parsetree.pcl_desc; + Ast_505.Parsetree.pcl_loc; + Ast_505.Parsetree.pcl_attributes; + } -> + { + Ast_504.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_504.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_504.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_505.Parsetree.class_expr_desc -> Ast_504.Parsetree.class_expr_desc = + function + | Ast_505.Parsetree.Pcl_constr (x0, x1) -> + Ast_504.Parsetree.Pcl_constr + (copy_loc copy_longident x0, List.map copy_core_type x1) + | Ast_505.Parsetree.Pcl_structure x0 -> + Ast_504.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_505.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_504.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_505.Parsetree.Pcl_apply (x0, x1) -> + Ast_504.Parsetree.Pcl_apply + ( copy_class_expr x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_505.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_504.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_505.Parsetree.Pcl_constraint (x0, x1) -> + Ast_504.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_505.Parsetree.Pcl_extension x0 -> + Ast_504.Parsetree.Pcl_extension (copy_extension x0) + | Ast_505.Parsetree.Pcl_open (x0, x1) -> + Ast_504.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_505.Parsetree.class_structure -> Ast_504.Parsetree.class_structure = + fun { Ast_505.Parsetree.pcstr_self; Ast_505.Parsetree.pcstr_fields } -> + { + Ast_504.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_504.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_505.Parsetree.class_field -> Ast_504.Parsetree.class_field = + fun { + Ast_505.Parsetree.pcf_desc; + Ast_505.Parsetree.pcf_loc; + Ast_505.Parsetree.pcf_attributes; + } -> + { + Ast_504.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_504.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_504.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_505.Parsetree.class_field_desc -> Ast_504.Parsetree.class_field_desc = + function + | Ast_505.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_504.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (copy_loc (fun x -> x)) x2 ) + | Ast_505.Parsetree.Pcf_val x0 -> + Ast_504.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_505.Parsetree.Pcf_method x0 -> + Ast_504.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_505.Parsetree.Pcf_constraint x0 -> + Ast_504.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_505.Parsetree.Pcf_initializer x0 -> + Ast_504.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_505.Parsetree.Pcf_attribute x0 -> + Ast_504.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_505.Parsetree.Pcf_extension x0 -> + Ast_504.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_505.Parsetree.class_field_kind -> Ast_504.Parsetree.class_field_kind = + function + | Ast_505.Parsetree.Cfk_virtual x0 -> + Ast_504.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_505.Parsetree.Cfk_concrete (x0, x1) -> + Ast_504.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_class_declaration : + Ast_505.Parsetree.class_declaration -> Ast_504.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_module_type : + Ast_505.Parsetree.module_type -> Ast_504.Parsetree.module_type = + fun { + Ast_505.Parsetree.pmty_desc; + Ast_505.Parsetree.pmty_loc; + Ast_505.Parsetree.pmty_attributes; + } -> + { + Ast_504.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_504.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_504.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_505.Parsetree.module_type_desc -> Ast_504.Parsetree.module_type_desc = + function + | Ast_505.Parsetree.Pmty_ident x0 -> + Ast_504.Parsetree.Pmty_ident (copy_loc copy_longident x0) + | Ast_505.Parsetree.Pmty_signature x0 -> + Ast_504.Parsetree.Pmty_signature (copy_signature x0) + | Ast_505.Parsetree.Pmty_functor (x0, x1) -> + Ast_504.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_505.Parsetree.Pmty_with (x0, x1) -> + Ast_504.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_505.Parsetree.Pmty_typeof x0 -> + Ast_504.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_505.Parsetree.Pmty_extension x0 -> + Ast_504.Parsetree.Pmty_extension (copy_extension x0) + | Ast_505.Parsetree.Pmty_alias x0 -> + Ast_504.Parsetree.Pmty_alias (copy_loc copy_longident x0) + +and copy_functor_parameter : + Ast_505.Parsetree.functor_parameter -> Ast_504.Parsetree.functor_parameter = + function + | Ast_505.Parsetree.Unit -> Ast_504.Parsetree.Unit + | Ast_505.Parsetree.Named (x0, x1) -> + Ast_504.Parsetree.Named + (copy_loc (Option.map (fun x -> x)) x0, copy_module_type x1) + +and copy_signature : Ast_505.Parsetree.signature -> Ast_504.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_505.Parsetree.signature_item -> Ast_504.Parsetree.signature_item = + fun { Ast_505.Parsetree.psig_desc; Ast_505.Parsetree.psig_loc } -> + { + Ast_504.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_504.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_505.Parsetree.signature_item_desc -> + Ast_504.Parsetree.signature_item_desc = function + | Ast_505.Parsetree.Psig_value x0 -> + Ast_504.Parsetree.Psig_value (copy_value_description x0) + | Ast_505.Parsetree.Psig_type (x0, x1) -> + Ast_504.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_505.Parsetree.Psig_typesubst x0 -> + Ast_504.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_505.Parsetree.Psig_typext x0 -> + Ast_504.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_505.Parsetree.Psig_exception x0 -> + Ast_504.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_505.Parsetree.Psig_module x0 -> + Ast_504.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_505.Parsetree.Psig_modsubst x0 -> + Ast_504.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_505.Parsetree.Psig_recmodule x0 -> + Ast_504.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_505.Parsetree.Psig_modtype x0 -> + Ast_504.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_505.Parsetree.Psig_modtypesubst x0 -> + Ast_504.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_505.Parsetree.Psig_open x0 -> + Ast_504.Parsetree.Psig_open (copy_open_description x0) + | Ast_505.Parsetree.Psig_include x0 -> + Ast_504.Parsetree.Psig_include (copy_include_description x0) + | Ast_505.Parsetree.Psig_class x0 -> + Ast_504.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_505.Parsetree.Psig_class_type x0 -> + Ast_504.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_505.Parsetree.Psig_attribute x0 -> + Ast_504.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_505.Parsetree.Psig_extension (x0, x1) -> + Ast_504.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_module_declaration : + Ast_505.Parsetree.module_declaration -> Ast_504.Parsetree.module_declaration + = + fun { + Ast_505.Parsetree.pmd_name; + Ast_505.Parsetree.pmd_type; + Ast_505.Parsetree.pmd_attributes; + Ast_505.Parsetree.pmd_loc; + } -> + { + Ast_504.Parsetree.pmd_name = copy_loc (Option.map (fun x -> x)) pmd_name; + Ast_504.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_504.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_504.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_module_substitution : + Ast_505.Parsetree.module_substitution -> + Ast_504.Parsetree.module_substitution = + fun { + Ast_505.Parsetree.pms_name; + Ast_505.Parsetree.pms_manifest; + Ast_505.Parsetree.pms_attributes; + Ast_505.Parsetree.pms_loc; + } -> + { + Ast_504.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_504.Parsetree.pms_manifest = copy_loc copy_longident pms_manifest; + Ast_504.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_504.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_type_declaration : + Ast_505.Parsetree.module_type_declaration -> + Ast_504.Parsetree.module_type_declaration = + fun { + Ast_505.Parsetree.pmtd_name; + Ast_505.Parsetree.pmtd_type; + Ast_505.Parsetree.pmtd_attributes; + Ast_505.Parsetree.pmtd_loc; + } -> + { + Ast_504.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_504.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_504.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_504.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_open_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_505.Parsetree.open_infos -> + 'g0 Ast_504.Parsetree.open_infos = + fun f0 + { + Ast_505.Parsetree.popen_expr; + Ast_505.Parsetree.popen_override; + Ast_505.Parsetree.popen_loc; + Ast_505.Parsetree.popen_attributes; + } -> + { + Ast_504.Parsetree.popen_expr = f0 popen_expr; + Ast_504.Parsetree.popen_override = copy_override_flag popen_override; + Ast_504.Parsetree.popen_loc = copy_location popen_loc; + Ast_504.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_open_description : + Ast_505.Parsetree.open_description -> Ast_504.Parsetree.open_description = + fun x -> copy_open_infos (copy_loc copy_longident) x + +and copy_open_declaration : + Ast_505.Parsetree.open_declaration -> Ast_504.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_505.Parsetree.include_infos -> + 'g0 Ast_504.Parsetree.include_infos = + fun f0 + { + Ast_505.Parsetree.pincl_mod; + Ast_505.Parsetree.pincl_loc; + Ast_505.Parsetree.pincl_attributes; + } -> + { + Ast_504.Parsetree.pincl_mod = f0 pincl_mod; + Ast_504.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_504.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_include_description : + Ast_505.Parsetree.include_description -> + Ast_504.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_declaration : + Ast_505.Parsetree.include_declaration -> + Ast_504.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_with_constraint : + Ast_505.Parsetree.with_constraint -> Ast_504.Parsetree.with_constraint = + function + | Ast_505.Parsetree.Pwith_type (x0, x1) -> + Ast_504.Parsetree.Pwith_type + (copy_loc copy_longident x0, copy_type_declaration x1) + | Ast_505.Parsetree.Pwith_module (x0, x1) -> + Ast_504.Parsetree.Pwith_module + (copy_loc copy_longident x0, copy_loc copy_longident x1) + | Ast_505.Parsetree.Pwith_modtype (x0, x1) -> + Ast_504.Parsetree.Pwith_modtype + (copy_loc copy_longident x0, copy_module_type x1) + | Ast_505.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_504.Parsetree.Pwith_modtypesubst + (copy_loc copy_longident x0, copy_module_type x1) + | Ast_505.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_504.Parsetree.Pwith_typesubst + (copy_loc copy_longident x0, copy_type_declaration x1) + | Ast_505.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_504.Parsetree.Pwith_modsubst + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_module_expr : + Ast_505.Parsetree.module_expr -> Ast_504.Parsetree.module_expr = + fun { + Ast_505.Parsetree.pmod_desc; + Ast_505.Parsetree.pmod_loc; + Ast_505.Parsetree.pmod_attributes; + } -> + { + Ast_504.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_504.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_504.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_505.Parsetree.module_expr_desc -> Ast_504.Parsetree.module_expr_desc = + function + | Ast_505.Parsetree.Pmod_ident x0 -> + Ast_504.Parsetree.Pmod_ident (copy_loc copy_longident x0) + | Ast_505.Parsetree.Pmod_structure x0 -> + Ast_504.Parsetree.Pmod_structure (copy_structure x0) + | Ast_505.Parsetree.Pmod_functor (x0, x1) -> + Ast_504.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_505.Parsetree.Pmod_apply (x0, x1) -> + Ast_504.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_505.Parsetree.Pmod_apply_unit x0 -> + Ast_504.Parsetree.Pmod_apply_unit (copy_module_expr x0) + | Ast_505.Parsetree.Pmod_constraint (x0, x1) -> + Ast_504.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_505.Parsetree.Pmod_unpack x0 -> + Ast_504.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_505.Parsetree.Pmod_extension x0 -> + Ast_504.Parsetree.Pmod_extension (copy_extension x0) + +and copy_structure : Ast_505.Parsetree.structure -> Ast_504.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_505.Parsetree.structure_item -> Ast_504.Parsetree.structure_item = + fun { Ast_505.Parsetree.pstr_desc; Ast_505.Parsetree.pstr_loc } -> + { + Ast_504.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_504.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_505.Parsetree.structure_item_desc -> + Ast_504.Parsetree.structure_item_desc = function + | Ast_505.Parsetree.Pstr_eval (x0, x1) -> + Ast_504.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_505.Parsetree.Pstr_value (x0, x1) -> + Ast_504.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_505.Parsetree.Pstr_primitive x0 -> + Ast_504.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_505.Parsetree.Pstr_type (x0, x1) -> + Ast_504.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_505.Parsetree.Pstr_typext x0 -> + Ast_504.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_505.Parsetree.Pstr_exception x0 -> + Ast_504.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_505.Parsetree.Pstr_module x0 -> + Ast_504.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_505.Parsetree.Pstr_recmodule x0 -> + Ast_504.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_505.Parsetree.Pstr_modtype x0 -> + Ast_504.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_505.Parsetree.Pstr_open x0 -> + Ast_504.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_505.Parsetree.Pstr_class x0 -> + Ast_504.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_505.Parsetree.Pstr_class_type x0 -> + Ast_504.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_505.Parsetree.Pstr_include x0 -> + Ast_504.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_505.Parsetree.Pstr_attribute x0 -> + Ast_504.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_505.Parsetree.Pstr_extension (x0, x1) -> + Ast_504.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_value_constraint : + Ast_505.Parsetree.value_constraint -> Ast_504.Parsetree.value_constraint = + function + | Ast_505.Parsetree.Pvc_constraint { locally_abstract_univars; typ } -> + Ast_504.Parsetree.Pvc_constraint + { + locally_abstract_univars = + List.map (copy_loc (fun x -> x)) locally_abstract_univars; + typ = copy_core_type typ; + } + | Ast_505.Parsetree.Pvc_coercion { ground; coercion } -> + Ast_504.Parsetree.Pvc_coercion + { + ground = Option.map copy_core_type ground; + coercion = copy_core_type coercion; + } + +and copy_value_binding : + Ast_505.Parsetree.value_binding -> Ast_504.Parsetree.value_binding = + fun { + Ast_505.Parsetree.pvb_pat; + Ast_505.Parsetree.pvb_expr; + Ast_505.Parsetree.pvb_constraint; + Ast_505.Parsetree.pvb_attributes; + Ast_505.Parsetree.pvb_loc; + } -> + { + Ast_504.Parsetree.pvb_pat = copy_pattern pvb_pat; + Ast_504.Parsetree.pvb_expr = copy_expression pvb_expr; + Ast_504.Parsetree.pvb_constraint = + Option.map copy_value_constraint pvb_constraint; + Ast_504.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_504.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_module_binding : + Ast_505.Parsetree.module_binding -> Ast_504.Parsetree.module_binding = + fun { + Ast_505.Parsetree.pmb_name; + Ast_505.Parsetree.pmb_expr; + Ast_505.Parsetree.pmb_attributes; + Ast_505.Parsetree.pmb_loc; + } -> + { + Ast_504.Parsetree.pmb_name = copy_loc (Option.map (fun x -> x)) pmb_name; + Ast_504.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_504.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_504.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_toplevel_phrase : + Ast_505.Parsetree.toplevel_phrase -> Ast_504.Parsetree.toplevel_phrase = + function + | Ast_505.Parsetree.Ptop_def x0 -> + Ast_504.Parsetree.Ptop_def (copy_structure x0) + | Ast_505.Parsetree.Ptop_dir x0 -> + Ast_504.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_505.Parsetree.toplevel_directive -> Ast_504.Parsetree.toplevel_directive + = + fun { + Ast_505.Parsetree.pdir_name; + Ast_505.Parsetree.pdir_arg; + Ast_505.Parsetree.pdir_loc; + } -> + { + Ast_504.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_504.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_504.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_505.Parsetree.directive_argument -> Ast_504.Parsetree.directive_argument + = + fun { Ast_505.Parsetree.pdira_desc; Ast_505.Parsetree.pdira_loc } -> + { + Ast_504.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_504.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_505.Parsetree.directive_argument_desc -> + Ast_504.Parsetree.directive_argument_desc = function + | Ast_505.Parsetree.Pdir_string x0 -> Ast_504.Parsetree.Pdir_string x0 + | Ast_505.Parsetree.Pdir_int (x0, x1) -> + Ast_504.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_505.Parsetree.Pdir_ident x0 -> + Ast_504.Parsetree.Pdir_ident (copy_longident x0) + | Ast_505.Parsetree.Pdir_bool x0 -> Ast_504.Parsetree.Pdir_bool x0 diff --git a/dune-project b/dune-project index 047d0decd..5ebda25dc 100644 --- a/dune-project +++ b/dune-project @@ -16,7 +16,7 @@ (depends ;; 5.3 support is still experimental, remember to set the upper bound ;; to 5.3.0 when cutting a release and then back to 5.4.0 afterwards. - (ocaml (and (and (>= 4.08.0) (< 5.5.0)))) + (ocaml (and (and (>= 4.08.0) (< 5.6.0)))) (ocaml-compiler-libs (>= v0.11.0)) (ppx_derivers (>= 1.0)) (sexplib0 (>= v0.12)) diff --git a/ppxlib.opam b/ppxlib.opam index 4ae8db179..ad6939d2c 100644 --- a/ppxlib.opam +++ b/ppxlib.opam @@ -21,7 +21,7 @@ doc: "https://ocaml-ppx.github.io/ppxlib/" bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" depends: [ "dune" {>= "3.8"} - "ocaml" {>= "4.08.0" & < "5.5.0"} + "ocaml" {>= "4.08.0" & < "5.6.0"} "ocaml-compiler-libs" {>= "v0.11.0"} "ppx_derivers" {>= "1.0"} "sexplib0" {>= "v0.12"} diff --git a/test/505_migrations/driver.ml b/test/505_migrations/driver.ml new file mode 100644 index 000000000..652da86e9 --- /dev/null +++ b/test/505_migrations/driver.ml @@ -0,0 +1,15 @@ +module To_before_505 = + Ppxlib_ast.Convert (Ppxlib_ast.Js) (Ppxlib_ast__.Versions.OCaml_504) + +module From_before_505 = + Ppxlib_ast.Convert (Ppxlib_ast__.Versions.OCaml_504) (Ppxlib_ast.Js) + +let impl _ctxt str = + (* This manual migration is here to ensure the test still works even once our + internal AST has been bumped past 5.5 *) + let before_503_ast = To_before_505.copy_structure str in + let roundtrip = From_before_505.copy_structure before_503_ast in + roundtrip + +let () = Ppxlib.Driver.V2.register_transformation ~impl "505-downward-roundtrip" +let () = Ppxlib.Driver.standalone () diff --git a/test/505_migrations/dune b/test/505_migrations/dune new file mode 100644 index 000000000..0abdf8c27 --- /dev/null +++ b/test/505_migrations/dune @@ -0,0 +1,10 @@ +(executable + (name driver) + (enabled_if + (>= %{ocaml_version} "5.5")) + (libraries ppxlib ocaml-compiler-libs.common compiler-libs.common)) + +(cram + (enabled_if + (>= %{ocaml_version} "5.5")) + (deps driver.exe)) diff --git a/test/505_migrations/run.t b/test/505_migrations/run.t new file mode 100644 index 000000000..b6a23ba13 --- /dev/null +++ b/test/505_migrations/run.t @@ -0,0 +1,46 @@ +OCaml 5.5 Migrations +-------------------- + +1. Pexp_struct_item AST node + +We first check that the changes to various let-bindings are suitably migrated. +[let module M = T in], [let open M in] and [let exception C in] are now all +represented with the same AST node. + +We have a custom driver that will force migration of the AST down to 5.2 and back to +the compiler's version and print it as source code using the compiler's printer, +regardless of ppxlib's internal AST version. + +If we run the driver on the following source file: + + $ cat > test.ml << EOF + > module T = struct let x = 1 end + > let f = + > let exception E of int in + > let module X = T in + > let open X in + > x + > EOF + +it should successfully roundtrip to 5.2 and print the source code unchanged: + + $ ./driver.exe test.ml --use-compiler-pp + module T = struct let x = 1 end + let f = let exception E of int in let module X = T in let open X in x + +2. Ptyp_extension + +A new feature of OCaml 5.5 are external types (e.g. [type t = external "t"]). + + $ cat > test.ml << EOF + > type t = external "t" + > EOF + +For now, we do not support these and raise an error. In the future we may wish +to encode this feature into attributes and this test, along with this comment, +will need updated. + + $ ./driver.exe test.ml --use-compiler-pp + File "test.ml", line 1: + Error: External types are not supported. + [1]