From f0320c49c3b2155d82bcdf7a39e2eefb77d5369a Mon Sep 17 00:00:00 2001 From: Thibaut Mattio Date: Tue, 20 Jun 2023 10:39:59 +0200 Subject: [PATCH] Add support for OCaml 5.1 (#428) * Update trunk AST for pvb_constraint * Add migration from 501 to 500 * Bump the 501 AST magic numbers * Binary AST reader: use latest possible AST version When the magic numbers aren't unique, before this commit, the binary AST reader would read into the first AST version matching the magic number. With this commit, it takes the last such version. That's important for trunk support. * Fix inline tests' dependency on OCaml version Done by making the expected output also dependent on the OCaml version * Add a add tests to test both round-trips as well as a test comparing parsing on 5.0.0 with parsing on 5.1.0 and then down migrating. This last test will need to be updated when bumping the AST. Signed-off-by: Thibaut Mattio Co-authored-by: Samuel Hym Co-authored-by: Florian Angeletti Co-authored-by: Sonja Heinze Co-authored-by: Paul-Elliot --- .ocamlformat-ignore | 7 + CHANGES.md | 3 + ast/supported_version/supported_version.ml | 1 + ast/versions.ml | 22 +- ast/versions.mli | 1 + astlib/ast_501.ml | 1090 +++++++++++++++ astlib/astlib.ml | 3 + astlib/cinaps/astlib_cinaps_helpers.ml | 1 + astlib/config/gen.ml | 1 + astlib/migrate_500_501.ml | 1358 +++++++++++++++++++ astlib/migrate_501_500.ml | 1404 ++++++++++++++++++++ dune-project | 2 +- ppxlib.opam | 2 +- src/location_check.ml | 2 +- test/501_migrations/compare_on.ml | 30 + test/501_migrations/dune | 36 + test/501_migrations/identity_driver.ml | 1 + test/501_migrations/normal_migrations.t | 131 ++ test/501_migrations/one_migration.t | 572 ++++++++ test/501_migrations/reverse_migrations.ml | 9 + test/501_migrations/reverse_migrations.t | 164 +++ test/base/dune | 22 +- test/base/test_510.ml | 180 +++ test/code_path/dune | 22 +- test/code_path/test_510.ml | 152 +++ test/deriving/dune | 22 +- test/deriving/test_510.ml | 90 ++ test/driver/attributes/dune | 22 +- test/driver/attributes/test.ml | 1 - test/driver/attributes/test_510.ml | 105 ++ test/extensions_and_deriving/dune | 22 +- test/extensions_and_deriving/test_510.ml | 148 +++ test/metaquot/dune | 22 +- test/metaquot/test_510.ml | 334 +++++ 34 files changed, 5966 insertions(+), 16 deletions(-) create mode 100644 astlib/ast_501.ml create mode 100644 astlib/migrate_500_501.ml create mode 100644 astlib/migrate_501_500.ml create mode 100644 test/501_migrations/compare_on.ml create mode 100644 test/501_migrations/dune create mode 100644 test/501_migrations/identity_driver.ml create mode 100644 test/501_migrations/normal_migrations.t create mode 100644 test/501_migrations/one_migration.t create mode 100644 test/501_migrations/reverse_migrations.ml create mode 100644 test/501_migrations/reverse_migrations.t create mode 100644 test/base/test_510.ml create mode 100644 test/code_path/test_510.ml create mode 100644 test/deriving/test_510.ml create mode 100644 test/driver/attributes/test_510.ml create mode 100644 test/extensions_and_deriving/test_510.ml create mode 100644 test/metaquot/test_510.ml diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore index ece258d97..c85cb641e 100644 --- a/.ocamlformat-ignore +++ b/.ocamlformat-ignore @@ -16,6 +16,7 @@ astlib/ast_411.ml astlib/ast_412.ml astlib/ast_413.ml astlib/ast_414.ml +astlib/ast_501.ml # Files that use cinaps to generate bode blocks from other code blocks work well, # but files that inject freely formatted code via cinaps must be excluded @@ -25,9 +26,13 @@ ast/versions.mli # Currently our expect-test lexer is too strict for our expect tests to # work well with ocamlformat test/base/test.ml +test/base/test_510.ml test/code_path/test.ml +test/code_path/test_510.ml test/deriving/test.ml +test/deriving/test_510.ml test/driver/attributes/test.ml +test/driver/attributes/test_510.ml test/driver/instrument/test.ml test/driver/non-compressible-suffix/test.ml test/driver/transformations/test.ml @@ -35,8 +40,10 @@ test/expand-header-and-footer/test.ml test/expansion_helpers/mangle/test.ml test/expansion_inside_payloads/test.ml test/extensions_and_deriving/test.ml +test/extensions_and_deriving/test_510.ml test/location/exception/test.ml test/metaquot/test.ml +test/metaquot/test_510.ml test/ppx_import_support/test.ml test/quoter/test.ml test/traverse/test.ml diff --git a/CHANGES.md b/CHANGES.md index 31debdd61..35a5fb9b3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -27,6 +27,9 @@ unreleased - Update description to reflect that `ppxlib` contains more than a library (#422, @pitag-ha) +- Add support for OCaml 5.1, excluding OCaml `5.1.0~alpha1` (#428, @shym, @Octachron , @pitag-ha, @panglesd) +- Driver: Fix `-locations-check` option for coercions with ground (#428, @Octachron) + 0.29.1 (14/02/2023) ------------------ diff --git a/ast/supported_version/supported_version.ml b/ast/supported_version/supported_version.ml index 1e63e0e6d..9d9a458ad 100644 --- a/ast/supported_version/supported_version.ml +++ b/ast/supported_version/supported_version.ml @@ -16,6 +16,7 @@ let all = (4, 13); (4, 14); (5, 0); + (5, 1); ] let to_string (a, b) = diff --git a/ast/versions.ml b/ast/versions.ml index 69ebe18de..cf7bb2081 100644 --- a/ast/versions.ml +++ b/ast/versions.ml @@ -506,6 +506,13 @@ module OCaml_500 = struct let string_version = "5.0" end let ocaml_500 : OCaml_500.types ocaml_version = (module OCaml_500) +module OCaml_501 = struct + module Ast = Astlib.Ast_501 + include Make_witness(Astlib.Ast_501) + let version = 501 + let string_version = "5.1" +end +let ocaml_501 : OCaml_501.types ocaml_version = (module OCaml_501) (*$*) let all_versions : (module OCaml_version) list = [ @@ -525,6 +532,7 @@ let all_versions : (module OCaml_version) list = [ (module OCaml_413 : OCaml_version); (module OCaml_414 : OCaml_version); (module OCaml_500 : OCaml_version); +(module OCaml_501 : OCaml_version); (*$*) ] @@ -559,6 +567,8 @@ include Register_migration(OCaml_413)(OCaml_414) (Astlib.Migrate_413_414)(Astlib.Migrate_414_413) include Register_migration(OCaml_414)(OCaml_500) (Astlib.Migrate_414_500)(Astlib.Migrate_500_414) +include Register_migration(OCaml_500)(OCaml_501) + (Astlib.Migrate_500_501)(Astlib.Migrate_501_500) (*$*) module OCaml_current = OCaml_OCAML_VERSION @@ -577,10 +587,10 @@ module Find_version = struct else loop tail in - (* First check whether it could be the current version, probably - the most common use case. - This bias towards the current version also provides a way to - choose wisely between, say, `trunk` and the latest stable - release, for which the magic numbers are not distinguished *) - loop @@ ((module OCaml_current : OCaml_version) :: all_versions) + (* Traverse the versions from last to first: + if the magic numbers aren't unique among versions, + we want the latest version with a magic number match. + The situation in mind is trunk support. *) + let all_versions_top_down = List.rev all_versions in + loop all_versions_top_down end diff --git a/ast/versions.mli b/ast/versions.mli index 2418e0224..83b2ea78f 100644 --- a/ast/versions.mli +++ b/ast/versions.mli @@ -129,6 +129,7 @@ module OCaml_412 : OCaml_version with module Ast = Astlib.Ast_412 module OCaml_413 : OCaml_version with module Ast = Astlib.Ast_413 module OCaml_414 : OCaml_version with module Ast = Astlib.Ast_414 module OCaml_500 : OCaml_version with module Ast = Astlib.Ast_500 +module OCaml_501 : OCaml_version with module Ast = Astlib.Ast_501 (*$*) (* An alias to the current compiler version *) diff --git a/astlib/ast_501.ml b/astlib/ast_501.ml new file mode 100644 index 000000000..4e0de3173 --- /dev/null +++ b/astlib/ast_501.ml @@ -0,0 +1,1090 @@ +module Asttypes = struct + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * Location.t * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive + + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto + + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public + + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable + + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete + + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh + + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open + + type label = string + + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (** [label:T -> ...] *) + | Optional of string (** [?label:T -> ...] *) + + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; + } + + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity +end + +module Parsetree = struct + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + | Pconst_integer of string * char option + (** Integer constants such as [3] [3l] [3L] [3n]. + + Suffixes [[g-z][G-Z]] are accepted by the parser. + Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker + *) + | Pconst_char of char (** Character such as ['c']. *) + | Pconst_string of string * Location.t * string option + (** Constant string such as ["constant"] or + [{delim|other constant|delim}]. + + The location span the content of the string, without the delimiters. + *) + | Pconst_float of string * char option + (** Float constant such as [3.4], [2e5] or [1.4e-4]. + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + type location_stack = Location.t list + + (** {1 Extension points} *) + + type attribute (*IF_CURRENT = Parsetree.attribute *) = { + attr_name : string loc; + attr_payload : payload; + attr_loc : Location.t; + } + (** Attributes such as [[\@id ARG]] and [[\@\@id ARG]]. + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (** Extension points such as [[%id ARG] and [%%id ARG]]. + + Sub-language placeholder -- rejected by the typechecker. + *) + + and attributes = attribute list + + and payload (*IF_CURRENT = Parsetree.payload *) = + | PStr of structure + | PSig of signature (** [: SIG] in an attribute or an extension point *) + | PTyp of core_type (** [: T] in an attribute or an extension point *) + | PPat of pattern * expression option + (** [? P] or [? P when E], in an attribute or an extension point *) + + (** {1 Core language} *) + (** {2 Type expressions} *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_loc_stack: location_stack; + ptyp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any (** [_] *) + | Ptyp_var of string (** A type variable such as ['a] *) + | Ptyp_arrow of arg_label * core_type * core_type + (** [Ptyp_arrow(lbl, T1, T2)] represents: + - [T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Labelled}[Labelled]}, + - [?l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Optional}[Optional]}. + *) + | Ptyp_tuple of core_type list + (** [Ptyp_tuple([T1 ; ... ; Tn])] + represents a product type [T1 * ... * Tn]. + + Invariant: [n >= 2]. + *) + | Ptyp_constr of Longident.t loc * core_type list + (** [Ptyp_constr(lident, l)] represents: + - [tconstr] when [l=[]], + - [T tconstr] when [l=[T]], + - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_object of object_field list * closed_flag + (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents: + - [< l1:T1; ...; ln:Tn >] when [flag] is + {{!Asttypes.closed_flag.Closed}[Closed]}, + - [< l1:T1; ...; ln:Tn; .. >] when [flag] is + {{!Asttypes.closed_flag.Open}[Open]}. + *) + | Ptyp_class of Longident.t loc * core_type list + (** [Ptyp_class(tconstr, l)] represents: + - [#tconstr] when [l=[]], + - [T #tconstr] when [l=[T]], + - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_alias of core_type * string (** [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_extension of extension (** [[%id]]. *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (** As {!package_type} typed values: + - [(S, [])] represents [(module S)], + - [(S, [(t1, T1) ; ... ; (tn, Tn)])] + represents [(module S with type t1 = T1 and ... and tn = Tn)]. + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = { + prf_desc : row_field_desc; + prf_loc : Location.t; + prf_attributes : attributes; + } + + and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) = + | Rtag of label loc * bool * core_type list + (** [Rtag(`A, b, l)] represents: + - [`A] when [b] is [true] and [l] is [[]], + - [`A of T] when [b] is [false] and [l] is [[T]], + - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]], + - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[T1;...Tn]]. + + - The [bool] field is true if the tag contains a + constant (empty) constructor. + - [&] occurs when several types are used for the same constructor + (see 4.2 in the manual) + *) + | Rinherit of core_type (** [[ | t ]] *) + + and object_field (*IF_CURRENT = Parsetree.object_field *) = { + pof_desc : object_field_desc; + pof_loc : Location.t; + pof_attributes : attributes; + } + + and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) = + | Otag of label loc * core_type + | Oinherit of core_type + + (** {2 Patterns} *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_loc_stack: location_stack; + ppat_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any (** The pattern [_]. *) + | Ppat_var of string loc (** A variable pattern such as [x] *) + | Ppat_alias of pattern * string loc + (** An alias pattern such as [P as 'a] *) + | Ppat_constant of constant + (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *) + | Ppat_interval of constant * constant + (** Patterns such as ['a'..'z']. + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (** Patterns [(P1, ..., Pn)]. + + Invariant: [n >= 2] + *) + | Ppat_construct of Longident.t loc * (string loc list * pattern) option + (** [Ppat_construct(C, args)] represents: + - [C] when [args] is [None], + - [C P] when [args] is [Some ([], P)] + - [C (P1, ..., Pn)] when [args] is + [Some ([], Ppat_tuple [P1; ...; Pn])] + - [C (type a b) P] when [args] is [Some ([a; b], P)] + *) + | Ppat_variant of label * pattern option + (** [Ppat_variant(`A, pat)] represents: + - [`A] when [pat] is [None], + - [`A P] when [pat] is [Some P] + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents: + - [{ l1=P1; ...; ln=Pn }] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]} + - [{ l1=P1; ...; ln=Pn; _}] + when [flag] is {{!Asttypes.closed_flag.Open}[Open]} + + Invariant: [n > 0] + *) + | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *) + | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *) + | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *) + | Ppat_type of Longident.t loc (** Pattern [#tconst] *) + | Ppat_lazy of pattern (** Pattern [lazy P] *) + | Ppat_unpack of string option loc + (** [Ppat_unpack(s)] represents: + - [(module P)] when [s] is [Some "P"] + - [(module _)] when [s] is [None] + + Note: [(module P : S)] is represented as + [Ppat_constraint(Ppat_unpack(Some "P"), Ptyp_package S)] + *) + | Ppat_exception of pattern (** Pattern [exception P] *) + | Ppat_extension of extension (** Pattern [[%id]] *) + | Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *) + + (** {2 Value expressions} *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_loc_stack: location_stack; + pexp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (** Identifiers such as [x] and [M.x] + *) + | Pexp_constant of constant + (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l], + [1L], [1n] *) + | Pexp_let of rec_flag * value_binding list * expression + (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents: + - [let P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pexp_function of case list (** [function P1 -> E1 | ... | Pn -> En] *) + | Pexp_fun of arg_label * expression option * pattern * expression + (** [Pexp_fun(lbl, exp0, P, E1)] represents: + - [fun P -> E1] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None] + - [fun ~l:P -> E1] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None] + - [fun ?l:P -> E1] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None] + - [fun ?l:(P = E0) -> E1] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0] + + Notes: + - If [E0] is provided, only + {{!Asttypes.arg_label.Optional}[Optional]} is allowed. + - [fun P1 P2 .. Pn -> E1] is represented as nested + {{!expression_desc.Pexp_fun}[Pexp_fun]}. + - [let f P = E] is represented using + {{!expression_desc.Pexp_fun}[Pexp_fun]}. + *) + | Pexp_apply of expression * (arg_label * expression) list + (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])] + represents [E0 ~l1:E1 ... ~ln:En] + + [li] can be + {{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument), + {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or + {{!Asttypes.arg_label.Optional}[Optional]} (optional argument). + + Invariant: [n > 0] + *) + | Pexp_match of expression * case list + (** [match E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_try of expression * case list + (** [try E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_tuple of expression list + (** Expressions [(E1, ..., En)] + + Invariant: [n >= 2] + *) + | Pexp_construct of Longident.t loc * expression option + (** [Pexp_construct(C, exp)] represents: + - [C] when [exp] is [None], + - [C E] when [exp] is [Some E], + - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])] + *) + | Pexp_variant of label * expression option + (** [Pexp_variant(`A, exp)] represents + - [`A] when [exp] is [None] + - [`A E] when [exp] is [Some E] + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents + - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None] + - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0] + + Invariant: [n > 0] + *) + | Pexp_field of expression * Longident.t loc (** [E.l] *) + | Pexp_setfield of expression * Longident.t loc * expression + (** [E1.l <- E2] *) + | Pexp_array of expression list (** [[| E1; ...; En |]] *) + | Pexp_ifthenelse of expression * expression * expression option + (** [if E1 then E2 else E3] *) + | Pexp_sequence of expression * expression (** [E1; E2] *) + | Pexp_while of expression * expression (** [while E1 do E2 done] *) + | Pexp_for of pattern * expression * expression * direction_flag * expression + (** [Pexp_for(i, E1, E2, direction, E3)] represents: + - [for i = E1 to E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]} + - [for i = E1 downto E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]} + *) + | Pexp_constraint of expression * core_type (** [(E : T)] *) + | Pexp_coerce of expression * core_type option * core_type + (** [Pexp_coerce(E, from, T)] represents + - [(E :> T)] when [from] is [None], + - [(E : T0 :> T)] when [from] is [Some T0]. + *) + | Pexp_send of expression * label loc (** [E # m] *) + | Pexp_new of Longident.t loc (** [new M.c] *) + | Pexp_setinstvar of label loc * expression (** [x <- 2] *) + | Pexp_override of (label loc * expression) list + (** [{< x1 = E1; ...; xn = En >}] *) + | Pexp_letmodule of string option loc * module_expr * expression + (** [let module M = ME in E] *) + | Pexp_letexception of extension_constructor * expression + (** [let exception C in E] *) + | Pexp_assert of expression + (** [assert E]. + + Note: [assert false] is treated in a special way by the + type-checker. *) + | Pexp_lazy of expression (** [lazy E] *) + | Pexp_poly of expression * core_type option + (** Used for method bodies. + + Can only be used as the expression under + {{!class_field_kind.Cfk_concrete}[Cfk_concrete]} for methods (not + values). *) + | Pexp_object of class_structure (** [object ... end] *) + | Pexp_newtype of string loc * expression (** [fun (type t) -> E] *) + | Pexp_pack of module_expr + (** [(module ME)]. + + [(module ME : S)] is represented as + [Pexp_constraint(Pexp_pack ME, Ptyp_package S)] *) + | Pexp_open of open_declaration * expression + (** - [M.(E)] + - [let open M in E] + - [let open! M in E] *) + | Pexp_letop of letop + (** - [let* P = E0 in E1] + - [let* P0 = E00 and* P1 = E01 in E1] *) + | Pexp_extension of extension (** [[%id]] *) + | Pexp_unreachable (** [.] *) + + and case (*IF_CURRENT = Parsetree.case *) = + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + (** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *) + + and letop (*IF_CURRENT = Parsetree.letop *) = + { + let_ : binding_op; + ands : binding_op list; + body : expression; + } + + and binding_op (*IF_CURRENT = Parsetree.binding_op *) = + { + pbop_op : string loc; + pbop_pat : pattern; + pbop_exp : expression; + pbop_loc : Location.t; + } + + (** {2 Value descriptions} *) + + and value_description (*IF_CURRENT = Parsetree.value_description *) = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pval_loc: Location.t; + } + (** Values of type {!value_description} represents: + - [val x: T], + when {{!value_description.pval_prim}[pval_prim]} is [[]] + - [external x: T = "s1" ... "sn"] + when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]] + *) + + (** {2 Type declarations} *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * (variance * injectivity)) list; + (** [('a1,...'an) t] *) + ptype_cstrs: (core_type * core_type * Location.t) list; + (** [... constraint T1=T1' ... constraint Tn=Tn'] *) + ptype_kind: type_kind; + ptype_private: private_flag; (** for [= private ...] *) + ptype_manifest: core_type option; (** represents [= T] *) + ptype_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + ptype_loc: Location.t; + } + (** + Here are type declarations and their representation, + for various {{!type_declaration.ptype_kind}[ptype_kind]} + and {{!type_declaration.ptype_manifest}[ptype_manifest]} values: + - [type t] when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [None], + - [type t = T0] + when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [Some T0], + - [type t = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [None], + - [type t = T0 = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [Some T0], + - [type t = {l: T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [None], + - [type t = T0 = {l : T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [Some T0], + - [type t = ..] + when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]}, + and [manifest] is [None]. + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + | Ptype_record of label_declaration list (** Invariant: non-empty list *) + | Ptype_open + + and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: Location.t; + pld_attributes: attributes; (** [l : T [\@id1] [\@id2]] *) + } + (** + - [{ ...; l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Immutable}[Immutable]}, + - [{ ...; mutable l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Mutable}[Mutable]}. + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_vars: string loc list; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + + and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + (** Values of type {!constructor_declaration} + represents the constructor arguments of: + - [C of T1 * ... * Tn] when [res = None], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C: T0] when [res = Some T0], + and [args = Pcstr_tuple []], + - [C: T1 * ... * Tn -> T0] when [res = Some T0], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C of {...}] when [res = None], + and [args = Pcstr_record [...]], + - [C: {...} -> T0] when [res = Some T0], + and [args = Pcstr_record [...]]. + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * (variance * injectivity)) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (** ... [\@\@id1] [\@\@id2] *) + } + (** + Definition of new extensions constructors for the extensive sum type [t] + ([type t += ...]). + *) + + and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = + { + pext_name: string loc; + pext_kind: extension_constructor_kind; + pext_loc: Location.t; + pext_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor : extension_constructor; + ptyexn_loc : Location.t; + ptyexn_attributes : attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + (** Definition of a new exception ([exception E]). *) + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + | Pext_decl of string loc list * constructor_arguments * core_type option + (** [Pext_decl(existentials, c_args, t_opt)] + describes a new extension constructor. It can be: + - [C of T1 * ... * Tn] when: + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [None].}} + - [C: T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[]],} + {- [t_opt] is [Some T0].}} + - [C: T1 * ... * Tn -> T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [Some T0].}} + - [C: 'a... . T1 * ... * Tn -> T0] when + {ul {- [existentials] is [['a;...]],} + {- [c_args] is [[T1; ... ; Tn]],} + {- [t_opt] is [Some T0].}} + *) + | Pext_rebind of Longident.t loc + (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *) + + (** {1 Class language} *) + (** {2 Type expressions for the class language} *) + + and class_type (*IF_CURRENT = Parsetree.class_type *) = + { + pcty_desc: class_type_desc; + pcty_loc: Location.t; + pcty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = + | Pcty_constr of Longident.t loc * core_type list + (** - [c] + - [['a1, ..., 'an] c] *) + | Pcty_signature of class_signature (** [object ... end] *) + | Pcty_arrow of arg_label * core_type * class_type + (** [Pcty_arrow(lbl, T, CT)] represents: + - [T -> CT] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}, + - [?l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}. + *) + | Pcty_extension of extension (** [%id] *) + | Pcty_open of open_description * class_type (** [let open M in CT] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (** Values of type [class_signature] represents: + - [object('selfpat) ... end] + - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]} + is {{!core_type_desc.Ptyp_any}[Ptyp_any]} + *) + + and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = + { + pctf_desc: class_type_field_desc; + pctf_loc: Location.t; + pctf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + + and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = + | Pctf_inherit of class_type (** [inherit CT] *) + | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) + (** [val x: T] *) + | Pctf_method of (label loc * private_flag * virtual_flag * core_type) + (** [method x: T] + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. + *) + | Pctf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pctf_attribute of attribute (** [[\@\@\@id]] *) + | Pctf_extension of extension (** [[%%id]] *) + + and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = + { + pci_virt: virtual_flag; + pci_params: (core_type * (variance * injectivity)) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + (** Values of type [class_expr class_infos] represents: + - [class c = ...] + - [class ['a1,...,'an] c = ...] + - [class virtual c = ...] + + They are also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (** {2 Value expressions for the class language} *) + + and class_expr (*IF_CURRENT = Parsetree.class_expr *) = + { + pcl_desc: class_expr_desc; + pcl_loc: Location.t; + pcl_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = + | Pcl_constr of Longident.t loc * core_type list + (** [c] and [['a1, ..., 'an] c] *) + | Pcl_structure of class_structure (** [object ... end] *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (** [Pcl_fun(lbl, exp0, P, CE)] represents: + - [fun P -> CE] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None], + - [fun ~l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None], + - [fun ?l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None], + - [fun ?l:(P = E0) -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0]. + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])] + represents [CE ~l1:E1 ... ~ln:En]. + [li] can be empty (non labeled argument) or start with [?] + (optional argument). + + Invariant: [n > 0] + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents: + - [let P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pcl_constraint of class_expr * class_type (** [(CE : CT)] *) + | Pcl_extension of extension (** [[%id]] *) + | Pcl_open of open_description * class_expr (** [let open M in CE] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (** Values of type {!class_structure} represents: + - [object(selfpat) ... end] + - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]} + is {{!pattern_desc.Ppat_any}[Ppat_any]} + *) + + and class_field (*IF_CURRENT = Parsetree.class_field *) = + { + pcf_desc: class_field_desc; + pcf_loc: Location.t; + pcf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + + and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = + | Pcf_inherit of override_flag * class_expr * string loc option + (** [Pcf_inherit(flag, CE, s)] represents: + - [inherit CE] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [None], + - [inherit CE as x] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [Some x], + - [inherit! CE] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [None], + - [inherit! CE as x] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [Some x] + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (** [Pcf_val(x,flag, kind)] represents: + - [val x = E] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + - [val mutable x = E] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val mutable virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (** - [method x = E] + ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]}) + - [method virtual x: T] + ([T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}) + *) + | Pcf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pcf_initializer of expression (** [initializer E] *) + | Pcf_attribute of attribute (** [[\@\@\@id]] *) + | Pcf_extension of extension (** [[%%id]] *) + + and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + + and class_declaration = class_expr class_infos + + (** {1 Module language} *) + (** {2 Type expressions for the module language} *) + + and module_type (*IF_CURRENT = Parsetree.module_type *) = + { + pmty_desc: module_type_desc; + pmty_loc: Location.t; + pmty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = + | Pmty_ident of Longident.t loc (** [Pmty_ident(S)] represents [S] *) + | Pmty_signature of signature (** [sig ... end] *) + | Pmty_functor of functor_parameter * module_type + (** [functor(X : MT1) -> MT2] *) + | Pmty_with of module_type * with_constraint list (** [MT with ...] *) + | Pmty_typeof of module_expr (** [module type of ME] *) + | Pmty_extension of extension (** [[%id]] *) + | Pmty_alias of Longident.t loc (** [(module M)] *) + + and functor_parameter (*IF_CURRENT = Parsetree.functor_parameter *) = + | Unit (** [()] *) + | Named of string option loc * module_type + (** [Named(name, MT)] represents: + - [(X : MT)] when [name] is [Some X], + - [(_ : MT)] when [name] is [None] *) + + and signature = signature_item list + + and signature_item (*IF_CURRENT = Parsetree.signature_item *) = + { + psig_desc: signature_item_desc; + psig_loc: Location.t; + } + + and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = + | Psig_value of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn"] + *) + | Psig_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Psig_typesubst of type_declaration list + (** [type t1 := ... and ... and tn := ...] *) + | Psig_typext of type_extension (** [type t1 += ...] *) + | Psig_exception of type_exception (** [exception C of T] *) + | Psig_module of module_declaration (** [module X = M] and [module X : MT] *) + | Psig_modsubst of module_substitution (** [module X := M] *) + | Psig_recmodule of module_declaration list + (** [module rec X1 : MT1 and ... and Xn : MTn] *) + | Psig_modtype of module_type_declaration + (** [module type S = MT] and [module type S] *) + | Psig_modtypesubst of module_type_declaration + (** [module type S := ...] *) + | Psig_open of open_description (** [open X] *) + | Psig_include of include_description (** [include MT] *) + | Psig_class of class_description list + (** [class c1 : ... and ... and cn : ...] *) + | Psig_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Psig_attribute of attribute (** [[\@\@\@id]] *) + | Psig_extension of extension * attributes (** [[%%id]] *) + + and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = + { + pmd_name: string option loc; + pmd_type: module_type; + pmd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmd_loc: Location.t; + } + (** Values of type [module_declaration] represents [S : MT] *) + + and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) = + { + pms_name: string loc; + pms_manifest: Longident.t loc; + pms_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pms_loc: Location.t; + } + (** Values of type [module_substitution] represents [S := M] *) + + and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmtd_loc: Location.t; + } + (** Values of type [module_type_declaration] represents: + - [S = MT], + - [S] for abstract module type declaration, + when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None]. + *) + + and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) = + { + popen_expr: 'a; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (** Values of type ['a open_infos] represents: + - [open! X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Override}[Override]} + (silences the "used identifier shadowing" warning) + - [open X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Fresh}[Fresh]} + *) + + and open_description = Longident.t loc open_infos + (** Values of type [open_description] represents: + - [open M.N] + - [open M(N).O] *) + + and open_declaration = module_expr open_infos + (** Values of type [open_declaration] represents: + - [open M.N] + - [open M(N).O] + - [open struct ... end] *) + + and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = + { + pincl_mod: 'a; + pincl_loc: Location.t; + pincl_attributes: attributes; + } + + and include_description = module_type include_infos + (** Values of type [include_description] represents [include MT] *) + + and include_declaration = module_expr include_infos + (** Values of type [include_declaration] represents [include ME] *) + + and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = + | Pwith_type of Longident.t loc * type_declaration + (** [with type X.t = ...] + + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (** [with module X.Y = Z] *) + | Pwith_modtype of Longident.t loc * module_type + (** [with module type X.Y = Z] *) + | Pwith_modtypesubst of Longident.t loc * module_type + (** [with module type X.Y := sig end] *) + | Pwith_typesubst of Longident.t loc * type_declaration + (** [with type X.t := ..., same format as [Pwith_type]] *) + | Pwith_modsubst of Longident.t loc * Longident.t loc + (** [with module X.Y := Z] *) + + (** {2 Value expressions for the module language} *) + + and module_expr (*IF_CURRENT = Parsetree.module_expr *) = + { + pmod_desc: module_expr_desc; + pmod_loc: Location.t; + pmod_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = + | Pmod_ident of Longident.t loc (** [X] *) + | Pmod_structure of structure (** [struct ... end] *) + | Pmod_functor of functor_parameter * module_expr + (** [functor(X : MT1) -> ME] *) + | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *) + | Pmod_apply_unit of module_expr (** [ME1()] *) + | Pmod_constraint of module_expr * module_type (** [(ME : MT)] *) + | Pmod_unpack of expression (** [(val E)] *) + | Pmod_extension of extension (** [[%id]] *) + + and structure = structure_item list + + and structure_item (*IF_CURRENT = Parsetree.structure_item *) = + { + pstr_desc: structure_item_desc; + pstr_loc: Location.t; + } + + and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = + | Pstr_eval of expression * attributes (** [E] *) + | Pstr_value of rec_flag * value_binding list + (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents: + - [let P1 = E1 and ... and Pn = EN] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN ] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pstr_primitive of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn" ]*) + | Pstr_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Pstr_typext of type_extension (** [type t1 += ...] *) + | Pstr_exception of type_exception + (** - [exception C of T] + - [exception C = M.X] *) + | Pstr_module of module_binding (** [module X = ME] *) + | Pstr_recmodule of module_binding list + (** [module rec X1 = ME1 and ... and Xn = MEn] *) + | Pstr_modtype of module_type_declaration (** [module type S = MT] *) + | Pstr_open of open_declaration (** [open X] *) + | Pstr_class of class_declaration list + (** [class c1 = ... and ... and cn = ...] *) + | Pstr_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Pstr_include of include_declaration (** [include ME] *) + | Pstr_attribute of attribute (** [[\@\@\@id]] *) + | Pstr_extension of extension * attributes (** [[%%id]] *) + + and value_constraint (*IF_CURRENT = Parsetree.value_constraint *) = + | Pvc_constraint of { + locally_abstract_univars:string loc list; + typ:core_type; + } + | Pvc_coercion of {ground:core_type option; coercion:core_type } + + and value_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_constraint: value_constraint option; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string option loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (** Values of type [module_binding] represents [module X = ME] *) + + (** {1 Toplevel} *) + + (** {2 Toplevel phrases} *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of toplevel_directive (** [#use], [#load] ... *) + + and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) = + { + pdir_name: string loc; + pdir_arg: directive_argument option; + pdir_loc: Location.t; + } + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + { + pdira_desc: directive_argument_desc; + pdira_loc: Location.t; + } + + and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) = + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M033" + let ast_intf_magic_number = "Caml1999N033" +end diff --git a/astlib/astlib.ml b/astlib/astlib.ml index a77918400..d13d986c9 100644 --- a/astlib/astlib.ml +++ b/astlib/astlib.ml @@ -36,6 +36,7 @@ module Ast_412 = Ast_412 module Ast_413 = Ast_413 module Ast_414 = Ast_414 module Ast_500 = Ast_500 +module Ast_501 = Ast_501 (*$*) (* Manual migration between versions *) @@ -70,6 +71,8 @@ module Migrate_413_414 = Migrate_413_414 module Migrate_414_413 = Migrate_414_413 module Migrate_414_500 = Migrate_414_500 module Migrate_500_414 = Migrate_500_414 +module Migrate_500_501 = Migrate_500_501 +module Migrate_501_500 = Migrate_501_500 (*$*) (* Compiler modules *) diff --git a/astlib/cinaps/astlib_cinaps_helpers.ml b/astlib/cinaps/astlib_cinaps_helpers.ml index 15ebcfacf..550c84021 100644 --- a/astlib/cinaps/astlib_cinaps_helpers.ml +++ b/astlib/cinaps/astlib_cinaps_helpers.ml @@ -21,6 +21,7 @@ let supported_versions = ("413", "4.13"); ("414", "4.14"); ("500", "5.00"); + ("501", "5.01"); ] let foreach_version f = diff --git a/astlib/config/gen.ml b/astlib/config/gen.ml index b29965fb9..e590dda34 100644 --- a/astlib/config/gen.ml +++ b/astlib/config/gen.ml @@ -26,6 +26,7 @@ let () = | 5, 0 -> "414" (* Ast_500 aliases Ast_414, since the AST hasn't changed between those two *) + | 5, 1 -> "501" | _ -> Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str; exit 1) diff --git a/astlib/migrate_500_501.ml b/astlib/migrate_500_501.ml new file mode 100644 index 000000000..bb26e4f38 --- /dev/null +++ b/astlib/migrate_500_501.ml @@ -0,0 +1,1358 @@ +open Stdlib0 +module From = Ast_500 +module To = Ast_501 + +let rec copy_toplevel_phrase : + Ast_500.Parsetree.toplevel_phrase -> Ast_501.Parsetree.toplevel_phrase = + function + | Ast_500.Parsetree.Ptop_def x0 -> + Ast_501.Parsetree.Ptop_def (copy_structure x0) + | Ast_500.Parsetree.Ptop_dir x0 -> + Ast_501.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_500.Parsetree.toplevel_directive -> Ast_501.Parsetree.toplevel_directive + = + fun { + Ast_500.Parsetree.pdir_name; + Ast_500.Parsetree.pdir_arg; + Ast_500.Parsetree.pdir_loc; + } -> + { + Ast_501.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_501.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_501.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_500.Parsetree.directive_argument -> Ast_501.Parsetree.directive_argument + = + fun { Ast_500.Parsetree.pdira_desc; Ast_500.Parsetree.pdira_loc } -> + { + Ast_501.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_501.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_500.Parsetree.directive_argument_desc -> + Ast_501.Parsetree.directive_argument_desc = function + | Ast_500.Parsetree.Pdir_string x0 -> Ast_501.Parsetree.Pdir_string x0 + | Ast_500.Parsetree.Pdir_int (x0, x1) -> + Ast_501.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_500.Parsetree.Pdir_ident x0 -> + Ast_501.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_500.Parsetree.Pdir_bool x0 -> Ast_501.Parsetree.Pdir_bool x0 + +and copy_expression : + Ast_500.Parsetree.expression -> Ast_501.Parsetree.expression = + fun { + Ast_500.Parsetree.pexp_desc; + Ast_500.Parsetree.pexp_loc; + Ast_500.Parsetree.pexp_loc_stack; + Ast_500.Parsetree.pexp_attributes; + } -> + { + Ast_501.Parsetree.pexp_desc = copy_expression_desc pexp_desc; + Ast_501.Parsetree.pexp_loc = copy_location pexp_loc; + Ast_501.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_501.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_500.Parsetree.expression_desc -> Ast_501.Parsetree.expression_desc = + function + | Ast_500.Parsetree.Pexp_ident x0 -> + Ast_501.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_500.Parsetree.Pexp_constant x0 -> + Ast_501.Parsetree.Pexp_constant (copy_constant x0) + | Ast_500.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_501.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_500.Parsetree.Pexp_function x0 -> + Ast_501.Parsetree.Pexp_function (List.map copy_case x0) + | Ast_500.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_501.Parsetree.Pexp_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_expression x3 ) + | Ast_500.Parsetree.Pexp_apply (x0, x1) -> + Ast_501.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_500.Parsetree.Pexp_match (x0, x1) -> + Ast_501.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_500.Parsetree.Pexp_try (x0, x1) -> + Ast_501.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_500.Parsetree.Pexp_tuple x0 -> + Ast_501.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_500.Parsetree.Pexp_construct (x0, x1) -> + Ast_501.Parsetree.Pexp_construct + (copy_loc copy_Longident_t x0, Option.map copy_expression x1) + | Ast_500.Parsetree.Pexp_variant (x0, x1) -> + Ast_501.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_500.Parsetree.Pexp_record (x0, x1) -> + Ast_501.Parsetree.Pexp_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_expression x1)) + x0, + Option.map copy_expression x1 ) + | Ast_500.Parsetree.Pexp_field (x0, x1) -> + Ast_501.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_Longident_t x1) + | Ast_500.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_501.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_Longident_t x1, copy_expression x2) + | Ast_500.Parsetree.Pexp_array x0 -> + Ast_501.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_500.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_501.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_500.Parsetree.Pexp_sequence (x0, x1) -> + Ast_501.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_while (x0, x1) -> + Ast_501.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_501.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_500.Parsetree.Pexp_constraint (x0, x1) -> + Ast_501.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_500.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_501.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_500.Parsetree.Pexp_send (x0, x1) -> + Ast_501.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_500.Parsetree.Pexp_new x0 -> + Ast_501.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_500.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_501.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_override x0 -> + Ast_501.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_500.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_501.Parsetree.Pexp_letmodule + ( copy_loc (fun x -> Option.map (fun x -> x) x) x0, + copy_module_expr x1, + copy_expression x2 ) + | Ast_500.Parsetree.Pexp_letexception (x0, x1) -> + Ast_501.Parsetree.Pexp_letexception + (copy_extension_constructor x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_assert x0 -> + Ast_501.Parsetree.Pexp_assert (copy_expression x0) + | Ast_500.Parsetree.Pexp_lazy x0 -> + Ast_501.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_500.Parsetree.Pexp_poly (x0, x1) -> + Ast_501.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_500.Parsetree.Pexp_object x0 -> + Ast_501.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_500.Parsetree.Pexp_newtype (x0, x1) -> + Ast_501.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_pack x0 -> + Ast_501.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_500.Parsetree.Pexp_open (x0, x1) -> + Ast_501.Parsetree.Pexp_open (copy_open_declaration x0, copy_expression x1) + | Ast_500.Parsetree.Pexp_letop x0 -> + Ast_501.Parsetree.Pexp_letop (copy_letop x0) + | Ast_500.Parsetree.Pexp_extension x0 -> + Ast_501.Parsetree.Pexp_extension (copy_extension x0) + | Ast_500.Parsetree.Pexp_unreachable -> Ast_501.Parsetree.Pexp_unreachable + +and copy_letop : Ast_500.Parsetree.letop -> Ast_501.Parsetree.letop = + fun { Ast_500.Parsetree.let_; Ast_500.Parsetree.ands; Ast_500.Parsetree.body } -> + { + Ast_501.Parsetree.let_ = copy_binding_op let_; + Ast_501.Parsetree.ands = List.map copy_binding_op ands; + Ast_501.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_500.Parsetree.binding_op -> Ast_501.Parsetree.binding_op = + fun { + Ast_500.Parsetree.pbop_op; + Ast_500.Parsetree.pbop_pat; + Ast_500.Parsetree.pbop_exp; + Ast_500.Parsetree.pbop_loc; + } -> + { + Ast_501.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_501.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_501.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_501.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_direction_flag : + Ast_500.Asttypes.direction_flag -> Ast_501.Asttypes.direction_flag = + function + | Ast_500.Asttypes.Upto -> Ast_501.Asttypes.Upto + | Ast_500.Asttypes.Downto -> Ast_501.Asttypes.Downto + +and copy_case : Ast_500.Parsetree.case -> Ast_501.Parsetree.case = + fun { + Ast_500.Parsetree.pc_lhs; + Ast_500.Parsetree.pc_guard; + Ast_500.Parsetree.pc_rhs; + } -> + { + Ast_501.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_501.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_501.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_value_binding : + Ast_500.Parsetree.value_binding -> Ast_501.Parsetree.value_binding = + fun { + Ast_500.Parsetree.pvb_pat; + Ast_500.Parsetree.pvb_expr; + Ast_500.Parsetree.pvb_attributes; + Ast_500.Parsetree.pvb_loc; + } -> + (* Copied and adapted from OCaml 5.0 Ast_helper *) + let varify_constructors var_names t = + let var_names = List.map (fun v -> v.Location.txt) var_names in + let rec loop t = + let desc = + match t.Ast_500.Parsetree.ptyp_desc with + | Ast_500.Parsetree.Ptyp_any -> Ast_500.Parsetree.Ptyp_any + | Ptyp_var x -> Ptyp_var x + | Ptyp_arrow (label, core_type, core_type') -> + Ptyp_arrow (label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr ({ txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr (longident, lst) -> + Ptyp_constr (longident, List.map loop lst) + | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias (core_type, string) -> Ptyp_alias (loop core_type, string) + | Ptyp_variant (row_field_list, flag, lbl_lst_option) -> + Ptyp_variant + (List.map loop_row_field row_field_list, flag, lbl_lst_option) + | Ptyp_poly (string_lst, core_type) -> + Ptyp_poly (string_lst, loop core_type) + | Ptyp_package (longident, lst) -> + Ptyp_package + (longident, List.map (fun (n, typ) -> (n, loop typ)) lst) + | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) + in + { t with ptyp_desc = desc } + and loop_row_field field = + let prf_desc = + match field.prf_desc with + | Ast_500.Parsetree.Rtag (label, flag, lst) -> + Ast_500.Parsetree.Rtag (label, flag, List.map loop lst) + | Rinherit t -> Rinherit (loop t) + in + { field with prf_desc } + and loop_object_field field = + let pof_desc = + match field.pof_desc with + | Ast_500.Parsetree.Otag (label, t) -> + Ast_500.Parsetree.Otag (label, loop t) + | Oinherit t -> Oinherit (loop t) + in + { field with pof_desc } + in + loop t + in + (* Match the form of the expr and pattern to decide the value of + [pvb_constraint]. Adapted from OCaml 5.0 PPrinter. *) + let tyvars_str tyvars = List.map (fun v -> v.Location.txt) tyvars in + let resugarable_value_binding p e = + let value_pattern = + match p with + | { + Ast_500.Parsetree.ppat_desc = + Ppat_constraint + ( ({ ppat_desc = Ppat_var _ } as pat), + ({ ptyp_desc = Ptyp_poly (args_tyvars, rt) } as ty_ext) ); + ppat_attributes = []; + } -> + assert (match rt.ptyp_desc with Ptyp_poly _ -> false | _ -> true); + let ty = match args_tyvars with [] -> rt | _ -> ty_ext in + `Var (pat, args_tyvars, rt, ty) + | { + Ast_500.Parsetree.ppat_desc = Ppat_constraint (pat, rt); + ppat_attributes = []; + } -> + `NonVar (pat, rt) + | _ -> `None + in + let rec value_exp tyvars e = + match e with + | { + Ast_500.Parsetree.pexp_desc = Pexp_newtype (tyvar, e); + pexp_attributes = []; + } -> + value_exp (tyvar :: tyvars) e + | { pexp_desc = Pexp_constraint (e, ct); pexp_attributes = [] } -> + Some (List.rev tyvars, e, ct) + | _ -> None + in + let value_exp = value_exp [] e in + match (value_pattern, value_exp) with + | `Var (p, pt_tyvars, pt_ct, extern_ct), Some (e_tyvars, inner_e, e_ct) + when tyvars_str pt_tyvars = tyvars_str e_tyvars -> + let ety = varify_constructors e_tyvars e_ct in + if ety = pt_ct then + `Desugared_locally_abstract (p, pt_tyvars, e_ct, inner_e) + else + (* the expression constraint and the pattern constraint, + don't match, but we still have a Ptyp_poly pattern constraint that + should be resugared to a value binding *) + `Univars (p, pt_tyvars, extern_ct, e) + | `Var (p, pt_tyvars, pt_ct, extern_ct), _ -> + `Univars (p, pt_tyvars, extern_ct, e) + | `NonVar (pat, ct), _ -> `NonVar (pat, ct, e) + | _ -> `None + in + let with_constraint ty_vars typ = + let typ = copy_core_type typ in + Some + (Ast_501.Parsetree.Pvc_constraint + { locally_abstract_univars = ty_vars; typ }) + in + let pvb_pat, pvb_expr, pvb_constraint = + match resugarable_value_binding pvb_pat pvb_expr with + | `Desugared_locally_abstract (p, ty_vars, typ, e) -> + (p, e, with_constraint ty_vars typ) + | `Univars (pat, [], ct, expr) -> ( + (* check if we are in the [let x : ty? :> coer = expr ] case *) + match expr with + | { pexp_desc = Pexp_coerce (expr, gr, coerce); pexp_attributes = [] } + -> + let ground = Option.map copy_core_type gr in + let coercion = copy_core_type coerce in + let pvb_constraint = + Some (Ast_501.Parsetree.Pvc_coercion { ground; coercion }) + in + (pat, expr, pvb_constraint) + | _ -> (pat, expr, with_constraint [] ct)) + | `Univars (pat, _, ct, expr) -> (pat, expr, with_constraint [] ct) + | `NonVar (p, typ, e) -> (p, e, with_constraint [] typ) + | `None -> (pvb_pat, pvb_expr, None) + in + { + Ast_501.Parsetree.pvb_pat = copy_pattern pvb_pat; + Ast_501.Parsetree.pvb_expr = copy_expression pvb_expr; + Ast_501.Parsetree.pvb_constraint; + Ast_501.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_501.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_pattern : Ast_500.Parsetree.pattern -> Ast_501.Parsetree.pattern = + fun { + Ast_500.Parsetree.ppat_desc; + Ast_500.Parsetree.ppat_loc; + Ast_500.Parsetree.ppat_loc_stack; + Ast_500.Parsetree.ppat_attributes; + } -> + { + Ast_501.Parsetree.ppat_desc = copy_pattern_desc ppat_desc; + Ast_501.Parsetree.ppat_loc = copy_location ppat_loc; + Ast_501.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_501.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc : + Ast_500.Parsetree.pattern_desc -> Ast_501.Parsetree.pattern_desc = function + | Ast_500.Parsetree.Ppat_any -> Ast_501.Parsetree.Ppat_any + | Ast_500.Parsetree.Ppat_var x0 -> + Ast_501.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_500.Parsetree.Ppat_alias (x0, x1) -> + Ast_501.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_500.Parsetree.Ppat_constant x0 -> + Ast_501.Parsetree.Ppat_constant (copy_constant x0) + | Ast_500.Parsetree.Ppat_interval (x0, x1) -> + Ast_501.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1) + | Ast_500.Parsetree.Ppat_tuple x0 -> + Ast_501.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_500.Parsetree.Ppat_construct (x0, x1) -> + Ast_501.Parsetree.Ppat_construct + ( copy_loc copy_Longident_t x0, + Option.map + (fun x -> + let x0, x1 = x in + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_pattern x1)) + x1 ) + | Ast_500.Parsetree.Ppat_variant (x0, x1) -> + Ast_501.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_500.Parsetree.Ppat_record (x0, x1) -> + Ast_501.Parsetree.Ppat_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_500.Parsetree.Ppat_array x0 -> + Ast_501.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_500.Parsetree.Ppat_or (x0, x1) -> + Ast_501.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_500.Parsetree.Ppat_constraint (x0, x1) -> + Ast_501.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_500.Parsetree.Ppat_type x0 -> + Ast_501.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_500.Parsetree.Ppat_lazy x0 -> + Ast_501.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_500.Parsetree.Ppat_unpack x0 -> + Ast_501.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_500.Parsetree.Ppat_exception x0 -> + Ast_501.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_500.Parsetree.Ppat_extension x0 -> + Ast_501.Parsetree.Ppat_extension (copy_extension x0) + | Ast_500.Parsetree.Ppat_open (x0, x1) -> + Ast_501.Parsetree.Ppat_open (copy_loc copy_Longident_t x0, copy_pattern x1) + +and copy_core_type : Ast_500.Parsetree.core_type -> Ast_501.Parsetree.core_type + = + fun { + Ast_500.Parsetree.ptyp_desc; + Ast_500.Parsetree.ptyp_loc; + Ast_500.Parsetree.ptyp_loc_stack; + Ast_500.Parsetree.ptyp_attributes; + } -> + { + Ast_501.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_501.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_501.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_501.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_location_stack : + Ast_500.Parsetree.location_stack -> Ast_501.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_core_type_desc : + Ast_500.Parsetree.core_type_desc -> Ast_501.Parsetree.core_type_desc = + function + | Ast_500.Parsetree.Ptyp_any -> Ast_501.Parsetree.Ptyp_any + | Ast_500.Parsetree.Ptyp_var x0 -> Ast_501.Parsetree.Ptyp_var x0 + | Ast_500.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_501.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_500.Parsetree.Ptyp_tuple x0 -> + Ast_501.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_500.Parsetree.Ptyp_constr (x0, x1) -> + Ast_501.Parsetree.Ptyp_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_500.Parsetree.Ptyp_object (x0, x1) -> + Ast_501.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_500.Parsetree.Ptyp_class (x0, x1) -> + Ast_501.Parsetree.Ptyp_class + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_500.Parsetree.Ptyp_alias (x0, x1) -> + Ast_501.Parsetree.Ptyp_alias (copy_core_type x0, x1) + | Ast_500.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_501.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (fun x -> List.map copy_label x) x2 ) + | Ast_500.Parsetree.Ptyp_poly (x0, x1) -> + Ast_501.Parsetree.Ptyp_poly + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_core_type x1) + | Ast_500.Parsetree.Ptyp_package x0 -> + Ast_501.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_500.Parsetree.Ptyp_extension x0 -> + Ast_501.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_500.Parsetree.package_type -> Ast_501.Parsetree.package_type = + fun x -> + let x0, x1 = x in + ( copy_loc copy_Longident_t x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_core_type x1)) + x1 ) + +and copy_row_field : Ast_500.Parsetree.row_field -> Ast_501.Parsetree.row_field + = + fun { + Ast_500.Parsetree.prf_desc; + Ast_500.Parsetree.prf_loc; + Ast_500.Parsetree.prf_attributes; + } -> + { + Ast_501.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_501.Parsetree.prf_loc = copy_location prf_loc; + Ast_501.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_500.Parsetree.row_field_desc -> Ast_501.Parsetree.row_field_desc = + function + | Ast_500.Parsetree.Rtag (x0, x1, x2) -> + Ast_501.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_500.Parsetree.Rinherit x0 -> + Ast_501.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_500.Parsetree.object_field -> Ast_501.Parsetree.object_field = + fun { + Ast_500.Parsetree.pof_desc; + Ast_500.Parsetree.pof_loc; + Ast_500.Parsetree.pof_attributes; + } -> + { + Ast_501.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_501.Parsetree.pof_loc = copy_location pof_loc; + Ast_501.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_attributes : + Ast_500.Parsetree.attributes -> Ast_501.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : Ast_500.Parsetree.attribute -> Ast_501.Parsetree.attribute + = + fun { + Ast_500.Parsetree.attr_name; + Ast_500.Parsetree.attr_payload; + Ast_500.Parsetree.attr_loc; + } -> + { + Ast_501.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_501.Parsetree.attr_payload = copy_payload attr_payload; + Ast_501.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_payload : Ast_500.Parsetree.payload -> Ast_501.Parsetree.payload = + function + | Ast_500.Parsetree.PStr x0 -> Ast_501.Parsetree.PStr (copy_structure x0) + | Ast_500.Parsetree.PSig x0 -> Ast_501.Parsetree.PSig (copy_signature x0) + | Ast_500.Parsetree.PTyp x0 -> Ast_501.Parsetree.PTyp (copy_core_type x0) + | Ast_500.Parsetree.PPat (x0, x1) -> + Ast_501.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_structure : Ast_500.Parsetree.structure -> Ast_501.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_500.Parsetree.structure_item -> Ast_501.Parsetree.structure_item = + fun { Ast_500.Parsetree.pstr_desc; Ast_500.Parsetree.pstr_loc } -> + { + Ast_501.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_501.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_500.Parsetree.structure_item_desc -> + Ast_501.Parsetree.structure_item_desc = function + | Ast_500.Parsetree.Pstr_eval (x0, x1) -> + Ast_501.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_500.Parsetree.Pstr_value (x0, x1) -> + Ast_501.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_500.Parsetree.Pstr_primitive x0 -> + Ast_501.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_500.Parsetree.Pstr_type (x0, x1) -> + Ast_501.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_500.Parsetree.Pstr_typext x0 -> + Ast_501.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_500.Parsetree.Pstr_exception x0 -> + Ast_501.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_500.Parsetree.Pstr_module x0 -> + Ast_501.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_500.Parsetree.Pstr_recmodule x0 -> + Ast_501.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_500.Parsetree.Pstr_modtype x0 -> + Ast_501.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_500.Parsetree.Pstr_open x0 -> + Ast_501.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_500.Parsetree.Pstr_class x0 -> + Ast_501.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_500.Parsetree.Pstr_class_type x0 -> + Ast_501.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_500.Parsetree.Pstr_include x0 -> + Ast_501.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_500.Parsetree.Pstr_attribute x0 -> + Ast_501.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_500.Parsetree.Pstr_extension (x0, x1) -> + Ast_501.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_include_declaration : + Ast_500.Parsetree.include_declaration -> + Ast_501.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_class_declaration : + Ast_500.Parsetree.class_declaration -> Ast_501.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_class_expr : + Ast_500.Parsetree.class_expr -> Ast_501.Parsetree.class_expr = + fun { + Ast_500.Parsetree.pcl_desc; + Ast_500.Parsetree.pcl_loc; + Ast_500.Parsetree.pcl_attributes; + } -> + { + Ast_501.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_501.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_501.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_500.Parsetree.class_expr_desc -> Ast_501.Parsetree.class_expr_desc = + function + | Ast_500.Parsetree.Pcl_constr (x0, x1) -> + Ast_501.Parsetree.Pcl_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_500.Parsetree.Pcl_structure x0 -> + Ast_501.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_500.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_501.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_500.Parsetree.Pcl_apply (x0, x1) -> + Ast_501.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_500.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_501.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_500.Parsetree.Pcl_constraint (x0, x1) -> + Ast_501.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_500.Parsetree.Pcl_extension x0 -> + Ast_501.Parsetree.Pcl_extension (copy_extension x0) + | Ast_500.Parsetree.Pcl_open (x0, x1) -> + Ast_501.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_500.Parsetree.class_structure -> Ast_501.Parsetree.class_structure = + fun { Ast_500.Parsetree.pcstr_self; Ast_500.Parsetree.pcstr_fields } -> + { + Ast_501.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_501.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_500.Parsetree.class_field -> Ast_501.Parsetree.class_field = + fun { + Ast_500.Parsetree.pcf_desc; + Ast_500.Parsetree.pcf_loc; + Ast_500.Parsetree.pcf_attributes; + } -> + { + Ast_501.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_501.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_501.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_500.Parsetree.class_field_desc -> Ast_501.Parsetree.class_field_desc = + function + | Ast_500.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_501.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (fun x -> copy_loc (fun x -> x) x) x2 ) + | Ast_500.Parsetree.Pcf_val x0 -> + Ast_501.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_500.Parsetree.Pcf_method x0 -> + Ast_501.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_500.Parsetree.Pcf_constraint x0 -> + Ast_501.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_500.Parsetree.Pcf_initializer x0 -> + Ast_501.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_500.Parsetree.Pcf_attribute x0 -> + Ast_501.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_500.Parsetree.Pcf_extension x0 -> + Ast_501.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_500.Parsetree.class_field_kind -> Ast_501.Parsetree.class_field_kind = + function + | Ast_500.Parsetree.Cfk_virtual x0 -> + Ast_501.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_500.Parsetree.Cfk_concrete (x0, x1) -> + Ast_501.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_open_declaration : + Ast_500.Parsetree.open_declaration -> Ast_501.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_module_binding : + Ast_500.Parsetree.module_binding -> Ast_501.Parsetree.module_binding = + fun { + Ast_500.Parsetree.pmb_name; + Ast_500.Parsetree.pmb_expr; + Ast_500.Parsetree.pmb_attributes; + Ast_500.Parsetree.pmb_loc; + } -> + { + Ast_501.Parsetree.pmb_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name; + Ast_501.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_501.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_501.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_module_expr : + Ast_500.Parsetree.module_expr -> Ast_501.Parsetree.module_expr = + fun { + Ast_500.Parsetree.pmod_desc; + Ast_500.Parsetree.pmod_loc; + Ast_500.Parsetree.pmod_attributes; + } -> + { + Ast_501.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_501.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_501.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_500.Parsetree.module_expr_desc -> Ast_501.Parsetree.module_expr_desc = + function + | Ast_500.Parsetree.Pmod_ident x0 -> + Ast_501.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_500.Parsetree.Pmod_structure x0 -> + Ast_501.Parsetree.Pmod_structure (copy_structure x0) + | Ast_500.Parsetree.Pmod_functor (x0, x1) -> + Ast_501.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_500.Parsetree.Pmod_apply (x0, x1) -> + Ast_501.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_500.Parsetree.Pmod_constraint (x0, x1) -> + Ast_501.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_500.Parsetree.Pmod_unpack x0 -> + Ast_501.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_500.Parsetree.Pmod_extension x0 -> + Ast_501.Parsetree.Pmod_extension (copy_extension x0) + +and copy_functor_parameter : + Ast_500.Parsetree.functor_parameter -> Ast_501.Parsetree.functor_parameter = + function + | Ast_500.Parsetree.Unit -> Ast_501.Parsetree.Unit + | Ast_500.Parsetree.Named (x0, x1) -> + Ast_501.Parsetree.Named + (copy_loc (fun x -> Option.map (fun x -> x) x) x0, copy_module_type x1) + +and copy_module_type : + Ast_500.Parsetree.module_type -> Ast_501.Parsetree.module_type = + fun { + Ast_500.Parsetree.pmty_desc; + Ast_500.Parsetree.pmty_loc; + Ast_500.Parsetree.pmty_attributes; + } -> + { + Ast_501.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_501.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_501.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_500.Parsetree.module_type_desc -> Ast_501.Parsetree.module_type_desc = + function + | Ast_500.Parsetree.Pmty_ident x0 -> + Ast_501.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_500.Parsetree.Pmty_signature x0 -> + Ast_501.Parsetree.Pmty_signature (copy_signature x0) + | Ast_500.Parsetree.Pmty_functor (x0, x1) -> + Ast_501.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_500.Parsetree.Pmty_with (x0, x1) -> + Ast_501.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_500.Parsetree.Pmty_typeof x0 -> + Ast_501.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_500.Parsetree.Pmty_extension x0 -> + Ast_501.Parsetree.Pmty_extension (copy_extension x0) + | Ast_500.Parsetree.Pmty_alias x0 -> + Ast_501.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) + +and copy_with_constraint : + Ast_500.Parsetree.with_constraint -> Ast_501.Parsetree.with_constraint = + function + | Ast_500.Parsetree.Pwith_type (x0, x1) -> + Ast_501.Parsetree.Pwith_type + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_500.Parsetree.Pwith_module (x0, x1) -> + Ast_501.Parsetree.Pwith_module + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + | Ast_500.Parsetree.Pwith_modtype (x0, x1) -> + Ast_501.Parsetree.Pwith_modtype + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_500.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_501.Parsetree.Pwith_modtypesubst + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_500.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_501.Parsetree.Pwith_typesubst + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_500.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_501.Parsetree.Pwith_modsubst + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + +and copy_signature : Ast_500.Parsetree.signature -> Ast_501.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_500.Parsetree.signature_item -> Ast_501.Parsetree.signature_item = + fun { Ast_500.Parsetree.psig_desc; Ast_500.Parsetree.psig_loc } -> + { + Ast_501.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_501.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_500.Parsetree.signature_item_desc -> + Ast_501.Parsetree.signature_item_desc = function + | Ast_500.Parsetree.Psig_value x0 -> + Ast_501.Parsetree.Psig_value (copy_value_description x0) + | Ast_500.Parsetree.Psig_type (x0, x1) -> + Ast_501.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_500.Parsetree.Psig_typesubst x0 -> + Ast_501.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_500.Parsetree.Psig_typext x0 -> + Ast_501.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_500.Parsetree.Psig_exception x0 -> + Ast_501.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_500.Parsetree.Psig_module x0 -> + Ast_501.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_500.Parsetree.Psig_modsubst x0 -> + Ast_501.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_500.Parsetree.Psig_recmodule x0 -> + Ast_501.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_500.Parsetree.Psig_modtype x0 -> + Ast_501.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_500.Parsetree.Psig_modtypesubst x0 -> + Ast_501.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_500.Parsetree.Psig_open x0 -> + Ast_501.Parsetree.Psig_open (copy_open_description x0) + | Ast_500.Parsetree.Psig_include x0 -> + Ast_501.Parsetree.Psig_include (copy_include_description x0) + | Ast_500.Parsetree.Psig_class x0 -> + Ast_501.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_500.Parsetree.Psig_class_type x0 -> + Ast_501.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_500.Parsetree.Psig_attribute x0 -> + Ast_501.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_500.Parsetree.Psig_extension (x0, x1) -> + Ast_501.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_class_type_declaration : + Ast_500.Parsetree.class_type_declaration -> + Ast_501.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_description : + Ast_500.Parsetree.class_description -> Ast_501.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type : + Ast_500.Parsetree.class_type -> Ast_501.Parsetree.class_type = + fun { + Ast_500.Parsetree.pcty_desc; + Ast_500.Parsetree.pcty_loc; + Ast_500.Parsetree.pcty_attributes; + } -> + { + Ast_501.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_501.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_501.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_500.Parsetree.class_type_desc -> Ast_501.Parsetree.class_type_desc = + function + | Ast_500.Parsetree.Pcty_constr (x0, x1) -> + Ast_501.Parsetree.Pcty_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_500.Parsetree.Pcty_signature x0 -> + Ast_501.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_500.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_501.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_500.Parsetree.Pcty_extension x0 -> + Ast_501.Parsetree.Pcty_extension (copy_extension x0) + | Ast_500.Parsetree.Pcty_open (x0, x1) -> + Ast_501.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_500.Parsetree.class_signature -> Ast_501.Parsetree.class_signature = + fun { Ast_500.Parsetree.pcsig_self; Ast_500.Parsetree.pcsig_fields } -> + { + Ast_501.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_501.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_500.Parsetree.class_type_field -> Ast_501.Parsetree.class_type_field = + fun { + Ast_500.Parsetree.pctf_desc; + Ast_500.Parsetree.pctf_loc; + Ast_500.Parsetree.pctf_attributes; + } -> + { + Ast_501.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_501.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_501.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_500.Parsetree.class_type_field_desc -> + Ast_501.Parsetree.class_type_field_desc = function + | Ast_500.Parsetree.Pctf_inherit x0 -> + Ast_501.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_500.Parsetree.Pctf_val x0 -> + Ast_501.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_500.Parsetree.Pctf_method x0 -> + Ast_501.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_500.Parsetree.Pctf_constraint x0 -> + Ast_501.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_500.Parsetree.Pctf_attribute x0 -> + Ast_501.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_500.Parsetree.Pctf_extension x0 -> + Ast_501.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : Ast_500.Parsetree.extension -> Ast_501.Parsetree.extension + = + fun x -> + let x0, x1 = x in + (copy_loc (fun x -> x) x0, copy_payload x1) + +and copy_class_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_500.Parsetree.class_infos -> + 'g0 Ast_501.Parsetree.class_infos = + fun f0 + { + Ast_500.Parsetree.pci_virt; + Ast_500.Parsetree.pci_params; + Ast_500.Parsetree.pci_name; + Ast_500.Parsetree.pci_expr; + Ast_500.Parsetree.pci_loc; + Ast_500.Parsetree.pci_attributes; + } -> + { + Ast_501.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_501.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_501.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_501.Parsetree.pci_expr = f0 pci_expr; + Ast_501.Parsetree.pci_loc = copy_location pci_loc; + Ast_501.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_virtual_flag : + Ast_500.Asttypes.virtual_flag -> Ast_501.Asttypes.virtual_flag = function + | Ast_500.Asttypes.Virtual -> Ast_501.Asttypes.Virtual + | Ast_500.Asttypes.Concrete -> Ast_501.Asttypes.Concrete + +and copy_include_description : + Ast_500.Parsetree.include_description -> + Ast_501.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_500.Parsetree.include_infos -> + 'g0 Ast_501.Parsetree.include_infos = + fun f0 + { + Ast_500.Parsetree.pincl_mod; + Ast_500.Parsetree.pincl_loc; + Ast_500.Parsetree.pincl_attributes; + } -> + { + Ast_501.Parsetree.pincl_mod = f0 pincl_mod; + Ast_501.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_501.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_open_description : + Ast_500.Parsetree.open_description -> Ast_501.Parsetree.open_description = + fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x + +and copy_open_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_500.Parsetree.open_infos -> + 'g0 Ast_501.Parsetree.open_infos = + fun f0 + { + Ast_500.Parsetree.popen_expr; + Ast_500.Parsetree.popen_override; + Ast_500.Parsetree.popen_loc; + Ast_500.Parsetree.popen_attributes; + } -> + { + Ast_501.Parsetree.popen_expr = f0 popen_expr; + Ast_501.Parsetree.popen_override = copy_override_flag popen_override; + Ast_501.Parsetree.popen_loc = copy_location popen_loc; + Ast_501.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_override_flag : + Ast_500.Asttypes.override_flag -> Ast_501.Asttypes.override_flag = function + | Ast_500.Asttypes.Override -> Ast_501.Asttypes.Override + | Ast_500.Asttypes.Fresh -> Ast_501.Asttypes.Fresh + +and copy_module_type_declaration : + Ast_500.Parsetree.module_type_declaration -> + Ast_501.Parsetree.module_type_declaration = + fun { + Ast_500.Parsetree.pmtd_name; + Ast_500.Parsetree.pmtd_type; + Ast_500.Parsetree.pmtd_attributes; + Ast_500.Parsetree.pmtd_loc; + } -> + { + Ast_501.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_501.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_501.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_501.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_module_substitution : + Ast_500.Parsetree.module_substitution -> + Ast_501.Parsetree.module_substitution = + fun { + Ast_500.Parsetree.pms_name; + Ast_500.Parsetree.pms_manifest; + Ast_500.Parsetree.pms_attributes; + Ast_500.Parsetree.pms_loc; + } -> + { + Ast_501.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_501.Parsetree.pms_manifest = copy_loc copy_Longident_t pms_manifest; + Ast_501.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_501.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_declaration : + Ast_500.Parsetree.module_declaration -> Ast_501.Parsetree.module_declaration + = + fun { + Ast_500.Parsetree.pmd_name; + Ast_500.Parsetree.pmd_type; + Ast_500.Parsetree.pmd_attributes; + Ast_500.Parsetree.pmd_loc; + } -> + { + Ast_501.Parsetree.pmd_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name; + Ast_501.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_501.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_501.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_type_exception : + Ast_500.Parsetree.type_exception -> Ast_501.Parsetree.type_exception = + fun { + Ast_500.Parsetree.ptyexn_constructor; + Ast_500.Parsetree.ptyexn_loc; + Ast_500.Parsetree.ptyexn_attributes; + } -> + { + Ast_501.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_501.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_501.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_type_extension : + Ast_500.Parsetree.type_extension -> Ast_501.Parsetree.type_extension = + fun { + Ast_500.Parsetree.ptyext_path; + Ast_500.Parsetree.ptyext_params; + Ast_500.Parsetree.ptyext_constructors; + Ast_500.Parsetree.ptyext_private; + Ast_500.Parsetree.ptyext_loc; + Ast_500.Parsetree.ptyext_attributes; + } -> + { + Ast_501.Parsetree.ptyext_path = copy_loc copy_Longident_t ptyext_path; + Ast_501.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_501.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_501.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_501.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_501.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_500.Parsetree.extension_constructor -> + Ast_501.Parsetree.extension_constructor = + fun { + Ast_500.Parsetree.pext_name; + Ast_500.Parsetree.pext_kind; + Ast_500.Parsetree.pext_loc; + Ast_500.Parsetree.pext_attributes; + } -> + { + Ast_501.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_501.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_501.Parsetree.pext_loc = copy_location pext_loc; + Ast_501.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_extension_constructor_kind : + Ast_500.Parsetree.extension_constructor_kind -> + Ast_501.Parsetree.extension_constructor_kind = function + | Ast_500.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_501.Parsetree.Pext_decl + ( List.map (fun x -> copy_loc (fun x -> x) x) x0, + copy_constructor_arguments x1, + Option.map copy_core_type x2 ) + | Ast_500.Parsetree.Pext_rebind x0 -> + Ast_501.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) + +and copy_type_declaration : + Ast_500.Parsetree.type_declaration -> Ast_501.Parsetree.type_declaration = + fun { + Ast_500.Parsetree.ptype_name; + Ast_500.Parsetree.ptype_params; + Ast_500.Parsetree.ptype_cstrs; + Ast_500.Parsetree.ptype_kind; + Ast_500.Parsetree.ptype_private; + Ast_500.Parsetree.ptype_manifest; + Ast_500.Parsetree.ptype_attributes; + Ast_500.Parsetree.ptype_loc; + } -> + { + Ast_501.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_501.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_501.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_cstrs; + Ast_501.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_501.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_501.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_501.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_501.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_private_flag : + Ast_500.Asttypes.private_flag -> Ast_501.Asttypes.private_flag = function + | Ast_500.Asttypes.Private -> Ast_501.Asttypes.Private + | Ast_500.Asttypes.Public -> Ast_501.Asttypes.Public + +and copy_type_kind : Ast_500.Parsetree.type_kind -> Ast_501.Parsetree.type_kind + = function + | Ast_500.Parsetree.Ptype_abstract -> Ast_501.Parsetree.Ptype_abstract + | Ast_500.Parsetree.Ptype_variant x0 -> + Ast_501.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_500.Parsetree.Ptype_record x0 -> + Ast_501.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_500.Parsetree.Ptype_open -> Ast_501.Parsetree.Ptype_open + +and copy_constructor_declaration : + Ast_500.Parsetree.constructor_declaration -> + Ast_501.Parsetree.constructor_declaration = + fun { + Ast_500.Parsetree.pcd_name; + Ast_500.Parsetree.pcd_vars; + Ast_500.Parsetree.pcd_args; + Ast_500.Parsetree.pcd_res; + Ast_500.Parsetree.pcd_loc; + Ast_500.Parsetree.pcd_attributes; + } -> + { + Ast_501.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_501.Parsetree.pcd_vars = + List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars; + Ast_501.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_501.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_501.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_501.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_500.Parsetree.constructor_arguments -> + Ast_501.Parsetree.constructor_arguments = function + | Ast_500.Parsetree.Pcstr_tuple x0 -> + Ast_501.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_500.Parsetree.Pcstr_record x0 -> + Ast_501.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_label_declaration : + Ast_500.Parsetree.label_declaration -> Ast_501.Parsetree.label_declaration = + fun { + Ast_500.Parsetree.pld_name; + Ast_500.Parsetree.pld_mutable; + Ast_500.Parsetree.pld_type; + Ast_500.Parsetree.pld_loc; + Ast_500.Parsetree.pld_attributes; + } -> + { + Ast_501.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_501.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_501.Parsetree.pld_type = copy_core_type pld_type; + Ast_501.Parsetree.pld_loc = copy_location pld_loc; + Ast_501.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_mutable_flag : + Ast_500.Asttypes.mutable_flag -> Ast_501.Asttypes.mutable_flag = function + | Ast_500.Asttypes.Immutable -> Ast_501.Asttypes.Immutable + | Ast_500.Asttypes.Mutable -> Ast_501.Asttypes.Mutable + +and copy_injectivity : + Ast_500.Asttypes.injectivity -> Ast_501.Asttypes.injectivity = function + | Ast_500.Asttypes.Injective -> Ast_501.Asttypes.Injective + | Ast_500.Asttypes.NoInjectivity -> Ast_501.Asttypes.NoInjectivity + +and copy_variance : Ast_500.Asttypes.variance -> Ast_501.Asttypes.variance = + function + | Ast_500.Asttypes.Covariant -> Ast_501.Asttypes.Covariant + | Ast_500.Asttypes.Contravariant -> Ast_501.Asttypes.Contravariant + | Ast_500.Asttypes.NoVariance -> Ast_501.Asttypes.NoVariance + +and copy_value_description : + Ast_500.Parsetree.value_description -> Ast_501.Parsetree.value_description = + fun { + Ast_500.Parsetree.pval_name; + Ast_500.Parsetree.pval_type; + Ast_500.Parsetree.pval_prim; + Ast_500.Parsetree.pval_attributes; + Ast_500.Parsetree.pval_loc; + } -> + { + Ast_501.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_501.Parsetree.pval_type = copy_core_type pval_type; + Ast_501.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_501.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_501.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_object_field_desc : + Ast_500.Parsetree.object_field_desc -> Ast_501.Parsetree.object_field_desc = + function + | Ast_500.Parsetree.Otag (x0, x1) -> + Ast_501.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_500.Parsetree.Oinherit x0 -> + Ast_501.Parsetree.Oinherit (copy_core_type x0) + +and copy_arg_label : Ast_500.Asttypes.arg_label -> Ast_501.Asttypes.arg_label = + function + | Ast_500.Asttypes.Nolabel -> Ast_501.Asttypes.Nolabel + | Ast_500.Asttypes.Labelled x0 -> Ast_501.Asttypes.Labelled x0 + | Ast_500.Asttypes.Optional x0 -> Ast_501.Asttypes.Optional x0 + +and copy_closed_flag : + Ast_500.Asttypes.closed_flag -> Ast_501.Asttypes.closed_flag = function + | Ast_500.Asttypes.Closed -> Ast_501.Asttypes.Closed + | Ast_500.Asttypes.Open -> Ast_501.Asttypes.Open + +and copy_label : Ast_500.Asttypes.label -> Ast_501.Asttypes.label = fun x -> x + +and copy_rec_flag : Ast_500.Asttypes.rec_flag -> Ast_501.Asttypes.rec_flag = + function + | Ast_500.Asttypes.Nonrecursive -> Ast_501.Asttypes.Nonrecursive + | Ast_500.Asttypes.Recursive -> Ast_501.Asttypes.Recursive + +and copy_constant : Ast_500.Parsetree.constant -> Ast_501.Parsetree.constant = + function + | Ast_500.Parsetree.Pconst_integer (x0, x1) -> + Ast_501.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_500.Parsetree.Pconst_char x0 -> Ast_501.Parsetree.Pconst_char x0 + | Ast_500.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_501.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_500.Parsetree.Pconst_float (x0, x1) -> + Ast_501.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + +and copy_Longident_t : Longident.t -> Longident.t = function + | Longident.Lident x0 -> Longident.Lident x0 + | Longident.Ldot (x0, x1) -> Longident.Ldot (copy_Longident_t x0, x1) + | Longident.Lapply (x0, x1) -> + Longident.Lapply (copy_Longident_t x0, copy_Longident_t x1) + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_500.Asttypes.loc -> 'g0 Ast_501.Asttypes.loc = + fun f0 { Ast_500.Asttypes.txt; Ast_500.Asttypes.loc } -> + { Ast_501.Asttypes.txt = f0 txt; Ast_501.Asttypes.loc = copy_location loc } + +and copy_location : Location.t -> Location.t = + fun { Location.loc_start; Location.loc_end; Location.loc_ghost } -> + { + Location.loc_start = copy_position loc_start; + Location.loc_end = copy_position loc_end; + Location.loc_ghost; + } + +and copy_position : Lexing.position -> Lexing.position = + fun { Lexing.pos_fname; Lexing.pos_lnum; Lexing.pos_bol; Lexing.pos_cnum } -> + { Lexing.pos_fname; Lexing.pos_lnum; Lexing.pos_bol; Lexing.pos_cnum } diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml new file mode 100644 index 000000000..ac53b3203 --- /dev/null +++ b/astlib/migrate_501_500.ml @@ -0,0 +1,1404 @@ +open Stdlib0 +module From = Ast_501 +module To = Ast_500 + +let rec copy_toplevel_phrase : + Ast_501.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase = + function + | Ast_501.Parsetree.Ptop_def x0 -> + Ast_500.Parsetree.Ptop_def (copy_structure x0) + | Ast_501.Parsetree.Ptop_dir x0 -> + Ast_500.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_501.Parsetree.toplevel_directive -> Ast_500.Parsetree.toplevel_directive + = + fun { + Ast_501.Parsetree.pdir_name; + Ast_501.Parsetree.pdir_arg; + Ast_501.Parsetree.pdir_loc; + } -> + { + Ast_500.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_500.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_500.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_501.Parsetree.directive_argument -> Ast_500.Parsetree.directive_argument + = + fun { Ast_501.Parsetree.pdira_desc; Ast_501.Parsetree.pdira_loc } -> + { + Ast_500.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_500.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_501.Parsetree.directive_argument_desc -> + Ast_500.Parsetree.directive_argument_desc = function + | Ast_501.Parsetree.Pdir_string x0 -> Ast_500.Parsetree.Pdir_string x0 + | Ast_501.Parsetree.Pdir_int (x0, x1) -> + Ast_500.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_501.Parsetree.Pdir_ident x0 -> + Ast_500.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_501.Parsetree.Pdir_bool x0 -> Ast_500.Parsetree.Pdir_bool x0 + +and copy_expression : + Ast_501.Parsetree.expression -> Ast_500.Parsetree.expression = + fun { + Ast_501.Parsetree.pexp_desc; + Ast_501.Parsetree.pexp_loc; + Ast_501.Parsetree.pexp_loc_stack; + Ast_501.Parsetree.pexp_attributes; + } -> + { + Ast_500.Parsetree.pexp_desc = copy_expression_desc pexp_desc; + Ast_500.Parsetree.pexp_loc = copy_location pexp_loc; + Ast_500.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_500.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_501.Parsetree.expression_desc -> Ast_500.Parsetree.expression_desc = + function + | Ast_501.Parsetree.Pexp_ident x0 -> + Ast_500.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_501.Parsetree.Pexp_constant x0 -> + Ast_500.Parsetree.Pexp_constant (copy_constant x0) + | Ast_501.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_500.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_501.Parsetree.Pexp_function x0 -> + Ast_500.Parsetree.Pexp_function (List.map copy_case x0) + | Ast_501.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_500.Parsetree.Pexp_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_expression x3 ) + | Ast_501.Parsetree.Pexp_apply (x0, x1) -> + Ast_500.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_501.Parsetree.Pexp_match (x0, x1) -> + Ast_500.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_501.Parsetree.Pexp_try (x0, x1) -> + Ast_500.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_501.Parsetree.Pexp_tuple x0 -> + Ast_500.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_501.Parsetree.Pexp_construct (x0, x1) -> + Ast_500.Parsetree.Pexp_construct + (copy_loc copy_Longident_t x0, Option.map copy_expression x1) + | Ast_501.Parsetree.Pexp_variant (x0, x1) -> + Ast_500.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_501.Parsetree.Pexp_record (x0, x1) -> + Ast_500.Parsetree.Pexp_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_expression x1)) + x0, + Option.map copy_expression x1 ) + | Ast_501.Parsetree.Pexp_field (x0, x1) -> + Ast_500.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_Longident_t x1) + | Ast_501.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_500.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_Longident_t x1, copy_expression x2) + | Ast_501.Parsetree.Pexp_array x0 -> + Ast_500.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_501.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_500.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_501.Parsetree.Pexp_sequence (x0, x1) -> + Ast_500.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_while (x0, x1) -> + Ast_500.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_500.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_501.Parsetree.Pexp_constraint (x0, x1) -> + Ast_500.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_501.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_500.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_501.Parsetree.Pexp_send (x0, x1) -> + Ast_500.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_501.Parsetree.Pexp_new x0 -> + Ast_500.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_501.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_500.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_override x0 -> + Ast_500.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_501.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_500.Parsetree.Pexp_letmodule + ( copy_loc (fun x -> Option.map (fun x -> x) x) x0, + copy_module_expr x1, + copy_expression x2 ) + | Ast_501.Parsetree.Pexp_letexception (x0, x1) -> + Ast_500.Parsetree.Pexp_letexception + (copy_extension_constructor x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_assert x0 -> + Ast_500.Parsetree.Pexp_assert (copy_expression x0) + | Ast_501.Parsetree.Pexp_lazy x0 -> + Ast_500.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_501.Parsetree.Pexp_poly (x0, x1) -> + Ast_500.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_501.Parsetree.Pexp_object x0 -> + Ast_500.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_501.Parsetree.Pexp_newtype (x0, x1) -> + Ast_500.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_pack x0 -> + Ast_500.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_501.Parsetree.Pexp_open (x0, x1) -> + Ast_500.Parsetree.Pexp_open (copy_open_declaration x0, copy_expression x1) + | Ast_501.Parsetree.Pexp_letop x0 -> + Ast_500.Parsetree.Pexp_letop (copy_letop x0) + | Ast_501.Parsetree.Pexp_extension x0 -> + Ast_500.Parsetree.Pexp_extension (copy_extension x0) + | Ast_501.Parsetree.Pexp_unreachable -> Ast_500.Parsetree.Pexp_unreachable + +and copy_letop : Ast_501.Parsetree.letop -> Ast_500.Parsetree.letop = + fun { Ast_501.Parsetree.let_; Ast_501.Parsetree.ands; Ast_501.Parsetree.body } -> + { + Ast_500.Parsetree.let_ = copy_binding_op let_; + Ast_500.Parsetree.ands = List.map copy_binding_op ands; + Ast_500.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_501.Parsetree.binding_op -> Ast_500.Parsetree.binding_op = + fun { + Ast_501.Parsetree.pbop_op; + Ast_501.Parsetree.pbop_pat; + Ast_501.Parsetree.pbop_exp; + Ast_501.Parsetree.pbop_loc; + } -> + { + Ast_500.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_500.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_500.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_500.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_direction_flag : + Ast_501.Asttypes.direction_flag -> Ast_500.Asttypes.direction_flag = + function + | Ast_501.Asttypes.Upto -> Ast_500.Asttypes.Upto + | Ast_501.Asttypes.Downto -> Ast_500.Asttypes.Downto + +and copy_case : Ast_501.Parsetree.case -> Ast_500.Parsetree.case = + fun { + Ast_501.Parsetree.pc_lhs; + Ast_501.Parsetree.pc_guard; + Ast_501.Parsetree.pc_rhs; + } -> + { + Ast_500.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_500.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_500.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_value_binding : + Ast_501.Parsetree.value_binding -> Ast_500.Parsetree.value_binding = + fun { + Ast_501.Parsetree.pvb_pat; + Ast_501.Parsetree.pvb_expr; + Ast_501.Parsetree.pvb_constraint; + Ast_501.Parsetree.pvb_attributes; + Ast_501.Parsetree.pvb_loc; + } -> + let merge_loc left right = + Location. + { loc_start = left.loc_start; loc_end = right.loc_end; loc_ghost = false } + in + let ghost_loc loc = { loc with Location.loc_ghost = true } in + let ghost_constraint pat typ = + let ppat_loc = + ghost_loc + (merge_loc pat.Ast_500.Parsetree.ppat_loc typ.Ast_500.Parsetree.ptyp_loc) + in + { + Ast_500.Parsetree.ppat_attributes = []; + ppat_loc; + ppat_desc = Ast_500.Parsetree.Ppat_constraint (pat, typ); + ppat_loc_stack = []; + } + in + let pvb_pat = copy_pattern pvb_pat and pvb_expr = copy_expression pvb_expr in + let constrain_pat pat typ expr = + let typ = copy_core_type typ in + let pvb_pat = ghost_constraint pat typ in + (pvb_pat, pvb_expr) + in + let pvb_pat, pvb_expr = + match (pvb_constraint, pvb_pat) with + | ( Some + (Pvc_constraint + { + locally_abstract_univars = []; + typ = { ptyp_desc = Ptyp_poly _; _ } as typ; + }), + { Ast_500.Parsetree.ppat_desc = Ppat_var _; ppat_attributes = [] } ) -> + (* the sugaring of [let x: univars . typ = exp ] was desugared to + [let (x:univars . typ) = exp] in 5.0 which doesn't fit the case below *) + constrain_pat pvb_pat typ pvb_expr + | ( Some (Pvc_constraint { locally_abstract_univars; typ }), + { Ast_500.Parsetree.ppat_desc = Ppat_var _; ppat_attributes = [] } ) -> + (* Copied and adapted from OCaml 5.0 Ast_helper *) + let varify_constructors var_names t = + let var_names = List.map (fun v -> v.Location.txt) var_names in + let rec loop t = + let desc = + match t.Ast_500.Parsetree.ptyp_desc with + | Ast_500.Parsetree.Ptyp_any -> Ast_500.Parsetree.Ptyp_any + | Ptyp_var x -> Ptyp_var x + | Ptyp_arrow (label, core_type, core_type') -> + Ptyp_arrow (label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr ({ txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr (longident, lst) -> + Ptyp_constr (longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias (core_type, string) -> + Ptyp_alias (loop core_type, string) + | Ptyp_variant (row_field_list, flag, lbl_lst_option) -> + Ptyp_variant + ( List.map loop_row_field row_field_list, + flag, + lbl_lst_option ) + | Ptyp_poly (string_lst, core_type) -> + Ptyp_poly (string_lst, loop core_type) + | Ptyp_package (longident, lst) -> + Ptyp_package + (longident, List.map (fun (n, typ) -> (n, loop typ)) lst) + | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) + in + { t with ptyp_desc = desc } + and loop_row_field field = + let prf_desc = + match field.prf_desc with + | Ast_500.Parsetree.Rtag (label, flag, lst) -> + Ast_500.Parsetree.Rtag (label, flag, List.map loop lst) + | Rinherit t -> Rinherit (loop t) + in + { field with prf_desc } + and loop_object_field field = + let pof_desc = + match field.pof_desc with + | Ast_500.Parsetree.Otag (label, t) -> + Ast_500.Parsetree.Otag (label, loop t) + | Oinherit t -> Oinherit (loop t) + in + { field with pof_desc } + in + loop t + in + let typ = copy_core_type typ in + let pexp_loc = merge_loc pvb_pat.ppat_loc pvb_expr.pexp_loc in + let ptyp_loc = + match locally_abstract_univars with + | [] -> ghost_loc typ.ptyp_loc + | _ :: _ -> ghost_loc pexp_loc + in + let typ_poly = + { + typ with + ptyp_loc; + ptyp_attributes = []; + ptyp_desc = + Ast_500.Parsetree.Ptyp_poly + ( locally_abstract_univars, + varify_constructors locally_abstract_univars typ ); + } + in + + let ppat_loc = + ghost_loc + (merge_loc pvb_pat.Ast_500.Parsetree.ppat_loc + typ.Ast_500.Parsetree.ptyp_loc) + in + let pvb_pat = { (ghost_constraint pvb_pat typ_poly) with ppat_loc } + and pvb_expr = + List.fold_left + (fun expr var -> + { + expr with + pexp_attributes = []; + pexp_loc; + Ast_500.Parsetree.pexp_desc = + Ast_500.Parsetree.Pexp_newtype (var, expr); + }) + { + pvb_expr with + pexp_attributes = []; + pexp_loc; + pexp_desc = Pexp_constraint (pvb_expr, typ); + } + (List.rev locally_abstract_univars) + in + (pvb_pat, pvb_expr) + | Some (Pvc_constraint { locally_abstract_univars = []; typ }), _ -> + constrain_pat pvb_pat typ pvb_expr + | Some (Pvc_coercion { ground; coercion }), _ -> + let coercion = copy_core_type coercion in + let ptyp_loc = ghost_loc coercion.ptyp_loc in + let typ = + { + coercion with + ptyp_attributes = []; + ptyp_loc; + ptyp_desc = Ast_500.Parsetree.Ptyp_poly ([], coercion); + } + in + let pvb_pat = ghost_constraint pvb_pat typ in + let ground = Option.map copy_core_type ground in + let pexp_loc = merge_loc pvb_pat.ppat_loc pvb_expr.pexp_loc in + let pvb_expr = + { + pvb_expr with + pexp_attributes = []; + pexp_loc; + pexp_desc = + Ast_500.Parsetree.Pexp_coerce (pvb_expr, ground, coercion); + } + in + (pvb_pat, pvb_expr) + | _ -> (pvb_pat, pvb_expr) + in + { + Ast_500.Parsetree.pvb_pat; + Ast_500.Parsetree.pvb_expr; + Ast_500.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_500.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_pattern : Ast_501.Parsetree.pattern -> Ast_500.Parsetree.pattern = + fun { + Ast_501.Parsetree.ppat_desc; + Ast_501.Parsetree.ppat_loc; + Ast_501.Parsetree.ppat_loc_stack; + Ast_501.Parsetree.ppat_attributes; + } -> + { + Ast_500.Parsetree.ppat_desc = copy_pattern_desc ppat_desc; + Ast_500.Parsetree.ppat_loc = copy_location ppat_loc; + Ast_500.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_500.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc : + Ast_501.Parsetree.pattern_desc -> Ast_500.Parsetree.pattern_desc = function + | Ast_501.Parsetree.Ppat_any -> Ast_500.Parsetree.Ppat_any + | Ast_501.Parsetree.Ppat_var x0 -> + Ast_500.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_501.Parsetree.Ppat_alias (x0, x1) -> + Ast_500.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_501.Parsetree.Ppat_constant x0 -> + Ast_500.Parsetree.Ppat_constant (copy_constant x0) + | Ast_501.Parsetree.Ppat_interval (x0, x1) -> + Ast_500.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1) + | Ast_501.Parsetree.Ppat_tuple x0 -> + Ast_500.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_501.Parsetree.Ppat_construct (x0, x1) -> + Ast_500.Parsetree.Ppat_construct + ( copy_loc copy_Longident_t x0, + Option.map + (fun x -> + let x0, x1 = x in + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_pattern x1)) + x1 ) + | Ast_501.Parsetree.Ppat_variant (x0, x1) -> + Ast_500.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_501.Parsetree.Ppat_record (x0, x1) -> + Ast_500.Parsetree.Ppat_record + ( List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_pattern x1)) + x0, + copy_closed_flag x1 ) + | Ast_501.Parsetree.Ppat_array x0 -> + Ast_500.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_501.Parsetree.Ppat_or (x0, x1) -> + Ast_500.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_501.Parsetree.Ppat_constraint (x0, x1) -> + Ast_500.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_501.Parsetree.Ppat_type x0 -> + Ast_500.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_501.Parsetree.Ppat_lazy x0 -> + Ast_500.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_501.Parsetree.Ppat_unpack x0 -> + Ast_500.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_501.Parsetree.Ppat_exception x0 -> + Ast_500.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_501.Parsetree.Ppat_extension x0 -> + Ast_500.Parsetree.Ppat_extension (copy_extension x0) + | Ast_501.Parsetree.Ppat_open (x0, x1) -> + Ast_500.Parsetree.Ppat_open (copy_loc copy_Longident_t x0, copy_pattern x1) + +and copy_core_type : Ast_501.Parsetree.core_type -> Ast_500.Parsetree.core_type + = + fun { + Ast_501.Parsetree.ptyp_desc; + Ast_501.Parsetree.ptyp_loc; + Ast_501.Parsetree.ptyp_loc_stack; + Ast_501.Parsetree.ptyp_attributes; + } -> + { + Ast_500.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_500.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_500.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_500.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_location_stack : + Ast_501.Parsetree.location_stack -> Ast_500.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_core_type_desc : + Ast_501.Parsetree.core_type_desc -> Ast_500.Parsetree.core_type_desc = + function + | Ast_501.Parsetree.Ptyp_any -> Ast_500.Parsetree.Ptyp_any + | Ast_501.Parsetree.Ptyp_var x0 -> Ast_500.Parsetree.Ptyp_var x0 + | Ast_501.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_500.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_501.Parsetree.Ptyp_tuple x0 -> + Ast_500.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_501.Parsetree.Ptyp_constr (x0, x1) -> + Ast_500.Parsetree.Ptyp_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_501.Parsetree.Ptyp_object (x0, x1) -> + Ast_500.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_501.Parsetree.Ptyp_class (x0, x1) -> + Ast_500.Parsetree.Ptyp_class + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_501.Parsetree.Ptyp_alias (x0, x1) -> + Ast_500.Parsetree.Ptyp_alias (copy_core_type x0, x1) + | Ast_501.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_500.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (fun x -> List.map copy_label x) x2 ) + | Ast_501.Parsetree.Ptyp_poly (x0, x1) -> + Ast_500.Parsetree.Ptyp_poly + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_core_type x1) + | Ast_501.Parsetree.Ptyp_package x0 -> + Ast_500.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_501.Parsetree.Ptyp_extension x0 -> + Ast_500.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_501.Parsetree.package_type -> Ast_500.Parsetree.package_type = + fun x -> + let x0, x1 = x in + ( copy_loc copy_Longident_t x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_core_type x1)) + x1 ) + +and copy_row_field : Ast_501.Parsetree.row_field -> Ast_500.Parsetree.row_field + = + fun { + Ast_501.Parsetree.prf_desc; + Ast_501.Parsetree.prf_loc; + Ast_501.Parsetree.prf_attributes; + } -> + { + Ast_500.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_500.Parsetree.prf_loc = copy_location prf_loc; + Ast_500.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_501.Parsetree.row_field_desc -> Ast_500.Parsetree.row_field_desc = + function + | Ast_501.Parsetree.Rtag (x0, x1, x2) -> + Ast_500.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_501.Parsetree.Rinherit x0 -> + Ast_500.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_501.Parsetree.object_field -> Ast_500.Parsetree.object_field = + fun { + Ast_501.Parsetree.pof_desc; + Ast_501.Parsetree.pof_loc; + Ast_501.Parsetree.pof_attributes; + } -> + { + Ast_500.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_500.Parsetree.pof_loc = copy_location pof_loc; + Ast_500.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_attributes : + Ast_501.Parsetree.attributes -> Ast_500.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : Ast_501.Parsetree.attribute -> Ast_500.Parsetree.attribute + = + fun { + Ast_501.Parsetree.attr_name; + Ast_501.Parsetree.attr_payload; + Ast_501.Parsetree.attr_loc; + } -> + { + Ast_500.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_500.Parsetree.attr_payload = copy_payload attr_payload; + Ast_500.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_payload : Ast_501.Parsetree.payload -> Ast_500.Parsetree.payload = + function + | Ast_501.Parsetree.PStr x0 -> Ast_500.Parsetree.PStr (copy_structure x0) + | Ast_501.Parsetree.PSig x0 -> Ast_500.Parsetree.PSig (copy_signature x0) + | Ast_501.Parsetree.PTyp x0 -> Ast_500.Parsetree.PTyp (copy_core_type x0) + | Ast_501.Parsetree.PPat (x0, x1) -> + Ast_500.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_structure : Ast_501.Parsetree.structure -> Ast_500.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_501.Parsetree.structure_item -> Ast_500.Parsetree.structure_item = + fun { Ast_501.Parsetree.pstr_desc; Ast_501.Parsetree.pstr_loc } -> + { + Ast_500.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_500.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_501.Parsetree.structure_item_desc -> + Ast_500.Parsetree.structure_item_desc = function + | Ast_501.Parsetree.Pstr_eval (x0, x1) -> + Ast_500.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_501.Parsetree.Pstr_value (x0, x1) -> + Ast_500.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_501.Parsetree.Pstr_primitive x0 -> + Ast_500.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_501.Parsetree.Pstr_type (x0, x1) -> + Ast_500.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_501.Parsetree.Pstr_typext x0 -> + Ast_500.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_501.Parsetree.Pstr_exception x0 -> + Ast_500.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_501.Parsetree.Pstr_module x0 -> + Ast_500.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_501.Parsetree.Pstr_recmodule x0 -> + Ast_500.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_501.Parsetree.Pstr_modtype x0 -> + Ast_500.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_501.Parsetree.Pstr_open x0 -> + Ast_500.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_501.Parsetree.Pstr_class x0 -> + Ast_500.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_501.Parsetree.Pstr_class_type x0 -> + Ast_500.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_501.Parsetree.Pstr_include x0 -> + Ast_500.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_501.Parsetree.Pstr_attribute x0 -> + Ast_500.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_501.Parsetree.Pstr_extension (x0, x1) -> + Ast_500.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_include_declaration : + Ast_501.Parsetree.include_declaration -> + Ast_500.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_class_declaration : + Ast_501.Parsetree.class_declaration -> Ast_500.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_class_expr : + Ast_501.Parsetree.class_expr -> Ast_500.Parsetree.class_expr = + fun { + Ast_501.Parsetree.pcl_desc; + Ast_501.Parsetree.pcl_loc; + Ast_501.Parsetree.pcl_attributes; + } -> + { + Ast_500.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_500.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_500.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_501.Parsetree.class_expr_desc -> Ast_500.Parsetree.class_expr_desc = + function + | Ast_501.Parsetree.Pcl_constr (x0, x1) -> + Ast_500.Parsetree.Pcl_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_501.Parsetree.Pcl_structure x0 -> + Ast_500.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_501.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_500.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_501.Parsetree.Pcl_apply (x0, x1) -> + Ast_500.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_501.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_500.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_501.Parsetree.Pcl_constraint (x0, x1) -> + Ast_500.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_501.Parsetree.Pcl_extension x0 -> + Ast_500.Parsetree.Pcl_extension (copy_extension x0) + | Ast_501.Parsetree.Pcl_open (x0, x1) -> + Ast_500.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_501.Parsetree.class_structure -> Ast_500.Parsetree.class_structure = + fun { Ast_501.Parsetree.pcstr_self; Ast_501.Parsetree.pcstr_fields } -> + { + Ast_500.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_500.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_501.Parsetree.class_field -> Ast_500.Parsetree.class_field = + fun { + Ast_501.Parsetree.pcf_desc; + Ast_501.Parsetree.pcf_loc; + Ast_501.Parsetree.pcf_attributes; + } -> + { + Ast_500.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_500.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_500.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_501.Parsetree.class_field_desc -> Ast_500.Parsetree.class_field_desc = + function + | Ast_501.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_500.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (fun x -> copy_loc (fun x -> x) x) x2 ) + | Ast_501.Parsetree.Pcf_val x0 -> + Ast_500.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_501.Parsetree.Pcf_method x0 -> + Ast_500.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_501.Parsetree.Pcf_constraint x0 -> + Ast_500.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_501.Parsetree.Pcf_initializer x0 -> + Ast_500.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_501.Parsetree.Pcf_attribute x0 -> + Ast_500.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_501.Parsetree.Pcf_extension x0 -> + Ast_500.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_501.Parsetree.class_field_kind -> Ast_500.Parsetree.class_field_kind = + function + | Ast_501.Parsetree.Cfk_virtual x0 -> + Ast_500.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_501.Parsetree.Cfk_concrete (x0, x1) -> + Ast_500.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_open_declaration : + Ast_501.Parsetree.open_declaration -> Ast_500.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_module_binding : + Ast_501.Parsetree.module_binding -> Ast_500.Parsetree.module_binding = + fun { + Ast_501.Parsetree.pmb_name; + Ast_501.Parsetree.pmb_expr; + Ast_501.Parsetree.pmb_attributes; + Ast_501.Parsetree.pmb_loc; + } -> + { + Ast_500.Parsetree.pmb_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name; + Ast_500.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_500.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_500.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_module_expr : + Ast_501.Parsetree.module_expr -> Ast_500.Parsetree.module_expr = + fun { + Ast_501.Parsetree.pmod_desc; + Ast_501.Parsetree.pmod_loc; + Ast_501.Parsetree.pmod_attributes; + } -> + { + Ast_500.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_500.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_500.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_501.Parsetree.module_expr_desc -> Ast_500.Parsetree.module_expr_desc = + function + | Ast_501.Parsetree.Pmod_ident x0 -> + Ast_500.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_501.Parsetree.Pmod_structure x0 -> + Ast_500.Parsetree.Pmod_structure (copy_structure x0) + | Ast_501.Parsetree.Pmod_functor (x0, x1) -> + Ast_500.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_501.Parsetree.Pmod_apply (x0, x1) -> + Ast_500.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_501.Parsetree.Pmod_apply_unit x0 -> + let empty_struct = + Ast_500.Parsetree. + { + pmod_desc = Pmod_structure []; + pmod_loc = Location.none; + pmod_attributes = []; + } + in + Ast_500.Parsetree.Pmod_apply (copy_module_expr x0, empty_struct) + | Ast_501.Parsetree.Pmod_constraint (x0, x1) -> + Ast_500.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_501.Parsetree.Pmod_unpack x0 -> + Ast_500.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_501.Parsetree.Pmod_extension x0 -> + Ast_500.Parsetree.Pmod_extension (copy_extension x0) + +and copy_functor_parameter : + Ast_501.Parsetree.functor_parameter -> Ast_500.Parsetree.functor_parameter = + function + | Ast_501.Parsetree.Unit -> Ast_500.Parsetree.Unit + | Ast_501.Parsetree.Named (x0, x1) -> + Ast_500.Parsetree.Named + (copy_loc (fun x -> Option.map (fun x -> x) x) x0, copy_module_type x1) + +and copy_module_type : + Ast_501.Parsetree.module_type -> Ast_500.Parsetree.module_type = + fun { + Ast_501.Parsetree.pmty_desc; + Ast_501.Parsetree.pmty_loc; + Ast_501.Parsetree.pmty_attributes; + } -> + { + Ast_500.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_500.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_500.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_501.Parsetree.module_type_desc -> Ast_500.Parsetree.module_type_desc = + function + | Ast_501.Parsetree.Pmty_ident x0 -> + Ast_500.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_501.Parsetree.Pmty_signature x0 -> + Ast_500.Parsetree.Pmty_signature (copy_signature x0) + | Ast_501.Parsetree.Pmty_functor (x0, x1) -> + Ast_500.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_501.Parsetree.Pmty_with (x0, x1) -> + Ast_500.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_501.Parsetree.Pmty_typeof x0 -> + Ast_500.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_501.Parsetree.Pmty_extension x0 -> + Ast_500.Parsetree.Pmty_extension (copy_extension x0) + | Ast_501.Parsetree.Pmty_alias x0 -> + Ast_500.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) + +and copy_with_constraint : + Ast_501.Parsetree.with_constraint -> Ast_500.Parsetree.with_constraint = + function + | Ast_501.Parsetree.Pwith_type (x0, x1) -> + Ast_500.Parsetree.Pwith_type + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_501.Parsetree.Pwith_module (x0, x1) -> + Ast_500.Parsetree.Pwith_module + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + | Ast_501.Parsetree.Pwith_modtype (x0, x1) -> + Ast_500.Parsetree.Pwith_modtype + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_501.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_500.Parsetree.Pwith_modtypesubst + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_501.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_500.Parsetree.Pwith_typesubst + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_501.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_500.Parsetree.Pwith_modsubst + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + +and copy_signature : Ast_501.Parsetree.signature -> Ast_500.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_501.Parsetree.signature_item -> Ast_500.Parsetree.signature_item = + fun { Ast_501.Parsetree.psig_desc; Ast_501.Parsetree.psig_loc } -> + { + Ast_500.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_500.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_501.Parsetree.signature_item_desc -> + Ast_500.Parsetree.signature_item_desc = function + | Ast_501.Parsetree.Psig_value x0 -> + Ast_500.Parsetree.Psig_value (copy_value_description x0) + | Ast_501.Parsetree.Psig_type (x0, x1) -> + Ast_500.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_501.Parsetree.Psig_typesubst x0 -> + Ast_500.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_501.Parsetree.Psig_typext x0 -> + Ast_500.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_501.Parsetree.Psig_exception x0 -> + Ast_500.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_501.Parsetree.Psig_module x0 -> + Ast_500.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_501.Parsetree.Psig_modsubst x0 -> + Ast_500.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_501.Parsetree.Psig_recmodule x0 -> + Ast_500.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_501.Parsetree.Psig_modtype x0 -> + Ast_500.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_501.Parsetree.Psig_modtypesubst x0 -> + Ast_500.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_501.Parsetree.Psig_open x0 -> + Ast_500.Parsetree.Psig_open (copy_open_description x0) + | Ast_501.Parsetree.Psig_include x0 -> + Ast_500.Parsetree.Psig_include (copy_include_description x0) + | Ast_501.Parsetree.Psig_class x0 -> + Ast_500.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_501.Parsetree.Psig_class_type x0 -> + Ast_500.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_501.Parsetree.Psig_attribute x0 -> + Ast_500.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_501.Parsetree.Psig_extension (x0, x1) -> + Ast_500.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_class_type_declaration : + Ast_501.Parsetree.class_type_declaration -> + Ast_500.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_description : + Ast_501.Parsetree.class_description -> Ast_500.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type : + Ast_501.Parsetree.class_type -> Ast_500.Parsetree.class_type = + fun { + Ast_501.Parsetree.pcty_desc; + Ast_501.Parsetree.pcty_loc; + Ast_501.Parsetree.pcty_attributes; + } -> + { + Ast_500.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_500.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_500.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_501.Parsetree.class_type_desc -> Ast_500.Parsetree.class_type_desc = + function + | Ast_501.Parsetree.Pcty_constr (x0, x1) -> + Ast_500.Parsetree.Pcty_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_501.Parsetree.Pcty_signature x0 -> + Ast_500.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_501.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_500.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_501.Parsetree.Pcty_extension x0 -> + Ast_500.Parsetree.Pcty_extension (copy_extension x0) + | Ast_501.Parsetree.Pcty_open (x0, x1) -> + Ast_500.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_501.Parsetree.class_signature -> Ast_500.Parsetree.class_signature = + fun { Ast_501.Parsetree.pcsig_self; Ast_501.Parsetree.pcsig_fields } -> + { + Ast_500.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_500.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_501.Parsetree.class_type_field -> Ast_500.Parsetree.class_type_field = + fun { + Ast_501.Parsetree.pctf_desc; + Ast_501.Parsetree.pctf_loc; + Ast_501.Parsetree.pctf_attributes; + } -> + { + Ast_500.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_500.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_500.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_501.Parsetree.class_type_field_desc -> + Ast_500.Parsetree.class_type_field_desc = function + | Ast_501.Parsetree.Pctf_inherit x0 -> + Ast_500.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_501.Parsetree.Pctf_val x0 -> + Ast_500.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_501.Parsetree.Pctf_method x0 -> + Ast_500.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_501.Parsetree.Pctf_constraint x0 -> + Ast_500.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_501.Parsetree.Pctf_attribute x0 -> + Ast_500.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_501.Parsetree.Pctf_extension x0 -> + Ast_500.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : Ast_501.Parsetree.extension -> Ast_500.Parsetree.extension + = + fun x -> + let x0, x1 = x in + (copy_loc (fun x -> x) x0, copy_payload x1) + +and copy_class_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_501.Parsetree.class_infos -> + 'g0 Ast_500.Parsetree.class_infos = + fun f0 + { + Ast_501.Parsetree.pci_virt; + Ast_501.Parsetree.pci_params; + Ast_501.Parsetree.pci_name; + Ast_501.Parsetree.pci_expr; + Ast_501.Parsetree.pci_loc; + Ast_501.Parsetree.pci_attributes; + } -> + { + Ast_500.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_500.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_500.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_500.Parsetree.pci_expr = f0 pci_expr; + Ast_500.Parsetree.pci_loc = copy_location pci_loc; + Ast_500.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_virtual_flag : + Ast_501.Asttypes.virtual_flag -> Ast_500.Asttypes.virtual_flag = function + | Ast_501.Asttypes.Virtual -> Ast_500.Asttypes.Virtual + | Ast_501.Asttypes.Concrete -> Ast_500.Asttypes.Concrete + +and copy_include_description : + Ast_501.Parsetree.include_description -> + Ast_500.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_501.Parsetree.include_infos -> + 'g0 Ast_500.Parsetree.include_infos = + fun f0 + { + Ast_501.Parsetree.pincl_mod; + Ast_501.Parsetree.pincl_loc; + Ast_501.Parsetree.pincl_attributes; + } -> + { + Ast_500.Parsetree.pincl_mod = f0 pincl_mod; + Ast_500.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_500.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_open_description : + Ast_501.Parsetree.open_description -> Ast_500.Parsetree.open_description = + fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x + +and copy_open_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_501.Parsetree.open_infos -> + 'g0 Ast_500.Parsetree.open_infos = + fun f0 + { + Ast_501.Parsetree.popen_expr; + Ast_501.Parsetree.popen_override; + Ast_501.Parsetree.popen_loc; + Ast_501.Parsetree.popen_attributes; + } -> + { + Ast_500.Parsetree.popen_expr = f0 popen_expr; + Ast_500.Parsetree.popen_override = copy_override_flag popen_override; + Ast_500.Parsetree.popen_loc = copy_location popen_loc; + Ast_500.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_override_flag : + Ast_501.Asttypes.override_flag -> Ast_500.Asttypes.override_flag = function + | Ast_501.Asttypes.Override -> Ast_500.Asttypes.Override + | Ast_501.Asttypes.Fresh -> Ast_500.Asttypes.Fresh + +and copy_module_type_declaration : + Ast_501.Parsetree.module_type_declaration -> + Ast_500.Parsetree.module_type_declaration = + fun { + Ast_501.Parsetree.pmtd_name; + Ast_501.Parsetree.pmtd_type; + Ast_501.Parsetree.pmtd_attributes; + Ast_501.Parsetree.pmtd_loc; + } -> + { + Ast_500.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_500.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_500.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_500.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_module_substitution : + Ast_501.Parsetree.module_substitution -> + Ast_500.Parsetree.module_substitution = + fun { + Ast_501.Parsetree.pms_name; + Ast_501.Parsetree.pms_manifest; + Ast_501.Parsetree.pms_attributes; + Ast_501.Parsetree.pms_loc; + } -> + { + Ast_500.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_500.Parsetree.pms_manifest = copy_loc copy_Longident_t pms_manifest; + Ast_500.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_500.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_declaration : + Ast_501.Parsetree.module_declaration -> Ast_500.Parsetree.module_declaration + = + fun { + Ast_501.Parsetree.pmd_name; + Ast_501.Parsetree.pmd_type; + Ast_501.Parsetree.pmd_attributes; + Ast_501.Parsetree.pmd_loc; + } -> + { + Ast_500.Parsetree.pmd_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name; + Ast_500.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_500.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_500.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_type_exception : + Ast_501.Parsetree.type_exception -> Ast_500.Parsetree.type_exception = + fun { + Ast_501.Parsetree.ptyexn_constructor; + Ast_501.Parsetree.ptyexn_loc; + Ast_501.Parsetree.ptyexn_attributes; + } -> + { + Ast_500.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_500.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_500.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_type_extension : + Ast_501.Parsetree.type_extension -> Ast_500.Parsetree.type_extension = + fun { + Ast_501.Parsetree.ptyext_path; + Ast_501.Parsetree.ptyext_params; + Ast_501.Parsetree.ptyext_constructors; + Ast_501.Parsetree.ptyext_private; + Ast_501.Parsetree.ptyext_loc; + Ast_501.Parsetree.ptyext_attributes; + } -> + { + Ast_500.Parsetree.ptyext_path = copy_loc copy_Longident_t ptyext_path; + Ast_500.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_500.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_500.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_500.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_500.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_501.Parsetree.extension_constructor -> + Ast_500.Parsetree.extension_constructor = + fun { + Ast_501.Parsetree.pext_name; + Ast_501.Parsetree.pext_kind; + Ast_501.Parsetree.pext_loc; + Ast_501.Parsetree.pext_attributes; + } -> + { + Ast_500.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_500.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_500.Parsetree.pext_loc = copy_location pext_loc; + Ast_500.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_extension_constructor_kind : + Ast_501.Parsetree.extension_constructor_kind -> + Ast_500.Parsetree.extension_constructor_kind = function + | Ast_501.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_500.Parsetree.Pext_decl + ( List.map (fun x -> copy_loc (fun x -> x) x) x0, + copy_constructor_arguments x1, + Option.map copy_core_type x2 ) + | Ast_501.Parsetree.Pext_rebind x0 -> + Ast_500.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) + +and copy_type_declaration : + Ast_501.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration = + fun { + Ast_501.Parsetree.ptype_name; + Ast_501.Parsetree.ptype_params; + Ast_501.Parsetree.ptype_cstrs; + Ast_501.Parsetree.ptype_kind; + Ast_501.Parsetree.ptype_private; + Ast_501.Parsetree.ptype_manifest; + Ast_501.Parsetree.ptype_attributes; + Ast_501.Parsetree.ptype_loc; + } -> + { + Ast_500.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_500.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_500.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_cstrs; + Ast_500.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_500.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_500.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_500.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_500.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_private_flag : + Ast_501.Asttypes.private_flag -> Ast_500.Asttypes.private_flag = function + | Ast_501.Asttypes.Private -> Ast_500.Asttypes.Private + | Ast_501.Asttypes.Public -> Ast_500.Asttypes.Public + +and copy_type_kind : Ast_501.Parsetree.type_kind -> Ast_500.Parsetree.type_kind + = function + | Ast_501.Parsetree.Ptype_abstract -> Ast_500.Parsetree.Ptype_abstract + | Ast_501.Parsetree.Ptype_variant x0 -> + Ast_500.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_501.Parsetree.Ptype_record x0 -> + Ast_500.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_501.Parsetree.Ptype_open -> Ast_500.Parsetree.Ptype_open + +and copy_constructor_declaration : + Ast_501.Parsetree.constructor_declaration -> + Ast_500.Parsetree.constructor_declaration = + fun { + Ast_501.Parsetree.pcd_name; + Ast_501.Parsetree.pcd_vars; + Ast_501.Parsetree.pcd_args; + Ast_501.Parsetree.pcd_res; + Ast_501.Parsetree.pcd_loc; + Ast_501.Parsetree.pcd_attributes; + } -> + { + Ast_500.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_500.Parsetree.pcd_vars = + List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars; + Ast_500.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_500.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_500.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_500.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_501.Parsetree.constructor_arguments -> + Ast_500.Parsetree.constructor_arguments = function + | Ast_501.Parsetree.Pcstr_tuple x0 -> + Ast_500.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_501.Parsetree.Pcstr_record x0 -> + Ast_500.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_label_declaration : + Ast_501.Parsetree.label_declaration -> Ast_500.Parsetree.label_declaration = + fun { + Ast_501.Parsetree.pld_name; + Ast_501.Parsetree.pld_mutable; + Ast_501.Parsetree.pld_type; + Ast_501.Parsetree.pld_loc; + Ast_501.Parsetree.pld_attributes; + } -> + { + Ast_500.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_500.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_500.Parsetree.pld_type = copy_core_type pld_type; + Ast_500.Parsetree.pld_loc = copy_location pld_loc; + Ast_500.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_mutable_flag : + Ast_501.Asttypes.mutable_flag -> Ast_500.Asttypes.mutable_flag = function + | Ast_501.Asttypes.Immutable -> Ast_500.Asttypes.Immutable + | Ast_501.Asttypes.Mutable -> Ast_500.Asttypes.Mutable + +and copy_injectivity : + Ast_501.Asttypes.injectivity -> Ast_500.Asttypes.injectivity = function + | Ast_501.Asttypes.Injective -> Ast_500.Asttypes.Injective + | Ast_501.Asttypes.NoInjectivity -> Ast_500.Asttypes.NoInjectivity + +and copy_variance : Ast_501.Asttypes.variance -> Ast_500.Asttypes.variance = + function + | Ast_501.Asttypes.Covariant -> Ast_500.Asttypes.Covariant + | Ast_501.Asttypes.Contravariant -> Ast_500.Asttypes.Contravariant + | Ast_501.Asttypes.NoVariance -> Ast_500.Asttypes.NoVariance + +and copy_value_description : + Ast_501.Parsetree.value_description -> Ast_500.Parsetree.value_description = + fun { + Ast_501.Parsetree.pval_name; + Ast_501.Parsetree.pval_type; + Ast_501.Parsetree.pval_prim; + Ast_501.Parsetree.pval_attributes; + Ast_501.Parsetree.pval_loc; + } -> + { + Ast_500.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_500.Parsetree.pval_type = copy_core_type pval_type; + Ast_500.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_500.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_500.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_object_field_desc : + Ast_501.Parsetree.object_field_desc -> Ast_500.Parsetree.object_field_desc = + function + | Ast_501.Parsetree.Otag (x0, x1) -> + Ast_500.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_501.Parsetree.Oinherit x0 -> + Ast_500.Parsetree.Oinherit (copy_core_type x0) + +and copy_arg_label : Ast_501.Asttypes.arg_label -> Ast_500.Asttypes.arg_label = + function + | Ast_501.Asttypes.Nolabel -> Ast_500.Asttypes.Nolabel + | Ast_501.Asttypes.Labelled x0 -> Ast_500.Asttypes.Labelled x0 + | Ast_501.Asttypes.Optional x0 -> Ast_500.Asttypes.Optional x0 + +and copy_closed_flag : + Ast_501.Asttypes.closed_flag -> Ast_500.Asttypes.closed_flag = function + | Ast_501.Asttypes.Closed -> Ast_500.Asttypes.Closed + | Ast_501.Asttypes.Open -> Ast_500.Asttypes.Open + +and copy_label : Ast_501.Asttypes.label -> Ast_500.Asttypes.label = fun x -> x + +and copy_rec_flag : Ast_501.Asttypes.rec_flag -> Ast_500.Asttypes.rec_flag = + function + | Ast_501.Asttypes.Nonrecursive -> Ast_500.Asttypes.Nonrecursive + | Ast_501.Asttypes.Recursive -> Ast_500.Asttypes.Recursive + +and copy_constant : Ast_501.Parsetree.constant -> Ast_500.Parsetree.constant = + function + | Ast_501.Parsetree.Pconst_integer (x0, x1) -> + Ast_500.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_501.Parsetree.Pconst_char x0 -> Ast_500.Parsetree.Pconst_char x0 + | Ast_501.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_500.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_501.Parsetree.Pconst_float (x0, x1) -> + Ast_500.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + +and copy_Longident_t : Longident.t -> Longident.t = function + | Longident.Lident x0 -> Longident.Lident x0 + | Longident.Ldot (x0, x1) -> Longident.Ldot (copy_Longident_t x0, x1) + | Longident.Lapply (x0, x1) -> + Longident.Lapply (copy_Longident_t x0, copy_Longident_t x1) + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_501.Asttypes.loc -> 'g0 Ast_500.Asttypes.loc = + fun f0 { Ast_501.Asttypes.txt; Ast_501.Asttypes.loc } -> + { Ast_500.Asttypes.txt = f0 txt; Ast_500.Asttypes.loc = copy_location loc } + +and copy_location : Location.t -> Location.t = + fun { Location.loc_start; Location.loc_end; Location.loc_ghost } -> + { + Location.loc_start = copy_position loc_start; + Location.loc_end = copy_position loc_end; + Location.loc_ghost; + } + +and copy_position : Lexing.position -> Lexing.position = + fun { Lexing.pos_fname; Lexing.pos_lnum; Lexing.pos_bol; Lexing.pos_cnum } -> + { Lexing.pos_fname; Lexing.pos_lnum; Lexing.pos_bol; Lexing.pos_cnum } diff --git a/dune-project b/dune-project index 54683d0ed..de18121e7 100644 --- a/dune-project +++ b/dune-project @@ -15,7 +15,7 @@ (package (name ppxlib) (depends - (ocaml (and (>= 4.04.1) (< 5.1.0))) + (ocaml (and (>= 4.04.1) (<> 5.1.0~alpha1))) (ocaml-compiler-libs (>= v0.11.0)) (ppx_derivers (>= 1.0)) (sexplib0 (>= v0.12)) diff --git a/ppxlib.opam b/ppxlib.opam index 56fa0c809..9acd806c1 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" {>= "2.7"} - "ocaml" {>= "4.04.1" & < "5.1.0"} + "ocaml" {>= "4.04.1" & != "5.1.0~alpha1"} "ocaml-compiler-libs" {>= "v0.11.0"} "ppx_derivers" {>= "1.0"} "sexplib0" {>= "v0.12"} diff --git a/src/location_check.ml b/src/location_check.ml index e29ff1c97..2c0e35fe2 100644 --- a/src/location_check.ml +++ b/src/location_check.ml @@ -161,7 +161,7 @@ let should_ignore loc attrs = let rec extract_constraint e = match e.pexp_desc with - | Pexp_constraint (e, ct) | Pexp_coerce (e, None, ct) -> Some (e, ct) + | Pexp_constraint (e, ct) | Pexp_coerce (e, _, ct) -> Some (e, ct) | Pexp_newtype (name, exp) -> Option.map (extract_constraint exp) ~f:(fun (exp, ct) -> ( { diff --git a/test/501_migrations/compare_on.ml b/test/501_migrations/compare_on.ml new file mode 100644 index 000000000..ecd059cf5 --- /dev/null +++ b/test/501_migrations/compare_on.ml @@ -0,0 +1,30 @@ +let run () = + let example_fn, ppx = + let args = Sys.argv in + if not (Array.length args = 3) then failwith "expected exactly two args" + else (Array.get args 1, Array.get args 2) + in + let direct = "without_migrations" in + let migrations = "with_migrations" in + let direct_ec = + Sys.command ("ocamlc -dparsetree " ^ example_fn ^ " 2> " ^ direct) + in + if direct_ec > 0 then ( + print_endline "compile error even without migrations"; + let _ = Sys.command ("cat " ^ direct) in + ()) + else + let migrations_ec = + Sys.command + ("ocamlc -dparsetree -ppx '" ^ ppx ^ " -as-ppx' " ^ example_fn ^ " 2> " + ^ migrations) + in + if migrations_ec > 0 then ( + print_endline "compile error after migrations"; + let _ = Sys.command ("cat " ^ migrations) in + ()) + else + let _ = Sys.command ("diff -U 0 " ^ direct ^ " " ^ migrations) in + () + +let () = run () diff --git a/test/501_migrations/dune b/test/501_migrations/dune new file mode 100644 index 000000000..886d2881a --- /dev/null +++ b/test/501_migrations/dune @@ -0,0 +1,36 @@ +(executable + (name identity_driver) + (modules identity_driver) + (libraries ppxlib)) + +(executable + (name reverse_migrations) + (modules reverse_migrations) + (libraries ppxlib)) + +(executable + (name compare_on) + (libraries unix) + (modules compare_on)) + +(cram + (enabled_if + (and + (>= %{ocaml_version} "5.1.0~alpha2") + (< %{ocaml_version} "5.2.0"))) + (applies_to normal_migrations) + (deps identity_driver.exe compare_on.exe)) + +(cram + (enabled_if + (= %{ocaml_version} "5.0.0")) + (applies_to reverse_migrations) + (deps reverse_migrations.exe compare_on.exe)) + +(cram + (enabled_if + (and + (>= %{ocaml_version} "5.0.0") + (< %{ocaml_version} "5.2.0"))) + (applies_to one_migration) + (deps identity_driver.exe compare_on.exe)) diff --git a/test/501_migrations/identity_driver.ml b/test/501_migrations/identity_driver.ml new file mode 100644 index 000000000..e3cba4049 --- /dev/null +++ b/test/501_migrations/identity_driver.ml @@ -0,0 +1 @@ +let () = Ppxlib.Driver.standalone () diff --git a/test/501_migrations/normal_migrations.t b/test/501_migrations/normal_migrations.t new file mode 100644 index 000000000..c9d2c8d42 --- /dev/null +++ b/test/501_migrations/normal_migrations.t @@ -0,0 +1,131 @@ +The 501 parsetree contains a parsing modificacion. +[compare_on.exe ] checks if there's a diff between the +AST's resulting from +1. parsing on 5.1.0 directly +2. parsing on 5.1.0, migrating down to 5.0.0 and migrating back to 5.1.0 +We only expect a diff in one special case. + + $ echo "let x : int = 5" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let (x) : int = 5" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let _ : int = 5" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let f : type a b c. a -> b -> c = fun x y -> assert false" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let f = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let _ = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let f : type a . a -> a = fun x -> x" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let (x, y) : (int * int) = assert false" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo "let f : type a . a = assert false" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo 'let x : [`A] :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo 'let x : [`A | `B] = (`A : [`A] :> [`A | `B])' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo 'let x : :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + $ echo 'let x :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + +Here might be a problem in the upward migration: the 5.1.0 parser parses the constraint as a pattern constraint. +However, the upward migration makes a value binding constraint out of it. + $ echo "let ((x,y) : (int*int)) = (assert false: int * int)" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + 6,25c6,23 + < pattern (file.ml[1,0+4]..[1,0+23]) + < Ppat_constraint + < pattern (file.ml[1,0+5]..[1,0+10]) + < Ppat_tuple + < [ + < pattern (file.ml[1,0+6]..[1,0+7]) + < Ppat_var "x" (file.ml[1,0+6]..[1,0+7]) + < pattern (file.ml[1,0+8]..[1,0+9]) + < Ppat_var "y" (file.ml[1,0+8]..[1,0+9]) + < ] + < core_type (file.ml[1,0+14]..[1,0+21]) + < Ptyp_tuple + < [ + < core_type (file.ml[1,0+14]..[1,0+17]) + < Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17]) + < [] + < core_type (file.ml[1,0+18]..[1,0+21]) + < Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21]) + < [] + < ] + --- + > pattern (file.ml[1,0+5]..[1,0+10]) + > Ppat_tuple + > [ + > pattern (file.ml[1,0+6]..[1,0+7]) + > Ppat_var "x" (file.ml[1,0+6]..[1,0+7]) + > pattern (file.ml[1,0+8]..[1,0+9]) + > Ppat_var "y" (file.ml[1,0+8]..[1,0+9]) + > ] + > core_type (file.ml[1,0+14]..[1,0+21]) + > Ptyp_tuple + > [ + > core_type (file.ml[1,0+14]..[1,0+17]) + > Ptyp_constr "int" (file.ml[1,0+14]..[1,0+17]) + > [] + > core_type (file.ml[1,0+18]..[1,0+21]) + > Ptyp_constr "int" (file.ml[1,0+18]..[1,0+21]) + > [] + > ] + + $ echo "let f: type a. a option -> _ = assert false" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + + +Here we may expect a diff (downwards migrating should yield the same as in the example right above). +However, those case are recoverable. + +First, both + + $ echo "let f : 'a . 'a = (fun (type a) -> (assert false : a))" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + +and + $ echo "let f : type a . a = assert false" > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + +are translated to the same 5.0 AST tree. But the locations on the expression +constraint and pattern constraint are only the same in the second case. +Thus, we can distinguish between the two. + +Similarly, the syntactic translation for + + $ echo 'let x :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + +and + + $ echo 'let x : [`A | `B] = (`A :> [ `A | `B ] )' > file.ml + $ ./compare_on.exe file.ml ./identity_driver.exe + +are pretty close: The former is translated to "let (x: ø . [`A | `B]) = (`A :> [`A | `B])" +whereas the latter is mapped to "let (x: ø . [`A | `B]) = ((`A :> [`A | `B]): [`A | `B]) ". +However, the two case can be distingued by the fact that we have either an outward coercion +or an outward constraint associated to a `Ptyp_poly([],...)` pattern constraint. + +Let's make sure that in the examples with diffs, +the location invariants are still fulfilled. + $ echo "let ((x,y) : (int*int)) = (assert false: int * int)" > file.ml + $ ./identity_driver.exe -check -locations-check file.ml > /dev/null diff --git a/test/501_migrations/one_migration.t b/test/501_migrations/one_migration.t new file mode 100644 index 000000000..70a549b1f --- /dev/null +++ b/test/501_migrations/one_migration.t @@ -0,0 +1,572 @@ +This test is enabled both on 5.0.0 and 5.1.0. The test makes sense for as long +as the ppxlib AST is either 5.0.0 or 5.1.0. While the ppxlib AST is on 5.0.0, the +test checks whether parsing on 5.0.0 (result of test running on 5.0.0) is the same as +parsing on 5.1.0 and then migrating down to 5.0.0 (result of test running on 5.1.0). + +The test is mostly useful for debuggung problems in a full round-trip. Since Ppxlib's +`dparsetree` option doesn't compactify or strip locations, its output is very long. +So let's only keep one example. + + $ echo "let x : int = 5" > file.ml + $ ./identity_driver.exe -dparsetree file.ml + (((pstr_desc + (Pstr_attribute + ((attr_name + ((txt ocaml.ppx.context) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_ghost true))))) + (attr_payload + (PStr + (((pstr_desc + (Pstr_eval + ((pexp_desc + (Pexp_record + ((((txt (Lident tool_name)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_constant + (Pconst_string ppxlib_driver + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)) + ()))) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident include_dirs)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident [])) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident load_path)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident [])) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident open_modules)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident [])) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident for_package)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident None)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident debug)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident use_threads)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident use_vmthreads)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident recursive_types)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident principal)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident transparent_modules)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident unboxed_types)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident unsafe_string)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident false)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (((txt (Lident cookies)) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ((pexp_desc + (Pexp_construct + ((txt (Lident [])) + (loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true)))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) + (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ())))) + ())) + (pexp_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_ghost true))) + (pexp_loc_stack ()) (pexp_attributes ())) + ())) + (pstr_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_end + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_ghost true))))))) + (attr_loc + ((loc_start + ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_end ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_ghost true)))))) + (pstr_loc + ((loc_start ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_end ((pos_fname _none_) (pos_lnum 0) (pos_bol 0) (pos_cnum -1))) + (loc_ghost true)))) + ((pstr_desc + (Pstr_value Nonrecursive + (((pvb_pat + ((ppat_desc + (Ppat_constraint + ((ppat_desc + (Ppat_var + ((txt x) + (loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 4))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 5))) + (loc_ghost false)))))) + (ppat_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 4))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 5))) + (loc_ghost false))) + (ppat_loc_stack ()) (ppat_attributes ())) + ((ptyp_desc + (Ptyp_poly () + ((ptyp_desc + (Ptyp_constr + ((txt (Lident int)) + (loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) + (pos_cnum 8))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) + (pos_cnum 11))) + (loc_ghost false)))) + ())) + (ptyp_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 8))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 11))) + (loc_ghost false))) + (ptyp_loc_stack ()) (ptyp_attributes ())))) + (ptyp_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 8))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 11))) + (loc_ghost true))) + (ptyp_loc_stack ()) (ptyp_attributes ())))) + (ppat_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 4))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 11))) + (loc_ghost true))) + (ppat_loc_stack ()) (ppat_attributes ()))) + (pvb_expr + ((pexp_desc + (Pexp_constraint + ((pexp_desc (Pexp_constant (Pconst_integer 5 ()))) + (pexp_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 14))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 15))) + (loc_ghost false))) + (pexp_loc_stack ()) (pexp_attributes ())) + ((ptyp_desc + (Ptyp_constr + ((txt (Lident int)) + (loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 8))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 11))) + (loc_ghost false)))) + ())) + (ptyp_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 8))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 11))) + (loc_ghost false))) + (ptyp_loc_stack ()) (ptyp_attributes ())))) + (pexp_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 4))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 15))) + (loc_ghost false))) + (pexp_loc_stack ()) (pexp_attributes ()))) + (pvb_attributes ()) + (pvb_loc + ((loc_start + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 0))) + (loc_end + ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 15))) + (loc_ghost false))))))) + (pstr_loc + ((loc_start ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 0))) + (loc_end ((pos_fname file.ml) (pos_lnum 1) (pos_bol 0) (pos_cnum 15))) + (loc_ghost false))))) diff --git a/test/501_migrations/reverse_migrations.ml b/test/501_migrations/reverse_migrations.ml new file mode 100644 index 000000000..0a3586b4d --- /dev/null +++ b/test/501_migrations/reverse_migrations.ml @@ -0,0 +1,9 @@ +module Reverse = Ppxlib_ast.Select_ast (Ppxlib_ast__.Versions.OCaml_501) + +let () = + let impl str = + Reverse.Of_ocaml.copy_structure @@ Reverse.To_ocaml.copy_structure str + in + Ppxlib.Driver.register_transformation ~impl "reverse_migrations" + +let () = Ppxlib.Driver.standalone () diff --git a/test/501_migrations/reverse_migrations.t b/test/501_migrations/reverse_migrations.t new file mode 100644 index 000000000..9120ed91e --- /dev/null +++ b/test/501_migrations/reverse_migrations.t @@ -0,0 +1,164 @@ +The 501 parsetree contains a parsing modificacion. +[compare_on.exe ./reverse_migrations.exe] checks if there's a diff between the +AST's resulting from +1. parsing on 5.0.0 directly +2. parsing on 5.0.0, migrating up to 5.1.0 and migrating back to 5.0.0 + + $ echo "let x : int = 5" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let _ : int = 5" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : type a b c. a -> b -> c = fun x y -> assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let _ = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : type a . a -> a = fun x -> x" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f: type a. a option -> _ = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : 'a . 'a = (fun (type a) -> (assert false : a))" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : type a . a = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : [`A] :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : [`A | `B] = (`A : [`A] :> [`A | `B])' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + +The downward migration isn't able to recover the whole pattern location range, +since it doesn't track the location of the closing brackets. + $ echo "let (x, y) : (int * int) = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + @@ -6 +6 @@ + - pattern (file.ml[1,0+4]..[1,0+24]) ghost + + pattern (file.ml[1,0+4]..[1,0+23]) ghost + + $ echo "let (x, y) : (int * int) = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + @@ -6 +6 @@ + - pattern (file.ml[1,0+4]..[1,0+24]) ghost + + pattern (file.ml[1,0+4]..[1,0+23]) ghost + + $ echo "let f: type a. a option -> _ = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : 'a . 'a = (fun (type a) -> (assert false : a))" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo "let f : type a . a = assert false" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : [`A] :> [`A | `B] = `A' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : [`A | `B] = (`A : [`A] :> [`A | `B])' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x : :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + + $ echo 'let x :> = object method m = 0 method n = 1 end' > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + [1] + +The diffs are on locations. If the location modification +at least preserved the location invariants, it might be acceptable. +However, in several cases it doesn't. + + $ echo "let x : int = 5" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ echo "let (x as y) : int = 5" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ cat > file.ml << EOF + > type t = {a : int} + > let {a} = {a = 5} + > EOF + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + + $ echo "let _ : int = 5" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ echo "let f : type a b c. a -> b -> c = fun x y -> assert false" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ echo "let f = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ echo "let _ = (fun (type a) (type b) (type c) -> (fun x y -> assert false : a -> b -> c))" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + +Here we're expecting a similar location diff as above. However, the downward +migration is faulty: it turns [let (x) : int = 5] (constraint only on pattern) +into [let x : int = 5] (contraint on both pattern an expression). + $ echo "let (x) : int = 5" > file.ml + $ ./compare_on.exe file.ml ./reverse_migrations.exe | grep -v "without_migrations" | grep -v "with_migrations" + @@ -9,0 +10,9 @@ + + core_type (file.ml[1,0+10]..[1,0+13]) ghost + + Ptyp_poly + + core_type (file.ml[1,0+10]..[1,0+13]) + + Ptyp_constr "int" (file.ml[1,0+10]..[1,0+13]) + + [] + + expression (file.ml[1,0+4]..[1,0+17]) + + Pexp_constraint + + expression (file.ml[1,0+16]..[1,0+17]) + + Pexp_constant PConst_int (5,None) + @@ -13,2 +21,0 @@ + - expression (file.ml[1,0+16]..[1,0+17]) + - Pexp_constant PConst_int (5,None) + +Let's make sure that in the examples with diffs, +the location invariants are still fulfilled. + + $ echo "let (x, y) : (int * int) = assert false" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null + + $ echo "let (x) : int = 5" > file.ml + $ ./reverse_migrations.exe -check -locations-check file.ml > /dev/null diff --git a/test/base/dune b/test/base/dune index 37beb0365..c13dc64c8 100644 --- a/test/base/dune +++ b/test/base/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.09.0")) + (and + (>= %{ocaml_version} "4.09.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/base/test_510.ml b/test/base/test_510.ml new file mode 100644 index 000000000..4cd6b7ed6 --- /dev/null +++ b/test/base/test_510.ml @@ -0,0 +1,180 @@ +#require "base";; +#require "stdio";; + +let () = Printexc.record_backtrace false + +open Base +open Stdio +open Ppxlib + +module N = Ppxlib_private.Name +[%%expect{| +module N = Ppxlib.Ppxlib_private.Name +|}] + + +let dot_suffixes name = + Caml.Printf.sprintf "%s" + (Sexp.to_string_hum + (List.sexp_of_t String.sexp_of_t (N.dot_suffixes name))) +[%%expect{| +val dot_suffixes : string/2 -> string/2 = +|}] + +let _ = dot_suffixes "foo.bar.baz" +[%%expect{| +- : string/2 = "(baz bar.baz foo.bar.baz)" +|}] + +let _ = dot_suffixes "foo.@bar.baz" +[%%expect{| +- : string/2 = "(bar.baz foo.bar.baz)" +|}] + + +let split_path name = + let a, b = N.split_path name in + Caml.Printf.sprintf "%s" + (Sexp.to_string_hum + (List [sexp_of_string a; Option.sexp_of_t sexp_of_string b])) +[%%expect{| +val split_path : string/2 -> string/2 = +|}] + +let _ = split_path "a.b.c" +[%%expect{| +- : string/2 = "(a.b.c ())" +|}] + +let _ = split_path "a.b.c.D" +[%%expect{| +- : string/2 = "(a.b.c (D))" +|}] + +let _ = split_path ".D" +[%%expect{| +- : string/2 = "(\"\" (D))" +|}] + +let convert_longident string = + let lident = Longident.parse string in + let name = Longident.name lident in + (name, lident) +[%%expect{| +val convert_longident : string/2 -> string/2 * longident = +|}] + +let _ = convert_longident "x" +[%%expect{| +- : string/2 * longident = ("x", Ppxlib.Longident.Lident "x") +|}] + +let _ = convert_longident "(+)" +[%%expect{| +- : string/2 * longident = ("( + )", Ppxlib.Longident.Lident "+") +|}] + +let _ = convert_longident "( + )" +[%%expect{| +- : string/2 * longident = ("( + )", Ppxlib.Longident.Lident "+") +|}] + +let _ = convert_longident "Base.x" +[%%expect{| +- : string/2 * longident = +("Base.x", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "x")) +|}] + +let _ = convert_longident "Base.(+)" +[%%expect{| +- : string/2 * longident = +("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+")) +|}] + +let _ = convert_longident "Base.( + )" +[%%expect{| +- : string/2 * longident = +("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+")) +|}] + +let _ = convert_longident "Base.( land )" +[%%expect{| +- : string/2 * longident = +("Base.( land )", + Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "land")) +|}] + +let _ = convert_longident "A(B)" +[%%expect{| +Exception: Invalid_argument "Ppxlib.Longident.parse: \"A(B)\"". +|}] + +let _ = convert_longident "A.B(C)" +[%%expect{| +Exception: Invalid_argument "Ppxlib.Longident.parse: \"A.B(C)\"". +|}] + +let _ = convert_longident ")" +[%%expect{| +Exception: Invalid_argument "Ppxlib.Longident.parse: \")\"". +|}] + +let _ = Ppxlib.Code_path.(file_path @@ top_level ~file_path:"dir/main.ml") +[%%expect{| +- : string/2 = "dir/main.ml" +|}] + +let _ = Ppxlib.Code_path.(fully_qualified_path @@ top_level ~file_path:"dir/main.ml") +[%%expect{| +- : string/2 = "Main" +|}] + +let complex_path = + let open Ppxlib.Code_path in + let loc = Ppxlib.Location.none in + top_level ~file_path:"dir/main.ml" + |> enter_module ~loc "Sub" + |> enter_module ~loc "Sub_sub" + |> enter_value ~loc "some_val" +[%%expect{| +val complex_path : Code_path.t = +|}] + +let _ = Ppxlib.Code_path.fully_qualified_path complex_path +[%%expect{| +- : string/2 = "Main.Sub.Sub_sub.some_val" +|}] + +let _ = Ppxlib.Code_path.to_string_path complex_path +[%%expect{| +- : string/2 = "dir/main.ml.Sub.Sub_sub" +|}] + +let _ = + let a = gen_symbol () ~prefix:"__prefix__" in + let b = gen_symbol () ~prefix:a in + a, b +[%%expect{| +- : string/2 * string/2 = ("__prefix____001_", "__prefix____002_") +|}] + +let _ = + let open Ast_builder.Make (struct let loc = Location.none end) in + let params decl = + List.map decl.ptype_params ~f:(fun (core_type, _) -> core_type.ptyp_desc) + in + let decl = + type_declaration + ~name:{ txt = "t"; loc = Location.none } + ~params:(List.init 3 ~f:(fun _ -> ptyp_any, (NoVariance, NoInjectivity))) + ~cstrs:[] + ~kind:Ptype_abstract + ~private_:Public + ~manifest:None + in + params decl, params (name_type_params_in_td decl) +[%%expect{| +- : core_type_desc list * core_type_desc list = +([Ptyp_any; Ptyp_any; Ptyp_any], + [Ptyp_var "a__003_"; Ptyp_var "b__004_"; Ptyp_var "c__005_"]) +|}] diff --git a/test/code_path/dune b/test/code_path/dune index 06179b3fc..b88be2aec 100644 --- a/test/code_path/dune +++ b/test/code_path/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.10.0")) + (and + (>= %{ocaml_version} "4.10.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/code_path/test_510.ml b/test/code_path/test_510.ml new file mode 100644 index 000000000..976aac8ef --- /dev/null +++ b/test/code_path/test_510.ml @@ -0,0 +1,152 @@ +open Ppxlib + +let sexp_of_code_path code_path = + Sexplib0.Sexp.message + "code_path" + [ "main_module_name", Sexplib0.Sexp_conv.sexp_of_string (Code_path.main_module_name code_path) + ; "submodule_path", Sexplib0.Sexp_conv.sexp_of_list Sexplib0.Sexp_conv.sexp_of_string (Code_path.submodule_path code_path) + ; "enclosing_module", Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_module code_path) + ; "enclosing_value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.enclosing_value code_path) + ; "value", Sexplib0.Sexp_conv.sexp_of_option Sexplib0.Sexp_conv.sexp_of_string (Code_path.value code_path) + ; "fully_qualified_path", Sexplib0.Sexp_conv.sexp_of_string (Code_path.fully_qualified_path code_path) + ] + +let () = + Driver.register_transformation "test" + ~extensions:[ + Extension.V3.declare "code_path" + Expression + Ast_pattern.(pstr nil) + (fun ~ctxt -> + let loc = Expansion_context.Extension.extension_point_loc ctxt in + let code_path = Expansion_context.Extension.code_path ctxt in + Ast_builder.Default.estring ~loc + (Sexplib0.Sexp.to_string (sexp_of_code_path code_path))) + ] +[%%expect{| +val sexp_of_code_path : Code_path.t -> Sexplib0.Sexp.t = +|}] + +let s = + let module A = struct + module A' = struct + let a = + let module B = struct + module B' = struct + let b = + let module C = struct + module C' = struct + let c = [%code_path] + end + end + in C.C'.c + end + end + in B.B'.b + end + end + in A.A'.a +;; +[%%expect{| +val s : string = + "(code_path(main_module_name Test_510)(submodule_path())(enclosing_module C')(enclosing_value(c))(value(s))(fully_qualified_path Test_510.s))" +|}] + +let module M = struct + let m = [%code_path] + end + in + M.m +[%%expect{| +- : string = +"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module M)(enclosing_value(m))(value())(fully_qualified_path Test_510))" +|}] + +module Outer = struct + module Inner = struct + let code_path = [%code_path] + end +end +let _ = Outer.Inner.code_path +[%%expect{| +module Outer : sig module Inner : sig val code_path : string end end +- : string = +"(code_path(main_module_name Test_510)(submodule_path(Outer Inner))(enclosing_module Inner)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.Outer.Inner.code_path))" +|}] + +module Functor() = struct + let code_path = ref "" + module _ = struct + let x = + let module First_class = struct + code_path := [%code_path] + end in + let module _ = First_class in + () + ;; + + ignore x + end +end +let _ = let module M = Functor() in !M.code_path +[%%expect{| +module Functor : functor () -> sig val code_path : string ref end +Line _: +Error (warning 73 [generative-application-expects-unit]): A generative functor +should be applied to '()'; using '(struct end)' is deprecated. +|}] + +module Actual = struct + let code_path = [%code_path] +end [@enter_module Dummy] +let _ = Actual.code_path +[%%expect{| + +module Actual : sig val code_path : string end + +- : string = +"(code_path(main_module_name Test_510)(submodule_path(Actual Dummy))(enclosing_module Dummy)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.Actual.Dummy.code_path))" +|}] + +module Ignore_me = struct + let code_path = [%code_path] +end [@@do_not_enter_module] +let _ = Ignore_me.code_path +[%%expect{| + +module Ignore_me : sig val code_path : string end + +- : string = +"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(code_path))(value(code_path))(fully_qualified_path Test_510.code_path))" +|}] + +let _ = + (let module Ignore_me = struct + let code_path = [%code_path] + end + in + Ignore_me.code_path) + [@do_not_enter_module] +[%%expect{| + +- : string = +"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(code_path))(value())(fully_qualified_path Test_510))" +|}] + +let _ = ([%code_path] [@ppxlib.enter_value dummy]) +[%%expect{| + +- : string = +"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value(dummy))(value(dummy))(fully_qualified_path Test_510.dummy))" +|}] + +let _ = + let ignore_me = [%code_path] + [@@do_not_enter_value] + in + ignore_me +[%%expect{| + +- : string = +"(code_path(main_module_name Test_510)(submodule_path())(enclosing_module Test_510)(enclosing_value())(value())(fully_qualified_path Test_510))" +|}] diff --git a/test/deriving/dune b/test/deriving/dune index 06179b3fc..b88be2aec 100644 --- a/test/deriving/dune +++ b/test/deriving/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.10.0")) + (and + (>= %{ocaml_version} "4.10.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/deriving/test_510.ml b/test/deriving/test_510.ml new file mode 100644 index 000000000..756d9b783 --- /dev/null +++ b/test/deriving/test_510.ml @@ -0,0 +1,90 @@ +open Ppxlib + + +let foo = + Deriving.add "foo" + ~str_type_decl:(Deriving.Generator.make_noarg + (fun ~loc ~path:_ _ -> [%str let foo = 42])) + ~sig_type_decl:(Deriving.Generator.make_noarg + (fun ~loc ~path:_ _ -> [%sig: val foo : int])) +[%%expect{| +val foo : Deriving.t = +|}] + +let bar = + Deriving.add "bar" + ~str_type_decl:(Deriving.Generator.make_noarg + ~deps:[foo] + (fun ~loc ~path:_ _ -> [%str let bar = foo + 1])) +[%%expect{| +val bar : Deriving.t = +|}] + +let mtd = + Deriving.add "mtd" + ~sig_module_type_decl:( + Deriving.Generator.make_noarg + (fun ~loc ~path:_ _ -> [%sig: val y : int])) + ~str_module_type_decl:( + Deriving.Generator.make_noarg + (fun ~loc ~path:_ _ -> [%str let y = 42])) +[%%expect{| +val mtd : Deriving.t = +|}] + +type t = int [@@deriving bar] +[%%expect{| +Line _, characters 25-28: +Error: Deriver foo is needed for bar, you need to add it before in the list +|}] + +type t = int [@@deriving bar, foo] +[%%expect{| + +Line _, characters 25-33: +Error: Deriver foo is needed for bar, you need to add it before in the list +|}] + +type nonrec int = int [@@deriving foo, bar] +[%%expect{| + +type nonrec int = int +val foo : int = 42 +val bar : int = 43 +|}] + +module Foo_sig : sig + type t [@@deriving foo] +end = struct + type t +end +[%%expect{| + +Line _, characters 6-25: +Error: Signature mismatch: + Modules do not match: + sig type t end + is not included in + sig type t val foo : int end + The value `foo' is required but not provided + File "test/deriving/test_510.ml", line 3, characters 2-25: + Expected declaration +|}] + +module type X = sig end [@@deriving mtd] +[%%expect{| + +module type X = sig end +val y : int = 42 +|}] + +module Y : sig + module type X = sig end [@@deriving mtd] +end = struct + module type X = sig end + let y = 42 +end +[%%expect{| + +module Y : sig module type X = sig end val y : int end +|}] diff --git a/test/driver/attributes/dune b/test/driver/attributes/dune index 40eea9e16..6da6c9a94 100644 --- a/test/driver/attributes/dune +++ b/test/driver/attributes/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.08.0")) + (and + (>= %{ocaml_version} "4.08.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/driver/attributes/test.ml b/test/driver/attributes/test.ml index 5498136e8..51b983a96 100644 --- a/test/driver/attributes/test.ml +++ b/test/driver/attributes/test.ml @@ -1,4 +1,3 @@ -open Stdppx open Ppxlib let () = Driver.enable_checks () diff --git a/test/driver/attributes/test_510.ml b/test/driver/attributes/test_510.ml new file mode 100644 index 000000000..d8b6bed7e --- /dev/null +++ b/test/driver/attributes/test_510.ml @@ -0,0 +1,105 @@ +open Ppxlib + +let () = Driver.enable_checks () + +let x = 1 [@@foo] +[%%expect{| +Line _, characters 13-16: +Error: Attribute `foo' was not used +|}] + +let f x = 1 [@@deprecatd "..."] +[%%expect{| + +Line _, characters 15-24: +Error: Attribute `deprecatd' was not used. + Hint: Did you mean deprecated? +|}] + +let attr : _ Attribute.t = + Attribute.declare "blah" + Attribute.Context.type_declaration + Ast_pattern.(__) + ignore +[%%expect{| + +val attr : (type_declaration, unit) Attribute.t = +|}] + +type t = int [@blah] +[%%expect{| + +Line _, characters 15-19: +Error: Attribute `blah' was not used. + Hint: `blah' is available for type declarations but is used here in + the + context of a core type. + Did you put it at the wrong level? +|}] + +let attr : _ Attribute.t = + Attribute.declare "blah" + Attribute.Context.expression + Ast_pattern.(__) + ignore +[%%expect{| + +val attr : (expression, unit) Attribute.t = +|}] + +type t = int [@blah] +[%%expect{| + +Line _, characters 15-19: +Error: Attribute `blah' was not used. + Hint: `blah' is available for expressions and type declarations but is + used + here in the context of a core type. + Did you put it at the wrong level? +|}] + +let _ = () [@blah] +[%%expect{| + +Line _, characters 13-17: +Error: Attribute `blah' was not used +|}] + +(* Attribute drops *) + +let faulty_transformation = object + inherit Ast_traverse.map as super + + method! expression e = + match e.pexp_desc with + | Pexp_constant c -> + Ast_builder.Default.pexp_constant ~loc:e.pexp_loc c + | _ -> super#expression e +end +[%%expect{| + +val faulty_transformation : Ast_traverse.map = +|}] + +let () = + Driver.register_transformation "faulty" ~impl:faulty_transformation#structure + +let x = (42 [@foo]) +[%%expect{| + +Line _, characters 14-17: +Error: Attribute `foo' was silently dropped +|}] + +type t1 = < > +type t2 = < t1 > +type t3 = < (t1[@foo]) > +[%%expect{| + +type t1 = < > + +type t2 = < > + +Line _, characters 17-20: +Error: Attribute `foo' was not used +|}] diff --git a/test/extensions_and_deriving/dune b/test/extensions_and_deriving/dune index 06179b3fc..b88be2aec 100644 --- a/test/extensions_and_deriving/dune +++ b/test/extensions_and_deriving/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.10.0")) + (and + (>= %{ocaml_version} "4.10.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/extensions_and_deriving/test_510.ml b/test/extensions_and_deriving/test_510.ml new file mode 100644 index 000000000..f57a05e0a --- /dev/null +++ b/test/extensions_and_deriving/test_510.ml @@ -0,0 +1,148 @@ +open Ppxlib + +(* Generates a [let derived_ = "ok"] or a + [let derived_ = "uninterpreted extension in input"] if + the type manifest is an uninterpreted extension. *) +let deriver = + let binding ~loc type_name expr = + let var_name = "derived_" ^ type_name in + let pat = Ast_builder.Default.ppat_var ~loc {txt = var_name; loc} in + let vb = Ast_builder.Default.value_binding ~loc ~pat ~expr in + [Ast_builder.Default.pstr_value ~loc Nonrecursive [vb]] + in + let str_type_decl = + Deriving.Generator.V2.make_noarg + (fun ~ctxt (_rec_flag, type_decls) -> + let loc = Expansion_context.Deriver.derived_item_loc ctxt in + match type_decls with + | { ptype_manifest = Some {ptyp_desc = Ptyp_extension _; _} + ; ptype_name = {txt; _}; _}::_ -> + binding ~loc txt [%expr "uninterpreted extension in input"] + | {ptype_name = {txt; _}; _}::_ -> + binding ~loc txt [%expr "ok"] + | [] -> assert false) + in + Deriving.add ~str_type_decl "derived" + +[%%expect{| +val deriver : Deriving.t = +|}] + +(* Generates a [type t = int] *) +let gen_type_decl = + Extension.V3.declare + "gen_type_decl" + Extension.Context.structure_item + Ast_pattern.(pstr nil) + (fun ~ctxt -> + let loc = Expansion_context.Extension.extension_point_loc ctxt in + [%stri type t = int]) + |> Context_free.Rule.extension + +let () = Driver.register_transformation ~rules:[gen_type_decl] "gen_type_decl" + +[%%expect{| +val gen_type_decl : Context_free.Rule.t = +|}] + +(* You cannot attach attributes to structure item extension points *) +[%%gen_type_decl] +[@@deriving derived] + +[%%expect{| +Line _, characters 3-19: +Error: Attributes not allowed here +|}] + +(* Generates a [type t = int[@@deriving derived]] *) +let gen_type_decl_with_derived = + Extension.V3.declare + "gen_type_decl_with_derived" + Extension.Context.structure_item + Ast_pattern.(pstr nil) + (fun ~ctxt -> + let loc = Expansion_context.Extension.extension_point_loc ctxt in + [%stri type t = int[@@deriving derived]]) + |> Context_free.Rule.extension + +let () = + Driver.register_transformation + ~rules:[gen_type_decl_with_derived] + "gen_type_decl_with_derived" + +[%%expect{| + +val gen_type_decl_with_derived : Context_free.Rule.t = +|}] + +(* Attributes rule must be applied in code generated by a structure item + extension *) +[%%gen_type_decl_with_derived] + +[%%expect{| + +type t = int +val derived_t : string = "ok" +|}] + +let gen_inline_type_decls_with_derived = + Extension.V3.declare_inline + "gen_inline_type_decls_with_derived" + Extension.Context.structure_item + Ast_pattern.(pstr nil) + (fun ~ctxt -> + let loc = Expansion_context.Extension.extension_point_loc ctxt in + [%str + type t = int[@@deriving derived] + type u = float[@@deriving derived]]) + |> Context_free.Rule.extension + +let () = + Driver.register_transformation + ~rules:[gen_inline_type_decls_with_derived] + "gen_inline_type_decls_with_derived" + +[%%expect{| + +val gen_inline_type_decls_with_derived : Context_free.Rule.t = +|}] + +(* That also stands for inline extension rules *) +[%%gen_inline_type_decls_with_derived] + +[%%expect{| + +type t = int +val derived_t : string = "ok" +type u = float +val derived_u : string = "ok" +|}] + +let id = + Extension.V3.declare + "id" + Extension.Context.core_type + Ast_pattern.(ptyp __) + (fun ~ctxt:_ core_type -> core_type) + |> Context_free.Rule.extension + +let () = Driver.register_transformation ~rules:[id] "id" + +[%%expect{| + +val id : Context_free.Rule.t = +|}] + +(* Nodes with attributes are expanded before attribute-based, inline + code generation rules are applied. + In this below, the `[[%id: int]]` is interpreted before the deriver + is applied, meaning it can't see this extension point in its expand + function argument. *) +type t = [%id: int] +[@@deriving derived] + +[%%expect{| + +type t = int +val derived_t : string = "ok" +|}] diff --git a/test/metaquot/dune b/test/metaquot/dune index 6e6f4e289..1fdc9c178 100644 --- a/test/metaquot/dune +++ b/test/metaquot/dune @@ -1,7 +1,9 @@ (rule (alias runtest) (enabled_if - (>= %{ocaml_version} "4.14.0")) + (and + (>= %{ocaml_version} "4.14.0") + (< %{ocaml_version} "5.1.0"))) (deps (:test test.ml) (package ppxlib)) @@ -11,3 +13,21 @@ (progn (run expect-test %{test}) (diff? %{test} %{test}.corrected))))) + +(rule + (alias runtest) + (enabled_if + (>= %{ocaml_version} "5.1.0")) + (deps + (:test test.ml) + (:t test_510.ml) + (package ppxlib)) + (action + (chdir + %{project_root} + (progn + (run mv %{t} %{t}.old) + (run cp %{test} %{t}) + (run expect-test %{t}) + (run mv %{t}.old %{t}) + (diff? %{t} %{t}.corrected))))) diff --git a/test/metaquot/test_510.ml b/test/metaquot/test_510.ml new file mode 100644 index 000000000..a4cae3339 --- /dev/null +++ b/test/metaquot/test_510.ml @@ -0,0 +1,334 @@ +let loc = Ppxlib.Location.none +[%%expect{| +val loc : Warnings.loc = + {Ppxlib.Location.loc_start = + {Lexing.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = -1}; + loc_end = + {Lexing.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = -1}; + loc_ghost = true} +|}] + +(* unannotated quotations *) + +let _ = [%expr ()] +[%%expect{| +- : Ppxlib.expression = +{Ppxlib_ast.Ast.pexp_desc = + Ppxlib_ast.Ast.Pexp_construct + ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}, + None); + pexp_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pexp_loc_stack = []; pexp_attributes = []} +|}] + +let _ = [%pat? ()] +[%%expect{| +- : Ppxlib.pattern = +{Ppxlib_ast.Ast.ppat_desc = + Ppxlib_ast.Ast.Ppat_construct + ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}, + None); + ppat_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + ppat_loc_stack = []; ppat_attributes = []} +|}] + +let _ = [%type: unit] +[%%expect{| +- : Ppxlib.core_type = +{Ppxlib_ast.Ast.ptyp_desc = + Ppxlib_ast.Ast.Ptyp_constr + ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "unit"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}, + []); + ptyp_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + ptyp_loc_stack = []; ptyp_attributes = []} +|}] + +let _ = [%stri let _ = ()] +[%%expect{| +- : Ppxlib.structure_item = +{Ppxlib_ast.Ast.pstr_desc = + Ppxlib_ast.Ast.Pstr_value (Ppxlib_ast.Ast.Nonrecursive, + [{Ppxlib_ast.Ast.pvb_pat = + {Ppxlib_ast.Ast.ppat_desc = Ppxlib_ast.Ast.Ppat_any; + ppat_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + ppat_loc_stack = []; ppat_attributes = []}; + pvb_expr = + {Ppxlib_ast.Ast.pexp_desc = + Ppxlib_ast.Ast.Pexp_construct + ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; + pos_bol = 0; pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; + pos_bol = 0; pos_cnum = -1}; + loc_ghost = true}}, + None); + pexp_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pexp_loc_stack = []; pexp_attributes = []}; + pvb_attributes = []; + pvb_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}]); + pstr_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}} +|}] + +let _ = [%sigi: include S] +[%%expect{| +- : Ppxlib.signature_item = +{Ppxlib_ast.Ast.psig_desc = + Ppxlib_ast.Ast.Psig_include + {Ppxlib_ast.Ast.pincl_mod = + {Ppxlib_ast.Ast.pmty_desc = + Ppxlib_ast.Ast.Pmty_ident + {Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "S"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}; + pmty_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pmty_attributes = []}; + pincl_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pincl_attributes = []}; + psig_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}} +|}] + +let _ = [%str let _ = ()] +[%%expect{| +- : Ppxlib_ast.Ast.structure = +[{Ppxlib_ast.Ast.pstr_desc = + Ppxlib_ast.Ast.Pstr_value (Ppxlib_ast.Ast.Nonrecursive, + [{Ppxlib_ast.Ast.pvb_pat = + {Ppxlib_ast.Ast.ppat_desc = Ppxlib_ast.Ast.Ppat_any; + ppat_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + ppat_loc_stack = []; ppat_attributes = []}; + pvb_expr = + {Ppxlib_ast.Ast.pexp_desc = + Ppxlib_ast.Ast.Pexp_construct + ({Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "()"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; + pos_bol = 0; pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; + pos_bol = 0; pos_cnum = -1}; + loc_ghost = true}}, + None); + pexp_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pexp_loc_stack = []; pexp_attributes = []}; + pvb_attributes = []; + pvb_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}]); + pstr_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}] +|}] + +let _ = [%sig: include S] +[%%expect{| +- : Ppxlib_ast.Ast.signature = +[{Ppxlib_ast.Ast.psig_desc = + Ppxlib_ast.Ast.Psig_include + {Ppxlib_ast.Ast.pincl_mod = + {Ppxlib_ast.Ast.pmty_desc = + Ppxlib_ast.Ast.Pmty_ident + {Ppxlib_ast.Ast.txt = Ppxlib_ast.Ast.Lident "S"; + loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}; + pmty_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pmty_attributes = []}; + pincl_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}; + pincl_attributes = []}; + psig_loc = + {Ppxlib_ast.Ast.loc_start = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_end = + {Ppxlib_ast.Ast.pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; + pos_cnum = -1}; + loc_ghost = true}}] +|}] + +(* mistyped escapes (not producing ASTs at all) *) + +let _ = [%expr [%e ()]] +[%%expect{| +Line _, characters 19-21: +Error: This expression should not be a unit literal, the expected type is + Ppxlib_ast.Ast.expression +|}] + +let _ = [%pat? [%p ()]] +[%%expect{| + +Line _, characters 19-21: +Error: This expression should not be a unit literal, the expected type is + Ppxlib_ast.Ast.pattern +|}] + +let _ = [%type: [%t ()]] +[%%expect{| + +Line _, characters 20-22: +Error: This expression should not be a unit literal, the expected type is + Ppxlib_ast.Ast.core_type +|}] + +let _ = [%stri [%%i ()]] +[%%expect{| + +Line _, characters 20-22: +Error: This expression should not be a unit literal, the expected type is + Ppxlib_ast.Ast.structure_item +|}] + +let _ = [%sigi: [%%i ()]] +[%%expect{| + +Line _, characters 21-23: +Error: This expression should not be a unit literal, the expected type is + Ppxlib_ast.Ast.signature_item +|}]