From 2599d9728e22eb96b5e5cd402a48696658f42fb5 Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Fri, 4 Apr 2025 10:22:19 +0100 Subject: [PATCH 1/5] Bump trunk CI to 5.4.0 This also updates the easier parts of ppxlib to be compatible with 5.4.0. We will need to version the Location module. Signed-off-by: Patrick Ferris --- .github/workflows/trunk-build.yml | 2 +- ast/supported_version/supported_version.ml | 1 + astlib/config/gen.ml | 1 + dune-project | 2 +- ppxlib.opam | 2 +- 5 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/trunk-build.yml b/.github/workflows/trunk-build.yml index 31448b895..7256536fb 100644 --- a/.github/workflows/trunk-build.yml +++ b/.github/workflows/trunk-build.yml @@ -28,7 +28,7 @@ jobs: - name: Install OCaml compiler uses: ocaml/setup-ocaml@v3 with: - ocaml-compiler: 'ocaml-variants.5.3.1+trunk' + ocaml-compiler: 'ocaml-variants.5.4.0+trunk' dune-cache: true cache-prefix: ${{ steps.setup.outputs.cache_prefix }} diff --git a/ast/supported_version/supported_version.ml b/ast/supported_version/supported_version.ml index ae8a5d566..d0a1aa3d9 100644 --- a/ast/supported_version/supported_version.ml +++ b/ast/supported_version/supported_version.ml @@ -13,6 +13,7 @@ let all = (5, 1); (5, 2); (5, 3); + (5, 4); ] let to_string (a, b) = diff --git a/astlib/config/gen.ml b/astlib/config/gen.ml index 9aecd3994..a23114b87 100644 --- a/astlib/config/gen.ml +++ b/astlib/config/gen.ml @@ -23,6 +23,7 @@ let () = | 5, 1 -> "501" | 5, 2 -> "502" | 5, 3 -> "503" + | 5, 4 -> "504" | _ -> Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str; exit 1) diff --git a/dune-project b/dune-project index 0db92bfff..2dae697ed 100644 --- a/dune-project +++ b/dune-project @@ -16,7 +16,7 @@ (depends ;; 5.3 support is still experimental, remember to set the upper bound ;; to 5.3.0 when cutting a release and then back to 5.4.0 afterwards. - (ocaml (and (and (>= 4.08.0) (< 5.4.0)))) + (ocaml (and (and (>= 4.08.0) (< 5.5.0)))) (ocaml-compiler-libs (>= v0.11.0)) (ppx_derivers (>= 1.0)) (sexplib0 (>= v0.12)) diff --git a/ppxlib.opam b/ppxlib.opam index 2c81c95db..22689098e 100644 --- a/ppxlib.opam +++ b/ppxlib.opam @@ -21,7 +21,7 @@ doc: "https://ocaml-ppx.github.io/ppxlib/" bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" depends: [ "dune" {>= "3.8"} - "ocaml" {>= "4.08.0" & < "5.4.0"} + "ocaml" {>= "4.08.0" & < "5.5.0"} "ocaml-compiler-libs" {>= "v0.11.0"} "ppx_derivers" {>= "1.0"} "sexplib0" {>= "v0.12"} From 46797eb818271473dc04e08d21c79aa004b74fdf Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Sat, 19 Apr 2025 11:13:03 +0100 Subject: [PATCH 2/5] Support OCaml 5.4 Adds support for the OCaml 5.4, mainly versioning the Longident module and handling migrations of tuples with and without labels. Signed-off-by: Patrick Ferris --- .ocamlformat-ignore | 2 + ast/ast_helper_lite.ml | 2 +- ast/ast_helper_lite.mli | 2 +- ast/import.ml | 2 +- ast/versions.ml | 10 + ast/versions.mli | 1 + astlib/ast_408.ml | 1 + astlib/ast_409.ml | 1 + astlib/ast_410.ml | 1 + astlib/ast_411.ml | 1 + astlib/ast_412.ml | 1 + astlib/ast_413.ml | 1 + astlib/ast_414.ml | 1 + astlib/ast_501.ml | 2 + astlib/ast_502.ml | 1 + astlib/ast_503.ml | 1 + astlib/ast_504.ml | 1178 +++++++++++++++ astlib/astlib.ml | 4 + astlib/cinaps/astlib_cinaps_helpers.ml | 1 + astlib/legacy_longident.ml | 31 + astlib/legacy_longident.mli | 15 + astlib/longident.ml | 74 +- astlib/longident.mli | 7 +- astlib/migrate_408_409.ml | 1 + astlib/migrate_409_408.ml | 1 + astlib/migrate_409_410.ml | 1 + astlib/migrate_410_409.ml | 1 + astlib/migrate_410_411.ml | 1 + astlib/migrate_411_410.ml | 1 + astlib/migrate_411_412.ml | 1 + astlib/migrate_412_411.ml | 1 + astlib/migrate_412_413.ml | 1 + astlib/migrate_413_412.ml | 1 + astlib/migrate_413_414.ml | 1 + astlib/migrate_414_413.ml | 1 + astlib/migrate_414_500.ml | 1 + astlib/migrate_500_414.ml | 1 + astlib/migrate_500_501.ml | 1 + astlib/migrate_501_500.ml | 1 + astlib/migrate_501_502.ml | 1 + astlib/migrate_502_501.ml | 1 + astlib/migrate_502_503.ml | 1 + astlib/migrate_503_502.ml | 1 + astlib/migrate_503_504.ml | 1323 ++++++++++++++++ astlib/migrate_504_503.ml | 1340 +++++++++++++++++ astlib/pp/pp_rewrite.mll | 5 +- src/gen/import.ml | 1 + test/base/test.ml | 95 +- .../driver.ml | 7 +- test/expect/dune | 4 + test/expect/expect_test.ml | 6 +- test/type_is_recursive/test.ml | 10 +- 52 files changed, 4116 insertions(+), 35 deletions(-) create mode 100644 astlib/ast_504.ml create mode 100644 astlib/legacy_longident.ml create mode 100644 astlib/legacy_longident.mli create mode 100644 astlib/migrate_503_504.ml create mode 100644 astlib/migrate_504_503.ml diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore index 3fc7eedbf..3f352f42c 100644 --- a/.ocamlformat-ignore +++ b/.ocamlformat-ignore @@ -2,6 +2,7 @@ # and therefore must be excluded from the ocamlformat parsing astlib/location.ml astlib/longident.ml +astlib/longident.mli astlib/astlib.ml astlib/ast_402.ml astlib/ast_403.ml @@ -19,6 +20,7 @@ astlib/ast_414.ml astlib/ast_501.ml astlib/ast_502.ml astlib/ast_503.ml +astlib/ast_504.ml # Files that use cinaps to generate code blocks from other code blocks work well, # but files that inject freely formatted code via cinaps must be excluded diff --git a/ast/ast_helper_lite.ml b/ast/ast_helper_lite.ml index 06b7f5c38..2b30f33be 100644 --- a/ast/ast_helper_lite.ml +++ b/ast/ast_helper_lite.ml @@ -16,7 +16,7 @@ (* TODO: remove this open *) open Stdlib0 module Location = Astlib.Location -module Longident = Astlib.Longident +module Longident = Astlib.Legacy_longident open Astlib.Ast_503 [@@@warning "-9"] diff --git a/ast/ast_helper_lite.mli b/ast/ast_helper_lite.mli index 30a6d1c22..450ee126a 100644 --- a/ast/ast_helper_lite.mli +++ b/ast/ast_helper_lite.mli @@ -21,7 +21,7 @@ open Parsetree type 'a with_loc = 'a Astlib.Location.loc type loc = Astlib.Location.t -type lid = Astlib.Longident.t with_loc +type lid = Astlib.Legacy_longident.t with_loc type str = string with_loc type str_opt = string option with_loc type attrs = attribute list diff --git a/ast/import.ml b/ast/import.ml index d281f178f..3c6603155 100644 --- a/ast/import.ml +++ b/ast/import.ml @@ -193,7 +193,7 @@ module Asttypes = Selected_ast.Ast.Asttypes (* Other Astlib modules *) module Location = Astlib.Location -module Longident = Astlib.Longident +module Longident = Astlib.Legacy_longident module Parse = struct include Astlib.Parse diff --git a/ast/versions.ml b/ast/versions.ml index 23a2f3e03..a2312f4aa 100644 --- a/ast/versions.ml +++ b/ast/versions.ml @@ -647,6 +647,13 @@ module OCaml_503 = struct let string_version = "5.3" end let ocaml_503 : OCaml_503.types ocaml_version = (module OCaml_503) +module OCaml_504 = struct + module Ast = Astlib.Ast_504 + include Make_witness(Astlib.Ast_504) + let version = 504 + let string_version = "5.4" +end +let ocaml_504 : OCaml_504.types ocaml_version = (module OCaml_504) (*$*) let all_versions : (module OCaml_version) list = [ @@ -663,6 +670,7 @@ let all_versions : (module OCaml_version) list = [ (module OCaml_501 : OCaml_version); (module OCaml_502 : OCaml_version); (module OCaml_503 : OCaml_version); +(module OCaml_504 : OCaml_version); (*$*) ] @@ -691,6 +699,8 @@ include Register_migration(OCaml_501)(OCaml_502) (Astlib.Migrate_501_502)(Astlib.Migrate_502_501) include Register_migration(OCaml_502)(OCaml_503) (Astlib.Migrate_502_503)(Astlib.Migrate_503_502) +include Register_migration(OCaml_503)(OCaml_504) + (Astlib.Migrate_503_504)(Astlib.Migrate_504_503) (*$*) module OCaml_current = OCaml_OCAML_VERSION diff --git a/ast/versions.mli b/ast/versions.mli index 2ba8b4f98..7a3b3a73d 100644 --- a/ast/versions.mli +++ b/ast/versions.mli @@ -153,6 +153,7 @@ module OCaml_500 : OCaml_version with module Ast = Astlib.Ast_500 module OCaml_501 : OCaml_version with module Ast = Astlib.Ast_501 module OCaml_502 : OCaml_version with module Ast = Astlib.Ast_502 module OCaml_503 : OCaml_version with module Ast = Astlib.Ast_503 +module OCaml_504 : OCaml_version with module Ast = Astlib.Ast_504 (*$*) (* An alias to the current compiler version *) diff --git a/astlib/ast_408.ml b/astlib/ast_408.ml index 62add0559..0edec1f55 100644 --- a/astlib/ast_408.ml +++ b/astlib/ast_408.ml @@ -27,6 +27,7 @@ Actually run all lib-unix tests [4.08] *) +module Longident = Legacy_longident module Asttypes = struct diff --git a/astlib/ast_409.ml b/astlib/ast_409.ml index 318e8de74..5d881fa82 100644 --- a/astlib/ast_409.ml +++ b/astlib/ast_409.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct diff --git a/astlib/ast_410.ml b/astlib/ast_410.ml index 3cfb3a066..eb17310b1 100644 --- a/astlib/ast_410.ml +++ b/astlib/ast_410.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_411.ml b/astlib/ast_411.ml index 25c17dcb2..e9dea2cf2 100644 --- a/astlib/ast_411.ml +++ b/astlib/ast_411.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_412.ml b/astlib/ast_412.ml index 09a07379f..08db298b8 100644 --- a/astlib/ast_412.ml +++ b/astlib/ast_412.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_413.ml b/astlib/ast_413.ml index fcedd4f4b..f359ab4f5 100644 --- a/astlib/ast_413.ml +++ b/astlib/ast_413.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_414.ml b/astlib/ast_414.ml index 9f214b84e..5ee67d8e4 100644 --- a/astlib/ast_414.ml +++ b/astlib/ast_414.ml @@ -16,6 +16,7 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_501.ml b/astlib/ast_501.ml index 4e0de3173..3dfcb7f4a 100644 --- a/astlib/ast_501.ml +++ b/astlib/ast_501.ml @@ -1,3 +1,5 @@ +module Longident = Legacy_longident + module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_502.ml b/astlib/ast_502.ml index 4a7fc1fde..281a731ac 100644 --- a/astlib/ast_502.ml +++ b/astlib/ast_502.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_503.ml b/astlib/ast_503.ml index 637d2f21a..3665ca94c 100644 --- a/astlib/ast_503.ml +++ b/astlib/ast_503.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_504.ml b/astlib/ast_504.ml new file mode 100644 index 000000000..f6e1a8319 --- /dev/null +++ b/astlib/ast_504.ml @@ -0,0 +1,1178 @@ +module Asttypes = struct + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * Location.t * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive + + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto + + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public + + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable + + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete + + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh + + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open + + type label = string + + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (** [label:T -> ...] *) + | Optional of string (** [?label:T -> ...] *) + + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; + } + + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + | Bivariant + + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity +end + +module Parsetree = struct + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = { + pconst_desc : constant_desc; + pconst_loc : Location.t; + } + + and constant_desc (*IF_CURRENT = Parsetree.constant_desc *) = + | Pconst_integer of string * char option + (** Integer constants such as [3] [3l] [3L] [3n]. + + Suffixes [[g-z][G-Z]] are accepted by the parser. + Suffixes except ['l'], ['L'] and ['n'] are rejected by the typechecker + *) + | Pconst_char of char (** Character such as ['c']. *) + | Pconst_string of string * Location.t * string option + (** Constant string such as ["constant"] or + [{delim|other constant|delim}]. + + The location span the content of the string, without the delimiters. + *) + | Pconst_float of string * char option + (** Float constant such as [3.4], [2e5] or [1.4e-4]. + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + type location_stack = Location.t list + + (** {1 Extension points} *) + + type attribute (*IF_CURRENT = Parsetree.attribute *) = { + attr_name : string loc; + attr_payload : payload; + attr_loc : Location.t; + } + (** Attributes such as [[\@id ARG]] and [[\@\@id ARG]]. + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (** Extension points such as [[%id ARG] and [%%id ARG]]. + + Sub-language placeholder -- rejected by the typechecker. + *) + + and attributes = attribute list + + and payload (*IF_CURRENT = Parsetree.payload *) = + | PStr of structure + | PSig of signature (** [: SIG] in an attribute or an extension point *) + | PTyp of core_type (** [: T] in an attribute or an extension point *) + | PPat of pattern * expression option + (** [? P] or [? P when E], in an attribute or an extension point *) + + (** {1 Core language} *) + (** {2 Type expressions} *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_loc_stack: location_stack; + ptyp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any (** [_] *) + | Ptyp_var of string (** A type variable such as ['a] *) + | Ptyp_arrow of arg_label * core_type * core_type + (** [Ptyp_arrow(lbl, T1, T2)] represents: + - [T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Labelled}[Labelled]}, + - [?l:T1 -> T2] when [lbl] is + {{!Asttypes.arg_label.Optional}[Optional]}. + *) + | Ptyp_tuple of (string option * core_type) list + (** [Ptyp_tuple(tl)] represents a product type: + - [T1 * ... * Tn] + when [tl] is [(None, T1); ...; (None, Tn)] + - [L1:T1 * ... * Ln:Tn] + when [tl] is [(Some L1, T1); ...; (Some Ln, Tn)] + - A mix, e.g., [L1:T1 * T2] + when [tl] is [(Some L1, T1); (None, T2)] *) + | Ptyp_constr of Longident.t loc * core_type list + (** [Ptyp_constr(lident, l)] represents: + - [tconstr] when [l=[]], + - [T tconstr] when [l=[T]], + - [(T1, ..., Tn) tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_object of object_field list * closed_flag + (** [Ptyp_object([ l1:T1; ...; ln:Tn ], flag)] represents: + - [< l1:T1; ...; ln:Tn >] when [flag] is + {{!Asttypes.closed_flag.Closed}[Closed]}, + - [< l1:T1; ...; ln:Tn; .. >] when [flag] is + {{!Asttypes.closed_flag.Open}[Open]}. + *) + | Ptyp_class of Longident.t loc * core_type list + (** [Ptyp_class(tconstr, l)] represents: + - [#tconstr] when [l=[]], + - [T #tconstr] when [l=[T]], + - [(T1, ..., Tn) #tconstr] when [l=[T1 ; ... ; Tn]]. + *) + | Ptyp_alias of core_type * string loc (** [T as 'a]. *) + | Ptyp_variant of row_field list * closed_flag * label list option + (** [Ptyp_variant([`A;`B], flag, labels)] represents: + - [[ `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [None], + - [[> `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Open}[Open]}, + and [labels] is [None], + - [[< `A|`B ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [Some []], + - [[< `A|`B > `X `Y ]] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]}, + and [labels] is [Some ["X";"Y"]]. + *) + | Ptyp_poly of string loc list * core_type + (** ['a1 ... 'an. T] + + Can only appear in the following context: + + - As the {!core_type} of a + {{!pattern_desc.Ppat_constraint}[Ppat_constraint]} node corresponding + to a constraint on a let-binding: + {[let x : 'a1 ... 'an. T = e ...]} + + - Under {{!class_field_kind.Cfk_virtual}[Cfk_virtual]} for methods + (not values). + + - As the {!core_type} of a + {{!class_type_field_desc.Pctf_method}[Pctf_method]} node. + + - As the {!core_type} of a {{!expression_desc.Pexp_poly}[Pexp_poly]} + node. + + - As the {{!label_declaration.pld_type}[pld_type]} field of a + {!label_declaration}. + + - As a {!core_type} of a {{!core_type_desc.Ptyp_object}[Ptyp_object]} + node. + + - As the {{!value_description.pval_type}[pval_type]} field of a + {!value_description}. + *) + | Ptyp_package of package_type (** [(module S)]. *) + | Ptyp_open of Longident.t loc * core_type (** [M.(T)] *) + | Ptyp_extension of extension (** [[%id]]. *) + + and package_type (*IF_CURRENT = Parsetree.package_type *) = + { + ppt_path: Longident.t loc; + ppt_cstrs: (Longident.t loc * core_type) list; + ppt_loc: Location.t; + ppt_attrs: attributes; + } + (** As {!package_type} typed values: + - [{ppt_path: S; ppt_cstrs: []}] represents [(module S)], + - [{ppt_path: S; ppt_cstrs: [(t1, T1) ; ... ; (tn, Tn)]}] + represents [(module S with type t1 = T1 and ... and tn = Tn)]. + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = { + prf_desc : row_field_desc; + prf_loc : Location.t; + prf_attributes : attributes; + } + + and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) = + | Rtag of label loc * bool * core_type list + (** [Rtag(`A, b, l)] represents: + - [`A] when [b] is [true] and [l] is [[]], + - [`A of T] when [b] is [false] and [l] is [[T]], + - [`A of T1 & .. & Tn] when [b] is [false] and [l] is [[T1;...Tn]], + - [`A of & T1 & .. & Tn] when [b] is [true] and [l] is [[T1;...Tn]]. + + - The [bool] field is true if the tag contains a + constant (empty) constructor. + - [&] occurs when several types are used for the same constructor + (see 4.2 in the manual) + *) + | Rinherit of core_type (** [[ | t ]] *) + + and object_field (*IF_CURRENT = Parsetree.object_field *) = { + pof_desc : object_field_desc; + pof_loc : Location.t; + pof_attributes : attributes; + } + + and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) = + | Otag of label loc * core_type + | Oinherit of core_type + + (** {2 Patterns} *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_loc_stack: location_stack; + ppat_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any (** The pattern [_]. *) + | Ppat_var of string loc (** A variable pattern such as [x] *) + | Ppat_alias of pattern * string loc + (** An alias pattern such as [P as 'a] *) + | Ppat_constant of constant + (** Patterns such as [1], ['a'], ["true"], [1.0], [1l], [1L], [1n] *) + | Ppat_interval of constant * constant + (** Patterns such as ['a'..'z']. + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of (string option * pattern) list * Asttypes.closed_flag + (** [Ppat_tuple(pl, Closed)] represents + - [(P1, ..., Pn)] + when [pl] is [(None, P1); ...; (None, Pn)] + - [(~L1:P1, ..., ~Ln:Pn)] + when [pl] is [(Some L1, P1); ...; (Some Ln, Pn)] + - A mix, e.g. [(~L1:P1, P2)] + when [pl] is [(Some L1, P1); (None, P2)] + + [Ppat_tuple(pl, Open)] is similar, but indicates the pattern + additionally ends in a [..]. + + Invariant: + - If Closed, [n >= 2]. + - If Open, [n >= 1]. + *) + | Ppat_construct of Longident.t loc * (string loc list * pattern) option + (** [Ppat_construct(C, args)] represents: + - [C] when [args] is [None], + - [C P] when [args] is [Some ([], P)] + - [C (P1, ..., Pn)] when [args] is + [Some ([], Ppat_tuple [P1; ...; Pn])] + - [C (type a b) P] when [args] is [Some ([a; b], P)] + *) + | Ppat_variant of label * pattern option + (** [Ppat_variant(`A, pat)] represents: + - [`A] when [pat] is [None], + - [`A P] when [pat] is [Some P] + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (** [Ppat_record([(l1, P1) ; ... ; (ln, Pn)], flag)] represents: + - [{ l1=P1; ...; ln=Pn }] + when [flag] is {{!Asttypes.closed_flag.Closed}[Closed]} + - [{ l1=P1; ...; ln=Pn; _}] + when [flag] is {{!Asttypes.closed_flag.Open}[Open]} + + Invariant: [n > 0] + *) + | Ppat_array of pattern list (** Pattern [[| P1; ...; Pn |]] *) + | Ppat_or of pattern * pattern (** Pattern [P1 | P2] *) + | Ppat_constraint of pattern * core_type (** Pattern [(P : T)] *) + | Ppat_type of Longident.t loc (** Pattern [#tconst] *) + | Ppat_lazy of pattern (** Pattern [lazy P] *) + | Ppat_unpack of string option loc + (** [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_effect of pattern * pattern (* Pattern [effect P P] *) + | Ppat_extension of extension (** Pattern [[%id]] *) + | Ppat_open of Longident.t loc * pattern (** Pattern [M.(P)] *) + + (** {2 Value expressions} *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_loc_stack: location_stack; + pexp_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (** Identifiers such as [x] and [M.x] + *) + | Pexp_constant of constant + (** Expressions constant such as [1], ['a'], ["true"], [1.0], [1l], + [1L], [1n] *) + | Pexp_let of rec_flag * value_binding list * expression + (** [Pexp_let(flag, [(P1,E1) ; ... ; (Pn,En)], E)] represents: + - [let P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in E] + when [flag] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pexp_function of + function_param list * type_constraint option * function_body + (** [Pexp_function ([P1; ...; Pn], C, body)] represents any construct + involving [fun] or [function], including: + - [fun P1 ... Pn -> E] + when [body = Pfunction_body E] + - [fun P1 ... Pn -> function p1 -> e1 | ... | pm -> em] + when [body = Pfunction_cases [ p1 -> e1; ...; pm -> em ]] + + [C] represents a type constraint or coercion placed immediately before the + arrow, e.g. [fun P1 ... Pn : ty -> ...] when [C = Some (Pconstraint ty)]. + + A function must have parameters. [Pexp_function (params, _, body)] must + have non-empty [params] or a [Pfunction_cases _] body. + *) + | Pexp_apply of expression * (arg_label * expression) list + (** [Pexp_apply(E0, [(l1, E1) ; ... ; (ln, En)])] + represents [E0 ~l1:E1 ... ~ln:En] + + [li] can be + {{!Asttypes.arg_label.Nolabel}[Nolabel]} (non labeled argument), + {{!Asttypes.arg_label.Labelled}[Labelled]} (labelled arguments) or + {{!Asttypes.arg_label.Optional}[Optional]} (optional argument). + + Invariant: [n > 0] + *) + | Pexp_match of expression * case list + (** [match E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_try of expression * case list + (** [try E0 with P1 -> E1 | ... | Pn -> En] *) + | Pexp_tuple of (string option * expression) list + (** [Pexp_tuple(el)] represents + - [(E1, ..., En)] + when [el] is [(None, E1); ...; (None, En)] + - [(~L1:E1, ..., ~Ln:En)] + when [el] is [(Some L1, E1); ...; (Some Ln, En)] + - A mix, e.g., [(~L1:E1, E2)] + when [el] is [(Some L1, E1); (None, E2)] + *) + | Pexp_construct of Longident.t loc * expression option + (** [Pexp_construct(C, exp)] represents: + - [C] when [exp] is [None], + - [C E] when [exp] is [Some E], + - [C (E1, ..., En)] when [exp] is [Some (Pexp_tuple[E1;...;En])] + *) + | Pexp_variant of label * expression option + (** [Pexp_variant(`A, exp)] represents + - [`A] when [exp] is [None] + - [`A E] when [exp] is [Some E] + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (** [Pexp_record([(l1,P1) ; ... ; (ln,Pn)], exp0)] represents + - [{ l1=P1; ...; ln=Pn }] when [exp0] is [None] + - [{ E0 with l1=P1; ...; ln=Pn }] when [exp0] is [Some E0] + + Invariant: [n > 0] + *) + | Pexp_field of expression * Longident.t loc (** [E.l] *) + | Pexp_setfield of expression * Longident.t loc * expression + (** [E1.l <- E2] *) + | Pexp_array of expression list (** [[| E1; ...; En |]] *) + | Pexp_ifthenelse of expression * expression * expression option + (** [if E1 then E2 else E3] *) + | Pexp_sequence of expression * expression (** [E1; E2] *) + | Pexp_while of expression * expression (** [while E1 do E2 done] *) + | Pexp_for of pattern * expression * expression * direction_flag * expression + (** [Pexp_for(i, E1, E2, direction, E3)] represents: + - [for i = E1 to E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Upto}[Upto]} + - [for i = E1 downto E2 do E3 done] + when [direction] is {{!Asttypes.direction_flag.Downto}[Downto]} + *) + | Pexp_constraint of expression * core_type (** [(E : T)] *) + | Pexp_coerce of expression * core_type option * core_type + (** [Pexp_coerce(E, from, T)] represents + - [(E :> T)] when [from] is [None], + - [(E : T0 :> T)] when [from] is [Some T0]. + *) + | Pexp_send of expression * label loc (** [E # m] *) + | Pexp_new of Longident.t loc (** [new M.c] *) + | Pexp_setinstvar of label loc * expression (** [x <- 2] *) + | Pexp_override of (label loc * expression) list + (** [{< x1 = E1; ...; xn = En >}] *) + | Pexp_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 * package_type option + (** [(module ME)] or [(module ME : S)]. *) + | Pexp_open of open_declaration * expression + (** - [M.(E)] + - [let open M in E] + - [let open! M in E] *) + | Pexp_letop of letop + (** - [let* P = E0 in E1] + - [let* P0 = E00 and* P1 = E01 in E1] *) + | Pexp_extension of extension (** [[%id]] *) + | Pexp_unreachable (** [.] *) + + and case (*IF_CURRENT = Parsetree.case *) = + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + (** Values of type {!case} represents [(P -> E)] or [(P when E0 -> E)] *) + + and letop (*IF_CURRENT = Parsetree.letop *) = + { + let_ : binding_op; + ands : binding_op list; + body : expression; + } + + and binding_op (*IF_CURRENT = Parsetree.binding_op *) = + { + pbop_op : string loc; + pbop_pat : pattern; + pbop_exp : expression; + pbop_loc : Location.t; + } + + and function_param_desc (*IF_CURRENT = Parsetree.function_param_desc *) = + | Pparam_val of arg_label * expression option * pattern + (** [Pparam_val (lbl, exp0, P)] represents the parameter: + - [P] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None] + - [~l:P] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None] + - [?l:P] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None] + - [?l:(P = E0)] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0] + + Note: If [E0] is provided, only + {{!Asttypes.arg_label.Optional}[Optional]} is allowed. + *) + | Pparam_newtype of string loc + (** [Pparam_newtype x] represents the parameter [(type x)]. + [x] carries the location of the identifier, whereas the [pparam_loc] + on the enclosing [function_param] node is the location of the [(type x)] + as a whole. + + Multiple parameters [(type a b c)] are represented as multiple + [Pparam_newtype] nodes, let's say: + + {[ [ { pparam_kind = Pparam_newtype a; pparam_loc = loc1 }; + { pparam_kind = Pparam_newtype b; pparam_loc = loc2 }; + { pparam_kind = Pparam_newtype c; pparam_loc = loc3 }; + ] + ]} + + Here, the first loc [loc1] is the location of [(type a b c)], and the + subsequent locs [loc2] and [loc3] are the same as [loc1], except marked as + ghost locations. The locations on [a], [b], [c], correspond to the + variables [a], [b], and [c] in the source code. + *) + + and function_param (*IF_CURRENT = Parsetree.function_param *) = + { pparam_loc : Location.t; + pparam_desc : function_param_desc; + } + + and function_body (*IF_CURRENT = Parsetree.function_body *) = + | Pfunction_body of expression + | Pfunction_cases of case list * Location.t * attributes + (** In [Pfunction_cases (_, loc, attrs)], the location extends from the + start of the [function] keyword to the end of the last case. The compiler + will only use typechecking-related attributes from [attrs], e.g. enabling + or disabling a warning. + *) + (** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *) + + and type_constraint (*IF_CURRENT = Parsetree.type_constraint *) = + | Pconstraint of core_type + | Pcoerce of core_type option * core_type + (** See the comment on {{!expression_desc.Pexp_function}[Pexp_function]}. *) + + (** {2 Value descriptions} *) + + and value_description (*IF_CURRENT = Parsetree.value_description *) = + { + pval_name: string loc; + pval_type: core_type; + pval_prim: string list; + pval_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pval_loc: Location.t; + } + (** Values of type {!value_description} represents: + - [val x: T], + when {{!value_description.pval_prim}[pval_prim]} is [[]] + - [external x: T = "s1" ... "sn"] + when {{!value_description.pval_prim}[pval_prim]} is [["s1";..."sn"]] + *) + + (** {2 Type declarations} *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * (variance * injectivity)) list; + (** [('a1,...'an) t] *) + ptype_cstrs: (core_type * core_type * Location.t) list; + (** [... constraint T1=T1' ... constraint Tn=Tn'] *) + ptype_kind: type_kind; + ptype_private: private_flag; (** for [= private ...] *) + ptype_manifest: core_type option; (** represents [= T] *) + ptype_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + ptype_loc: Location.t; + } + (** + Here are type declarations and their representation, + for various {{!type_declaration.ptype_kind}[ptype_kind]} + and {{!type_declaration.ptype_manifest}[ptype_manifest]} values: + - [type t] when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [None], + - [type t = T0] + when [type_kind] is {{!type_kind.Ptype_abstract}[Ptype_abstract]}, + and [manifest] is [Some T0], + - [type t = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [None], + - [type t = T0 = C of T | ...] + when [type_kind] is {{!type_kind.Ptype_variant}[Ptype_variant]}, + and [manifest] is [Some T0], + - [type t = {l: T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [None], + - [type t = T0 = {l : T; ...}] + when [type_kind] is {{!type_kind.Ptype_record}[Ptype_record]}, + and [manifest] is [Some T0], + - [type t = ..] + when [type_kind] is {{!type_kind.Ptype_open}[Ptype_open]}, + and [manifest] is [None]. + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + | Ptype_record of label_declaration list (** Invariant: non-empty list *) + | Ptype_open + + and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = + { + pld_name: string loc; + pld_mutable: mutable_flag; + pld_type: core_type; + pld_loc: Location.t; + pld_attributes: attributes; (** [l : T [\@id1] [\@id2]] *) + } + (** + - [{ ...; l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Immutable}[Immutable]}, + - [{ ...; mutable l: T; ... }] + when {{!label_declaration.pld_mutable}[pld_mutable]} + is {{!Asttypes.mutable_flag.Mutable}[Mutable]}. + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_vars: string loc list; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + + and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + (** Values of type {!constructor_declaration} + represents the constructor arguments of: + - [C of T1 * ... * Tn] when [res = None], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C: T0] when [res = Some T0], + and [args = Pcstr_tuple []], + - [C: T1 * ... * Tn -> T0] when [res = Some T0], + and [args = Pcstr_tuple [T1; ... ; Tn]], + - [C of {...}] when [res = None], + and [args = Pcstr_record [...]], + - [C: {...} -> T0] when [res = Some T0], + and [args = Pcstr_record [...]]. + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * (variance * injectivity)) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (** ... [\@\@id1] [\@\@id2] *) + } + (** + Definition of new extensions constructors for the extensive sum type [t] + ([type t += ...]). + *) + + and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = + { + pext_name: string loc; + pext_kind: extension_constructor_kind; + pext_loc: Location.t; + pext_attributes: attributes; (** [C of ... [\@id1] [\@id2]] *) + } + + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor : extension_constructor; + ptyexn_loc : Location.t; + ptyexn_attributes : attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + (** Definition of a new exception ([exception E]). *) + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + | Pext_decl of string loc list * constructor_arguments * core_type option + (** [Pext_decl(existentials, c_args, t_opt)] + describes a new extension constructor. It can be: + - [C of T1 * ... * Tn] when: + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [None]}.} + - [C: T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[]],} + {- [t_opt] is [Some T0].}} + - [C: T1 * ... * Tn -> T0] when + {ul {- [existentials] is [[]],} + {- [c_args] is [[T1; ...; Tn]],} + {- [t_opt] is [Some T0].}} + - [C: 'a... . T1 * ... * Tn -> T0] when + {ul {- [existentials] is [['a;...]],} + {- [c_args] is [[T1; ... ; Tn]],} + {- [t_opt] is [Some T0].}} + *) + | Pext_rebind of Longident.t loc + (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *) + + (** {1 Class language} *) + (** {2 Type expressions for the class language} *) + + and class_type (*IF_CURRENT = Parsetree.class_type *) = + { + pcty_desc: class_type_desc; + pcty_loc: Location.t; + pcty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = + | Pcty_constr of Longident.t loc * core_type list + (** - [c] + - [['a1, ..., 'an] c] *) + | Pcty_signature of class_signature (** [object ... end] *) + | Pcty_arrow of arg_label * core_type * class_type + (** [Pcty_arrow(lbl, T, CT)] represents: + - [T -> CT] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]}, + - [~l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]}, + - [?l:T -> CT] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]}. + *) + | Pcty_extension of extension (** [%id] *) + | Pcty_open of open_description * class_type (** [let open M in CT] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (** Values of type [class_signature] represents: + - [object('selfpat) ... end] + - [object ... end] when {{!class_signature.pcsig_self}[pcsig_self]} + is {{!core_type_desc.Ptyp_any}[Ptyp_any]} + *) + + and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = + { + pctf_desc: class_type_field_desc; + pctf_loc: Location.t; + pctf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + + and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = + | Pctf_inherit of class_type (** [inherit CT] *) + | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) + (** [val x: T] *) + | Pctf_method of (label loc * private_flag * virtual_flag * core_type) + (** [method x: T] + + Note: [T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}. + *) + | Pctf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pctf_attribute of attribute (** [[\@\@\@id]] *) + | Pctf_extension of extension (** [[%%id]] *) + + and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = + { + pci_virt: virtual_flag; + pci_params: (core_type * (variance * injectivity)) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + (** Values of type [class_expr class_infos] represents: + - [class c = ...] + - [class ['a1,...,'an] c = ...] + - [class virtual c = ...] + + They are also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (** {2 Value expressions for the class language} *) + + and class_expr (*IF_CURRENT = Parsetree.class_expr *) = + { + pcl_desc: class_expr_desc; + pcl_loc: Location.t; + pcl_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = + | Pcl_constr of Longident.t loc * core_type list + (** [c] and [['a1, ..., 'an] c] *) + | Pcl_structure of class_structure (** [object ... end] *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (** [Pcl_fun(lbl, exp0, P, CE)] represents: + - [fun P -> CE] + when [lbl] is {{!Asttypes.arg_label.Nolabel}[Nolabel]} + and [exp0] is [None], + - [fun ~l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Labelled}[Labelled l]} + and [exp0] is [None], + - [fun ?l:P -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [None], + - [fun ?l:(P = E0) -> CE] + when [lbl] is {{!Asttypes.arg_label.Optional}[Optional l]} + and [exp0] is [Some E0]. + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (** [Pcl_apply(CE, [(l1,E1) ; ... ; (ln,En)])] + represents [CE ~l1:E1 ... ~ln:En]. + [li] can be empty (non labeled argument) or start with [?] + (optional argument). + + Invariant: [n > 0] + *) + | Pcl_let of rec_flag * value_binding list * class_expr + (** [Pcl_let(rec, [(P1, E1); ... ; (Pn, En)], CE)] represents: + - [let P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN in CE] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pcl_constraint of class_expr * class_type (** [(CE : CT)] *) + | Pcl_extension of extension (** [[%id]] *) + | Pcl_open of open_description * class_expr (** [let open M in CE] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (** Values of type {!class_structure} represents: + - [object(selfpat) ... end] + - [object ... end] when {{!class_structure.pcstr_self}[pcstr_self]} + is {{!pattern_desc.Ppat_any}[Ppat_any]} + *) + + and class_field (*IF_CURRENT = Parsetree.class_field *) = + { + pcf_desc: class_field_desc; + pcf_loc: Location.t; + pcf_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + } + + and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = + | Pcf_inherit of override_flag * class_expr * string loc option + (** [Pcf_inherit(flag, CE, s)] represents: + - [inherit CE] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [None], + - [inherit CE as x] + when [flag] is {{!Asttypes.override_flag.Fresh}[Fresh]} + and [s] is [Some x], + - [inherit! CE] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [None], + - [inherit! CE as x] + when [flag] is {{!Asttypes.override_flag.Override}[Override]} + and [s] is [Some x] + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (** [Pcf_val(x,flag, kind)] represents: + - [val x = E] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Immutable}[Immutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + - [val mutable x = E] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_concrete}[Cfk_concrete(Fresh, E)]} + - [val mutable virtual x: T] + when [flag] is {{!Asttypes.mutable_flag.Mutable}[Mutable]} + and [kind] is {{!class_field_kind.Cfk_virtual}[Cfk_virtual(T)]} + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (** - [method x = E] + ([E] can be a {{!expression_desc.Pexp_poly}[Pexp_poly]}) + - [method virtual x: T] + ([T] can be a {{!core_type_desc.Ptyp_poly}[Ptyp_poly]}) + *) + | Pcf_constraint of (core_type * core_type) (** [constraint T1 = T2] *) + | Pcf_initializer of expression (** [initializer E] *) + | Pcf_attribute of attribute (** [[\@\@\@id]] *) + | Pcf_extension of extension (** [[%%id]] *) + + and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = + | Cfk_virtual of core_type + | Cfk_concrete of override_flag * expression + + and class_declaration = class_expr class_infos + + (** {1 Module language} *) + (** {2 Type expressions for the module language} *) + + and module_type (*IF_CURRENT = Parsetree.module_type *) = + { + pmty_desc: module_type_desc; + pmty_loc: Location.t; + pmty_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = + | Pmty_ident of Longident.t loc (** [Pmty_ident(S)] represents [S] *) + | Pmty_signature of signature (** [sig ... end] *) + | Pmty_functor of functor_parameter * module_type + (** [functor(X : MT1) -> MT2] *) + | Pmty_with of module_type * with_constraint list (** [MT with ...] *) + | Pmty_typeof of module_expr (** [module type of ME] *) + | Pmty_extension of extension (** [[%id]] *) + | Pmty_alias of Longident.t loc (** [(module M)] *) + + and functor_parameter (*IF_CURRENT = Parsetree.functor_parameter *) = + | Unit (** [()] *) + | Named of string option loc * module_type + (** [Named(name, MT)] represents: + - [(X : MT)] when [name] is [Some X], + - [(_ : MT)] when [name] is [None] *) + + and signature = signature_item list + + and signature_item (*IF_CURRENT = Parsetree.signature_item *) = + { + psig_desc: signature_item_desc; + psig_loc: Location.t; + } + + and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = + | Psig_value of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn"] + *) + | Psig_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Psig_typesubst of type_declaration list + (** [type t1 := ... and ... and tn := ...] *) + | Psig_typext of type_extension (** [type t1 += ...] *) + | Psig_exception of type_exception (** [exception C of T] *) + | Psig_module of module_declaration (** [module X = M] and [module X : MT] *) + | Psig_modsubst of module_substitution (** [module X := M] *) + | Psig_recmodule of module_declaration list + (** [module rec X1 : MT1 and ... and Xn : MTn] *) + | Psig_modtype of module_type_declaration + (** [module type S = MT] and [module type S] *) + | Psig_modtypesubst of module_type_declaration + (** [module type S := ...] *) + | Psig_open of open_description (** [open X] *) + | Psig_include of include_description (** [include MT] *) + | Psig_class of class_description list + (** [class c1 : ... and ... and cn : ...] *) + | Psig_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Psig_attribute of attribute (** [[\@\@\@id]] *) + | Psig_extension of extension * attributes (** [[%%id]] *) + + and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = + { + pmd_name: string option loc; + pmd_type: module_type; + pmd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmd_loc: Location.t; + } + (** Values of type [module_declaration] represents [S : MT] *) + + and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) = + { + pms_name: string loc; + pms_manifest: Longident.t loc; + pms_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pms_loc: Location.t; + } + (** Values of type [module_substitution] represents [S := M] *) + + and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = + { + pmtd_name: string loc; + pmtd_type: module_type option; + pmtd_attributes: attributes; (** [... [\@\@id1] [\@\@id2]] *) + pmtd_loc: Location.t; + } + (** Values of type [module_type_declaration] represents: + - [S = MT], + - [S] for abstract module type declaration, + when {{!module_type_declaration.pmtd_type}[pmtd_type]} is [None]. + *) + + and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) = + { + popen_expr: 'a; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (** Values of type ['a open_infos] represents: + - [open! X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Override}[Override]} + (silences the "used identifier shadowing" warning) + - [open X] when {{!open_infos.popen_override}[popen_override]} + is {{!Asttypes.override_flag.Fresh}[Fresh]} + *) + + and open_description = Longident.t loc open_infos + (** Values of type [open_description] represents: + - [open M.N] + - [open M(N).O] *) + + and open_declaration = module_expr open_infos + (** Values of type [open_declaration] represents: + - [open M.N] + - [open M(N).O] + - [open struct ... end] *) + + and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = + { + pincl_mod: 'a; + pincl_loc: Location.t; + pincl_attributes: attributes; + } + + and include_description = module_type include_infos + (** Values of type [include_description] represents [include MT] *) + + and include_declaration = module_expr include_infos + (** Values of type [include_declaration] represents [include ME] *) + + and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = + | Pwith_type of Longident.t loc * type_declaration + (** [with type X.t = ...] + + Note: the last component of the longident must match + the name of the type_declaration. *) + | Pwith_module of Longident.t loc * Longident.t loc + (** [with module X.Y = Z] *) + | Pwith_modtype of Longident.t loc * module_type + (** [with module type X.Y = Z] *) + | Pwith_modtypesubst of Longident.t loc * module_type + (** [with module type X.Y := sig end] *) + | Pwith_typesubst of Longident.t loc * type_declaration + (** [with type X.t := ..., same format as [Pwith_type]] *) + | Pwith_modsubst of Longident.t loc * Longident.t loc + (** [with module X.Y := Z] *) + + (** {2 Value expressions for the module language} *) + + and module_expr (*IF_CURRENT = Parsetree.module_expr *) = + { + pmod_desc: module_expr_desc; + pmod_loc: Location.t; + pmod_attributes: attributes; (** [... [\@id1] [\@id2]] *) + } + + and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = + | Pmod_ident of Longident.t loc (** [X] *) + | Pmod_structure of structure (** [struct ... end] *) + | Pmod_functor of functor_parameter * module_expr + (** [functor(X : MT1) -> ME] *) + | Pmod_apply of module_expr * module_expr (** [ME1(ME2)] *) + | Pmod_apply_unit of module_expr (** [ME1()] *) + | Pmod_constraint of module_expr * module_type (** [(ME : MT)] *) + | Pmod_unpack of expression (** [(val E)] *) + | Pmod_extension of extension (** [[%id]] *) + + and structure = structure_item list + + and structure_item (*IF_CURRENT = Parsetree.structure_item *) = + { + pstr_desc: structure_item_desc; + pstr_loc: Location.t; + } + + and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = + | Pstr_eval of expression * attributes (** [E] *) + | Pstr_value of rec_flag * value_binding list + (** [Pstr_value(rec, [(P1, E1 ; ... ; (Pn, En))])] represents: + - [let P1 = E1 and ... and Pn = EN] + when [rec] is {{!Asttypes.rec_flag.Nonrecursive}[Nonrecursive]}, + - [let rec P1 = E1 and ... and Pn = EN ] + when [rec] is {{!Asttypes.rec_flag.Recursive}[Recursive]}. + *) + | Pstr_primitive of value_description + (** - [val x: T] + - [external x: T = "s1" ... "sn" ]*) + | Pstr_type of rec_flag * type_declaration list + (** [type t1 = ... and ... and tn = ...] *) + | Pstr_typext of type_extension (** [type t1 += ...] *) + | Pstr_exception of type_exception + (** - [exception C of T] + - [exception C = M.X] *) + | Pstr_module of module_binding (** [module X = ME] *) + | Pstr_recmodule of module_binding list + (** [module rec X1 = ME1 and ... and Xn = MEn] *) + | Pstr_modtype of module_type_declaration (** [module type S = MT] *) + | Pstr_open of open_declaration (** [open X] *) + | Pstr_class of class_declaration list + (** [class c1 = ... and ... and cn = ...] *) + | Pstr_class_type of class_type_declaration list + (** [class type ct1 = ... and ... and ctn = ...] *) + | Pstr_include of include_declaration (** [include ME] *) + | Pstr_attribute of attribute (** [[\@\@\@id]] *) + | Pstr_extension of extension * attributes (** [[%%id]] *) + + and value_constraint (*IF_CURRENT = Parsetree.value_constraint *) = + | Pvc_constraint of { + locally_abstract_univars:string loc list; + typ:core_type; + } + | Pvc_coercion of {ground:core_type option; coercion:core_type } + (** + - [Pvc_constraint { locally_abstract_univars=[]; typ}] + is a simple type constraint on a value binding: [ let x : typ] + - More generally, in [Pvc_constraint { locally_abstract_univars; typ}] + [locally_abstract_univars] is the list of locally abstract type + variables in [ let x: type a ... . typ ] + - [Pvc_coercion { ground=None; coercion }] represents [let x :> typ] + - [Pvc_coercion { ground=Some g; coercion }] represents [let x : g :> typ] + *) + + and value_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_constraint: value_constraint option; + pvb_attributes: attributes; + pvb_loc: Location.t; + }(** [let pat : type_constraint = exp] *) + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string option loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (** Values of type [module_binding] represents [module X = ME] *) + + (** {1 Toplevel} *) + + (** {2 Toplevel phrases} *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of toplevel_directive (** [#use], [#load] ... *) + + and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) = + { + pdir_name: string loc; + pdir_arg: directive_argument option; + pdir_loc: Location.t; + } + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + { + pdira_desc: directive_argument_desc; + pdira_loc: Location.t; + } + + and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) = + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M035" + let ast_intf_magic_number = "Caml1999N035" +end diff --git a/astlib/astlib.ml b/astlib/astlib.ml index c6ab1920d..c8525453d 100644 --- a/astlib/astlib.ml +++ b/astlib/astlib.ml @@ -33,6 +33,7 @@ module Ast_500 = Ast_500 module Ast_501 = Ast_501 module Ast_502 = Ast_502 module Ast_503 = Ast_503 +module Ast_504 = Ast_504 (*$*) (* Manual migration between versions *) @@ -61,6 +62,8 @@ module Migrate_501_502 = Migrate_501_502 module Migrate_502_501 = Migrate_502_501 module Migrate_502_503 = Migrate_502_503 module Migrate_503_502 = Migrate_503_502 +module Migrate_503_504 = Migrate_503_504 +module Migrate_504_503 = Migrate_504_503 (*$*) (* Compiler modules *) @@ -68,6 +71,7 @@ module Ast_metadata = Ast_metadata module Config = Config module Keyword = Keyword module Location = Location +module Legacy_longident = Legacy_longident module Longident = Longident module Parse = Parse module Pprintast = Pprintast diff --git a/astlib/cinaps/astlib_cinaps_helpers.ml b/astlib/cinaps/astlib_cinaps_helpers.ml index 513c62e92..23afa5eb4 100644 --- a/astlib/cinaps/astlib_cinaps_helpers.ml +++ b/astlib/cinaps/astlib_cinaps_helpers.ml @@ -18,6 +18,7 @@ let supported_versions = ("501", "5.01"); ("502", "5.02"); ("503", "5.03"); + ("504", "5.04"); ] let foreach_version f = diff --git a/astlib/legacy_longident.ml b/astlib/legacy_longident.ml new file mode 100644 index 000000000..a5bb3e8f9 --- /dev/null +++ b/astlib/legacy_longident.ml @@ -0,0 +1,31 @@ +type t = + (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) + | Lident of string + | Ldot of t * string + | Lapply of t * t + +let rec flat accu = function + | Lident s -> s :: accu + | Ldot (lid, s) -> flat (s :: accu) lid + | Lapply (_, _) -> Misc.fatal_error "Longident.flat" + +let flatten lid = flat [] lid + +let rec split_at_dots s pos = + try + let dot = String.index_from s pos '.' in + String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) + with Not_found -> [ String.sub s pos (String.length s - pos) ] + +let unflatten l = + match l with + | [] -> None + | hd :: tl -> Some (List.fold_left (fun p s -> Ldot (p, s)) (Lident hd) tl) + +let parse s = + match unflatten (split_at_dots s 0) with + | None -> + Lident "" + (* should not happen, but don't put assert false + so as not to crash the toplevel (see Genprintval) *) + | Some v -> v diff --git a/astlib/legacy_longident.mli b/astlib/legacy_longident.mli new file mode 100644 index 000000000..c5fe735af --- /dev/null +++ b/astlib/legacy_longident.mli @@ -0,0 +1,15 @@ +(** Long identifiers, used in parsetrees. *) + +(** The long identifier type *) +type t = + (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) + | Lident of string + | Ldot of t * string + | Lapply of t * t + +val flatten : t -> string list +(** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting + [Lapply].*) + +val parse : string -> t +(** Parse a string into a long identifier built upon [Lident] and [Ldot]. *) diff --git a/astlib/longident.ml b/astlib/longident.ml index ffc3a9fda..78d3ed722 100644 --- a/astlib/longident.ml +++ b/astlib/longident.ml @@ -1,5 +1,73 @@ -include Ocaml_common.Longident +(**************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. *) +(* *) +(* All rights reserved. This file is distributed under the terms of *) +(* the GNU Lesser General Public License version 2.1, with the *) +(* special exception on linking described in the file LICENSE. *) +(* *) +(**************************************************************************) +open Location + +type t = (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *) + Lident of string + | Ldot of t loc * string loc + | Lapply of t loc * t loc + + +let rec same t t' = + t == t' + || match t, t' with + | Lident s, Lident s' -> + String.equal s s' + | Ldot ({ txt = t; _ }, { txt = s; _ }), + Ldot ({ txt = t'; _ }, { txt = s'; _ }) -> + if String.equal s s' then + same t t' + else + false + | Lapply ({ txt = tl; _ }, { txt = tr; _ }), + Lapply ({ txt = tl'; _ }, { txt = tr'; _ }) -> + same tl tl' && same tr tr' + | _, _ -> false + + +let rec flat accu = function + Lident s -> s :: accu + | Ldot({ txt = lid; _ }, { txt = s; _ }) -> flat (s :: accu) lid + | Lapply(_, _) -> Misc.fatal_error "Longident.flat" + +let flatten lid = flat [] lid + +let last = function + Lident s -> s + | Ldot(_, s) -> s.txt + | Lapply(_, _) -> Misc.fatal_error "Longident.last" + + +let rec split_at_dots s pos = + try + let dot = String.index_from s pos '.' in + String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) + with Not_found -> + [String.sub s pos (String.length s - pos)] + +let mknoloc txt = { txt; loc = Location.none } + +let unflatten l = + match l with + | [] -> None + | hd :: tl -> + Some (List.fold_left (fun p s -> Ldot(mknoloc p, mknoloc s)) + (Lident hd) tl) let parse s = - (*IF_NOT_AT_LEAST 411 parse s *) - (*IF_AT_LEAST 411 Ocaml_common.Parse.longident @@ Lexing.from_string @@ s *) + match unflatten (split_at_dots s 0) with + | None -> Lident "" (* should not happen, but don't put assert false + so as not to crash the toplevel (see Genprintval) *) + | Some v -> v diff --git a/astlib/longident.mli b/astlib/longident.mli index 4e986deab..3bca23837 100644 --- a/astlib/longident.mli +++ b/astlib/longident.mli @@ -1,10 +1,11 @@ (** Long identifiers, used in parsetrees. *) +open Location (** The long identifier type *) -type t = Ocaml_common.Longident.t = +type t = (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *) | Lident of string - | Ldot of t * string - | Lapply of t * t + | Ldot of t loc * string loc + | Lapply of t loc * t loc val flatten : t -> string list (** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting diff --git a/astlib/migrate_408_409.ml b/astlib/migrate_408_409.ml index 754910f3a..f2042a9e0 100644 --- a/astlib/migrate_408_409.ml +++ b/astlib/migrate_408_409.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_408 module To = Ast_409 diff --git a/astlib/migrate_409_408.ml b/astlib/migrate_409_408.ml index bc9ab219a..8d0e9ed8c 100644 --- a/astlib/migrate_409_408.ml +++ b/astlib/migrate_409_408.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_409 module To = Ast_408 diff --git a/astlib/migrate_409_410.ml b/astlib/migrate_409_410.ml index af4b7308f..89fca12f7 100644 --- a/astlib/migrate_409_410.ml +++ b/astlib/migrate_409_410.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module From = Ast_409 module To = Ast_410 diff --git a/astlib/migrate_410_409.ml b/astlib/migrate_410_409.ml index d1298e0c6..5bcb889ff 100644 --- a/astlib/migrate_410_409.ml +++ b/astlib/migrate_410_409.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module From = Ast_410 module To = Ast_409 diff --git a/astlib/migrate_410_411.ml b/astlib/migrate_410_411.ml index be4d78e46..1b66d9691 100644 --- a/astlib/migrate_410_411.ml +++ b/astlib/migrate_410_411.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_410 module To = Ast_411 diff --git a/astlib/migrate_411_410.ml b/astlib/migrate_411_410.ml index ad1def34a..20a80eef1 100644 --- a/astlib/migrate_411_410.ml +++ b/astlib/migrate_411_410.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_411 module To = Ast_410 diff --git a/astlib/migrate_411_412.ml b/astlib/migrate_411_412.ml index 7861486e6..a9165b53e 100644 --- a/astlib/migrate_411_412.ml +++ b/astlib/migrate_411_412.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_411 module To = Ast_412 diff --git a/astlib/migrate_412_411.ml b/astlib/migrate_412_411.ml index 8d423c7f6..bcab203c4 100644 --- a/astlib/migrate_412_411.ml +++ b/astlib/migrate_412_411.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_412 module To = Ast_411 diff --git a/astlib/migrate_412_413.ml b/astlib/migrate_412_413.ml index 26c15e8f2..7e97eeb45 100644 --- a/astlib/migrate_412_413.ml +++ b/astlib/migrate_412_413.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_412 module To = Ast_413 diff --git a/astlib/migrate_413_412.ml b/astlib/migrate_413_412.ml index 350882ac6..c84a05e61 100644 --- a/astlib/migrate_413_412.ml +++ b/astlib/migrate_413_412.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_413 module To = Ast_412 diff --git a/astlib/migrate_413_414.ml b/astlib/migrate_413_414.ml index 7a9fe7f2a..d7e1b61e9 100644 --- a/astlib/migrate_413_414.ml +++ b/astlib/migrate_413_414.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_413 module To = Ast_414 diff --git a/astlib/migrate_414_413.ml b/astlib/migrate_414_413.ml index 90c268ba9..e5963d82e 100644 --- a/astlib/migrate_414_413.ml +++ b/astlib/migrate_414_413.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_414 module To = Ast_413 diff --git a/astlib/migrate_414_500.ml b/astlib/migrate_414_500.ml index 084692807..6aee122a8 100644 --- a/astlib/migrate_414_500.ml +++ b/astlib/migrate_414_500.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module From = Ast_414 module To = Ast_500 diff --git a/astlib/migrate_500_414.ml b/astlib/migrate_500_414.ml index 6b625e209..da2604a0e 100644 --- a/astlib/migrate_500_414.ml +++ b/astlib/migrate_500_414.ml @@ -1,3 +1,4 @@ +module Longident = Legacy_longident module From = Ast_500 module To = Ast_414 diff --git a/astlib/migrate_500_501.ml b/astlib/migrate_500_501.ml index c7d41dbc3..8c2dd1d30 100644 --- a/astlib/migrate_500_501.ml +++ b/astlib/migrate_500_501.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_500 module To = Ast_501 diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml index 4c6f05e1e..3d6be3c49 100644 --- a/astlib/migrate_501_500.ml +++ b/astlib/migrate_501_500.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_501 module To = Ast_500 diff --git a/astlib/migrate_501_502.ml b/astlib/migrate_501_502.ml index 102118c05..68693f088 100644 --- a/astlib/migrate_501_502.ml +++ b/astlib/migrate_501_502.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_501 module To = Ast_502 diff --git a/astlib/migrate_502_501.ml b/astlib/migrate_502_501.ml index 50ae5c76c..4818c8f8c 100644 --- a/astlib/migrate_502_501.ml +++ b/astlib/migrate_502_501.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_502 module To = Ast_501 diff --git a/astlib/migrate_502_503.ml b/astlib/migrate_502_503.ml index fe600b21f..1624cccdb 100644 --- a/astlib/migrate_502_503.ml +++ b/astlib/migrate_502_503.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_502 module To = Ast_503 diff --git a/astlib/migrate_503_502.ml b/astlib/migrate_503_502.ml index 3f55081d3..f852832ba 100644 --- a/astlib/migrate_503_502.ml +++ b/astlib/migrate_503_502.ml @@ -1,4 +1,5 @@ open Stdlib0 +module Longident = Legacy_longident module From = Ast_503 module To = Ast_502 diff --git a/astlib/migrate_503_504.ml b/astlib/migrate_503_504.ml new file mode 100644 index 000000000..b5d111be1 --- /dev/null +++ b/astlib/migrate_503_504.ml @@ -0,0 +1,1323 @@ +open Stdlib0 +module From = Ast_503 +module To = Ast_504 + +let rec copy_toplevel_phrase : + Ast_503.Parsetree.toplevel_phrase -> Ast_504.Parsetree.toplevel_phrase = + function + | Ast_503.Parsetree.Ptop_def x0 -> + Ast_504.Parsetree.Ptop_def (copy_structure x0) + | Ast_503.Parsetree.Ptop_dir x0 -> + Ast_504.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_503.Parsetree.toplevel_directive -> Ast_504.Parsetree.toplevel_directive + = + fun { + Ast_503.Parsetree.pdir_name; + Ast_503.Parsetree.pdir_arg; + Ast_503.Parsetree.pdir_loc; + } -> + { + Ast_504.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_504.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_504.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_503.Parsetree.directive_argument -> Ast_504.Parsetree.directive_argument + = + fun { Ast_503.Parsetree.pdira_desc; Ast_503.Parsetree.pdira_loc } -> + { + Ast_504.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_504.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_503.Parsetree.directive_argument_desc -> + Ast_504.Parsetree.directive_argument_desc = function + | Ast_503.Parsetree.Pdir_string x0 -> Ast_504.Parsetree.Pdir_string x0 + | Ast_503.Parsetree.Pdir_int (x0, x1) -> + Ast_504.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_503.Parsetree.Pdir_ident x0 -> + Ast_504.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_503.Parsetree.Pdir_bool x0 -> Ast_504.Parsetree.Pdir_bool x0 + +and copy_expression : + Ast_503.Parsetree.expression -> Ast_504.Parsetree.expression = + fun { + Ast_503.Parsetree.pexp_desc; + Ast_503.Parsetree.pexp_loc; + Ast_503.Parsetree.pexp_loc_stack; + Ast_503.Parsetree.pexp_attributes; + } -> + let loc = copy_location pexp_loc in + { + Ast_504.Parsetree.pexp_desc = copy_expression_desc_with_loc ~loc pexp_desc; + Ast_504.Parsetree.pexp_loc = loc; + Ast_504.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_504.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_503.Parsetree.expression_desc -> Ast_504.Parsetree.expression_desc = + fun desc -> copy_expression_desc_with_loc ~loc:Location.none desc + +and copy_expression_desc_with_loc : + loc:Location.t -> + Ast_503.Parsetree.expression_desc -> + Ast_504.Parsetree.expression_desc = + fun ~loc desc -> + match desc with + | Ast_503.Parsetree.Pexp_ident x0 -> + Ast_504.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_503.Parsetree.Pexp_constant x0 -> + let loc = { loc with loc_ghost = true } in + let constant = { (copy_constant x0) with pconst_loc = loc } in + Ast_504.Parsetree.Pexp_constant constant + | Ast_503.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_503.Parsetree.Pexp_function (params, typ_constraint, fun_body) -> + let params = List.map copy_function_param params in + let typ_constraint = Option.map copy_type_constraint typ_constraint in + let fun_body = copy_function_body fun_body in + Ast_504.Parsetree.Pexp_function (params, typ_constraint, fun_body) + | Ast_503.Parsetree.Pexp_apply (x0, x1) -> + Ast_504.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_503.Parsetree.Pexp_match (x0, x1) -> + Ast_504.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_503.Parsetree.Pexp_try (x0, x1) -> + Ast_504.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_503.Parsetree.Pexp_tuple x0 -> + Ast_504.Parsetree.Pexp_tuple + (List.map (fun v -> (None, copy_expression v)) x0) + | Ast_503.Parsetree.Pexp_construct (x0, x1) -> + Ast_504.Parsetree.Pexp_construct + (copy_loc copy_Longident_t x0, Option.map copy_expression x1) + | Ast_503.Parsetree.Pexp_variant (x0, x1) -> + Ast_504.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_503.Parsetree.Pexp_record (x0, x1) -> + Ast_504.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_503.Parsetree.Pexp_field (x0, x1) -> + Ast_504.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_Longident_t x1) + | Ast_503.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_Longident_t x1, copy_expression x2) + | Ast_503.Parsetree.Pexp_array x0 -> + Ast_504.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_503.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_503.Parsetree.Pexp_sequence (x0, x1) -> + Ast_504.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_while (x0, x1) -> + Ast_504.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_504.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_503.Parsetree.Pexp_constraint (x0, x1) -> + Ast_504.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_503.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_503.Parsetree.Pexp_send (x0, x1) -> + Ast_504.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_503.Parsetree.Pexp_new x0 -> + Ast_504.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_503.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_504.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_override x0 -> + Ast_504.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_503.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_504.Parsetree.Pexp_letmodule + ( copy_loc (fun x -> Option.map (fun x -> x) x) x0, + copy_module_expr x1, + copy_expression x2 ) + | Ast_503.Parsetree.Pexp_letexception (x0, x1) -> + Ast_504.Parsetree.Pexp_letexception + (copy_extension_constructor x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_assert x0 -> + Ast_504.Parsetree.Pexp_assert (copy_expression x0) + | Ast_503.Parsetree.Pexp_lazy x0 -> + Ast_504.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_503.Parsetree.Pexp_poly (x0, x1) -> + Ast_504.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_503.Parsetree.Pexp_object x0 -> + Ast_504.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_503.Parsetree.Pexp_newtype (x0, x1) -> + Ast_504.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_pack x0 -> + Ast_504.Parsetree.Pexp_pack (copy_module_expr x0, None) + | Ast_503.Parsetree.Pexp_open (x0, x1) -> + Ast_504.Parsetree.Pexp_open (copy_open_declaration x0, copy_expression x1) + | Ast_503.Parsetree.Pexp_letop x0 -> + Ast_504.Parsetree.Pexp_letop (copy_letop x0) + | Ast_503.Parsetree.Pexp_extension x0 -> + Ast_504.Parsetree.Pexp_extension (copy_extension x0) + | Ast_503.Parsetree.Pexp_unreachable -> Ast_504.Parsetree.Pexp_unreachable + +and copy_letop : Ast_503.Parsetree.letop -> Ast_504.Parsetree.letop = + fun { Ast_503.Parsetree.let_; Ast_503.Parsetree.ands; Ast_503.Parsetree.body } -> + { + Ast_504.Parsetree.let_ = copy_binding_op let_; + Ast_504.Parsetree.ands = List.map copy_binding_op ands; + Ast_504.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_503.Parsetree.binding_op -> Ast_504.Parsetree.binding_op = + fun { + Ast_503.Parsetree.pbop_op; + Ast_503.Parsetree.pbop_pat; + Ast_503.Parsetree.pbop_exp; + Ast_503.Parsetree.pbop_loc; + } -> + { + Ast_504.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_504.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_504.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_504.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_function_param_desc : + Ast_503.Parsetree.function_param_desc -> + Ast_504.Parsetree.function_param_desc = function + | Ast_503.Parsetree.Pparam_val (l, e, p) -> + Ast_504.Parsetree.Pparam_val + (copy_arg_label l, Option.map copy_expression e, copy_pattern p) + | Ast_503.Parsetree.Pparam_newtype x -> + Ast_504.Parsetree.Pparam_newtype (copy_loc (fun x -> x) x) + +and copy_function_param : + Ast_503.Parsetree.function_param -> Ast_504.Parsetree.function_param = + fun { Ast_503.Parsetree.pparam_loc; pparam_desc } -> + { + Ast_504.Parsetree.pparam_loc = copy_location pparam_loc; + pparam_desc = copy_function_param_desc pparam_desc; + } + +and copy_function_body : + Ast_503.Parsetree.function_body -> Ast_504.Parsetree.function_body = + function + | Ast_503.Parsetree.Pfunction_body e -> + Ast_504.Parsetree.Pfunction_body (copy_expression e) + | Ast_503.Parsetree.Pfunction_cases (cases, loc, attributes) -> + Ast_504.Parsetree.Pfunction_cases + (List.map copy_case cases, copy_location loc, copy_attributes attributes) + +and copy_type_constraint : + Ast_503.Parsetree.type_constraint -> Ast_504.Parsetree.type_constraint = + function + | Ast_503.Parsetree.Pconstraint t -> + Ast_504.Parsetree.Pconstraint (copy_core_type t) + | Ast_503.Parsetree.Pcoerce (t1, t2) -> + Ast_504.Parsetree.Pcoerce (Option.map copy_core_type t1, copy_core_type t2) + +and copy_direction_flag : + Ast_503.Asttypes.direction_flag -> Ast_504.Asttypes.direction_flag = + function + | Ast_503.Asttypes.Upto -> Ast_504.Asttypes.Upto + | Ast_503.Asttypes.Downto -> Ast_504.Asttypes.Downto + +and copy_case : Ast_503.Parsetree.case -> Ast_504.Parsetree.case = + fun { + Ast_503.Parsetree.pc_lhs; + Ast_503.Parsetree.pc_guard; + Ast_503.Parsetree.pc_rhs; + } -> + { + Ast_504.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_504.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_504.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_value_binding : + Ast_503.Parsetree.value_binding -> Ast_504.Parsetree.value_binding = + fun { + Ast_503.Parsetree.pvb_pat; + Ast_503.Parsetree.pvb_expr; + Ast_503.Parsetree.pvb_constraint; + Ast_503.Parsetree.pvb_attributes; + Ast_503.Parsetree.pvb_loc; + } -> + { + Ast_504.Parsetree.pvb_pat = copy_pattern pvb_pat; + Ast_504.Parsetree.pvb_expr = copy_expression pvb_expr; + Ast_504.Parsetree.pvb_constraint = + Option.map copy_value_constraint pvb_constraint; + Ast_504.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_504.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_pattern : Ast_503.Parsetree.pattern -> Ast_504.Parsetree.pattern = + fun { + Ast_503.Parsetree.ppat_desc; + Ast_503.Parsetree.ppat_loc; + Ast_503.Parsetree.ppat_loc_stack; + Ast_503.Parsetree.ppat_attributes; + } -> + let loc = copy_location ppat_loc in + { + Ast_504.Parsetree.ppat_desc = copy_pattern_desc_with_loc ~loc ppat_desc; + Ast_504.Parsetree.ppat_loc = loc; + Ast_504.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_504.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc : + Ast_503.Parsetree.pattern_desc -> Ast_504.Parsetree.pattern_desc = + fun desc -> copy_pattern_desc_with_loc ~loc:Location.none desc + +and copy_pattern_desc_with_loc : + loc:Location.t -> + Ast_503.Parsetree.pattern_desc -> + Ast_504.Parsetree.pattern_desc = + fun ~loc desc -> + match desc with + | Ast_503.Parsetree.Ppat_any -> Ast_504.Parsetree.Ppat_any + | Ast_503.Parsetree.Ppat_var x0 -> + Ast_504.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_503.Parsetree.Ppat_alias (x0, x1) -> + Ast_504.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_503.Parsetree.Ppat_constant x0 -> + let loc = { loc with loc_ghost = true } in + let constant = { (copy_constant x0) with pconst_loc = loc } in + Ast_504.Parsetree.Ppat_constant constant + | Ast_503.Parsetree.Ppat_interval (x0, x1) -> + let loc = { loc with loc_ghost = true } in + let constant0 = { (copy_constant x0) with pconst_loc = loc } in + let constant1 = { (copy_constant x1) with pconst_loc = loc } in + Ast_504.Parsetree.Ppat_interval (constant0, constant1) + | Ast_503.Parsetree.Ppat_tuple x0 -> + Ast_504.Parsetree.Ppat_tuple + (List.map (fun v -> (None, copy_pattern v)) x0, Closed) + | Ast_503.Parsetree.Ppat_construct (x0, x1) -> + Ast_504.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_503.Parsetree.Ppat_variant (x0, x1) -> + Ast_504.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_503.Parsetree.Ppat_record (x0, x1) -> + Ast_504.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_503.Parsetree.Ppat_array x0 -> + Ast_504.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_503.Parsetree.Ppat_or (x0, x1) -> + Ast_504.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_503.Parsetree.Ppat_constraint (x0, x1) -> + Ast_504.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_503.Parsetree.Ppat_type x0 -> + Ast_504.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_503.Parsetree.Ppat_lazy x0 -> + Ast_504.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_503.Parsetree.Ppat_unpack x0 -> + Ast_504.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_503.Parsetree.Ppat_exception x0 -> + Ast_504.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_503.Parsetree.Ppat_extension + ( { txt = "ppxlib.migration.ppat_effect"; _ }, + PPat ({ ppat_desc = Ppat_tuple [ e; c ]; _ }, None) ) -> + Ast_504.Parsetree.Ppat_effect (copy_pattern e, copy_pattern c) + | Ast_503.Parsetree.Ppat_extension x0 -> + Ast_504.Parsetree.Ppat_extension (copy_extension x0) + | Ast_503.Parsetree.Ppat_open (x0, x1) -> + Ast_504.Parsetree.Ppat_open (copy_loc copy_Longident_t x0, copy_pattern x1) + | Ast_503.Parsetree.Ppat_effect (x0, x1) -> + Ast_504.Parsetree.Ppat_effect (copy_pattern x0, copy_pattern x1) + +and copy_value_constraint : + Ast_503.Parsetree.value_constraint -> Ast_504.Parsetree.value_constraint = + function + | Ast_503.Parsetree.Pvc_constraint { locally_abstract_univars; typ } -> + Ast_504.Parsetree.Pvc_constraint + { + locally_abstract_univars = + List.map (copy_loc (fun x -> x)) locally_abstract_univars; + typ = copy_core_type typ; + } + | Ast_503.Parsetree.Pvc_coercion { ground; coercion } -> + Ast_504.Parsetree.Pvc_coercion + { + ground = Option.map copy_core_type ground; + coercion = copy_core_type coercion; + } + +and copy_core_type : Ast_503.Parsetree.core_type -> Ast_504.Parsetree.core_type + = + fun { + Ast_503.Parsetree.ptyp_desc; + Ast_503.Parsetree.ptyp_loc; + Ast_503.Parsetree.ptyp_loc_stack; + Ast_503.Parsetree.ptyp_attributes; + } -> + { + Ast_504.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_504.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_504.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_504.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_location_stack : + Ast_503.Parsetree.location_stack -> Ast_504.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_core_type_desc : + Ast_503.Parsetree.core_type_desc -> Ast_504.Parsetree.core_type_desc = + function + | Ast_503.Parsetree.Ptyp_any -> Ast_504.Parsetree.Ptyp_any + | Ast_503.Parsetree.Ptyp_var x0 -> Ast_504.Parsetree.Ptyp_var x0 + | Ast_503.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_504.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_503.Parsetree.Ptyp_tuple x0 -> + Ast_504.Parsetree.Ptyp_tuple + (List.map (fun v -> (None, copy_core_type v)) x0) + | Ast_503.Parsetree.Ptyp_constr (x0, x1) -> + Ast_504.Parsetree.Ptyp_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_503.Parsetree.Ptyp_object (x0, x1) -> + Ast_504.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_503.Parsetree.Ptyp_class (x0, x1) -> + Ast_504.Parsetree.Ptyp_class + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_503.Parsetree.Ptyp_alias (x0, x1) -> + Ast_504.Parsetree.Ptyp_alias (copy_core_type x0, copy_loc (fun x -> x) x1) + | Ast_503.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_504.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (fun x -> List.map copy_label x) x2 ) + | Ast_503.Parsetree.Ptyp_poly (x0, x1) -> + Ast_504.Parsetree.Ptyp_poly + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_core_type x1) + | Ast_503.Parsetree.Ptyp_package x0 -> + Ast_504.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_503.Parsetree.Ptyp_open (x0, ty) -> + Ast_504.Parsetree.Ptyp_open + (copy_loc copy_Longident_t x0, copy_core_type ty) + | Ast_503.Parsetree.Ptyp_extension x0 -> + Ast_504.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_503.Parsetree.package_type -> Ast_504.Parsetree.package_type = + fun x -> + let x0, x1 = x in + { + ppt_path = copy_loc copy_Longident_t x0; + ppt_cstrs = + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_core_type x1)) + x1; + ppt_loc = Location.none; + ppt_attrs = []; + } + +and copy_row_field : Ast_503.Parsetree.row_field -> Ast_504.Parsetree.row_field + = + fun { + Ast_503.Parsetree.prf_desc; + Ast_503.Parsetree.prf_loc; + Ast_503.Parsetree.prf_attributes; + } -> + { + Ast_504.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_504.Parsetree.prf_loc = copy_location prf_loc; + Ast_504.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_503.Parsetree.row_field_desc -> Ast_504.Parsetree.row_field_desc = + function + | Ast_503.Parsetree.Rtag (x0, x1, x2) -> + Ast_504.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_503.Parsetree.Rinherit x0 -> + Ast_504.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_503.Parsetree.object_field -> Ast_504.Parsetree.object_field = + fun { + Ast_503.Parsetree.pof_desc; + Ast_503.Parsetree.pof_loc; + Ast_503.Parsetree.pof_attributes; + } -> + { + Ast_504.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_504.Parsetree.pof_loc = copy_location pof_loc; + Ast_504.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_attributes : + Ast_503.Parsetree.attributes -> Ast_504.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : Ast_503.Parsetree.attribute -> Ast_504.Parsetree.attribute + = + fun { + Ast_503.Parsetree.attr_name; + Ast_503.Parsetree.attr_payload; + Ast_503.Parsetree.attr_loc; + } -> + { + Ast_504.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_504.Parsetree.attr_payload = copy_payload attr_payload; + Ast_504.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_payload : Ast_503.Parsetree.payload -> Ast_504.Parsetree.payload = + function + | Ast_503.Parsetree.PStr x0 -> Ast_504.Parsetree.PStr (copy_structure x0) + | Ast_503.Parsetree.PSig x0 -> Ast_504.Parsetree.PSig (copy_signature x0) + | Ast_503.Parsetree.PTyp x0 -> Ast_504.Parsetree.PTyp (copy_core_type x0) + | Ast_503.Parsetree.PPat (x0, x1) -> + Ast_504.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_structure : Ast_503.Parsetree.structure -> Ast_504.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_503.Parsetree.structure_item -> Ast_504.Parsetree.structure_item = + fun { Ast_503.Parsetree.pstr_desc; Ast_503.Parsetree.pstr_loc } -> + { + Ast_504.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_504.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_503.Parsetree.structure_item_desc -> + Ast_504.Parsetree.structure_item_desc = function + | Ast_503.Parsetree.Pstr_eval (x0, x1) -> + Ast_504.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_503.Parsetree.Pstr_value (x0, x1) -> + Ast_504.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_503.Parsetree.Pstr_primitive x0 -> + Ast_504.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_503.Parsetree.Pstr_type (x0, x1) -> + Ast_504.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_503.Parsetree.Pstr_typext x0 -> + Ast_504.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_503.Parsetree.Pstr_exception x0 -> + Ast_504.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_503.Parsetree.Pstr_module x0 -> + Ast_504.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_503.Parsetree.Pstr_recmodule x0 -> + Ast_504.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_503.Parsetree.Pstr_modtype x0 -> + Ast_504.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_503.Parsetree.Pstr_open x0 -> + Ast_504.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_503.Parsetree.Pstr_class x0 -> + Ast_504.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_503.Parsetree.Pstr_class_type x0 -> + Ast_504.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_503.Parsetree.Pstr_include x0 -> + Ast_504.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_503.Parsetree.Pstr_attribute x0 -> + Ast_504.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_503.Parsetree.Pstr_extension (x0, x1) -> + Ast_504.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_include_declaration : + Ast_503.Parsetree.include_declaration -> + Ast_504.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_class_declaration : + Ast_503.Parsetree.class_declaration -> Ast_504.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_class_expr : + Ast_503.Parsetree.class_expr -> Ast_504.Parsetree.class_expr = + fun { + Ast_503.Parsetree.pcl_desc; + Ast_503.Parsetree.pcl_loc; + Ast_503.Parsetree.pcl_attributes; + } -> + { + Ast_504.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_504.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_504.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_503.Parsetree.class_expr_desc -> Ast_504.Parsetree.class_expr_desc = + function + | Ast_503.Parsetree.Pcl_constr (x0, x1) -> + Ast_504.Parsetree.Pcl_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_503.Parsetree.Pcl_structure x0 -> + Ast_504.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_503.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_504.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_503.Parsetree.Pcl_apply (x0, x1) -> + Ast_504.Parsetree.Pcl_apply + ( copy_class_expr x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_503.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_504.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_503.Parsetree.Pcl_constraint (x0, x1) -> + Ast_504.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_503.Parsetree.Pcl_extension x0 -> + Ast_504.Parsetree.Pcl_extension (copy_extension x0) + | Ast_503.Parsetree.Pcl_open (x0, x1) -> + Ast_504.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_503.Parsetree.class_structure -> Ast_504.Parsetree.class_structure = + fun { Ast_503.Parsetree.pcstr_self; Ast_503.Parsetree.pcstr_fields } -> + { + Ast_504.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_504.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_503.Parsetree.class_field -> Ast_504.Parsetree.class_field = + fun { + Ast_503.Parsetree.pcf_desc; + Ast_503.Parsetree.pcf_loc; + Ast_503.Parsetree.pcf_attributes; + } -> + { + Ast_504.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_504.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_504.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_503.Parsetree.class_field_desc -> Ast_504.Parsetree.class_field_desc = + function + | Ast_503.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_504.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (fun x -> copy_loc (fun x -> x) x) x2 ) + | Ast_503.Parsetree.Pcf_val x0 -> + Ast_504.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_503.Parsetree.Pcf_method x0 -> + Ast_504.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_503.Parsetree.Pcf_constraint x0 -> + Ast_504.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_503.Parsetree.Pcf_initializer x0 -> + Ast_504.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_503.Parsetree.Pcf_attribute x0 -> + Ast_504.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_503.Parsetree.Pcf_extension x0 -> + Ast_504.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_503.Parsetree.class_field_kind -> Ast_504.Parsetree.class_field_kind = + function + | Ast_503.Parsetree.Cfk_virtual x0 -> + Ast_504.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_503.Parsetree.Cfk_concrete (x0, x1) -> + Ast_504.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_open_declaration : + Ast_503.Parsetree.open_declaration -> Ast_504.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_module_binding : + Ast_503.Parsetree.module_binding -> Ast_504.Parsetree.module_binding = + fun { + Ast_503.Parsetree.pmb_name; + Ast_503.Parsetree.pmb_expr; + Ast_503.Parsetree.pmb_attributes; + Ast_503.Parsetree.pmb_loc; + } -> + { + Ast_504.Parsetree.pmb_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name; + Ast_504.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_504.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_504.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_module_expr : + Ast_503.Parsetree.module_expr -> Ast_504.Parsetree.module_expr = + fun { + Ast_503.Parsetree.pmod_desc; + Ast_503.Parsetree.pmod_loc; + Ast_503.Parsetree.pmod_attributes; + } -> + { + Ast_504.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_504.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_504.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_503.Parsetree.module_expr_desc -> Ast_504.Parsetree.module_expr_desc = + function + | Ast_503.Parsetree.Pmod_ident x0 -> + Ast_504.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_503.Parsetree.Pmod_structure x0 -> + Ast_504.Parsetree.Pmod_structure (copy_structure x0) + | Ast_503.Parsetree.Pmod_functor (x0, x1) -> + Ast_504.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_503.Parsetree.Pmod_apply (x0, x1) -> + Ast_504.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_503.Parsetree.Pmod_apply_unit x0 -> + Ast_504.Parsetree.Pmod_apply_unit (copy_module_expr x0) + | Ast_503.Parsetree.Pmod_constraint (x0, x1) -> + Ast_504.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_503.Parsetree.Pmod_unpack x0 -> + Ast_504.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_503.Parsetree.Pmod_extension x0 -> + Ast_504.Parsetree.Pmod_extension (copy_extension x0) + +and copy_functor_parameter : + Ast_503.Parsetree.functor_parameter -> Ast_504.Parsetree.functor_parameter = + function + | Ast_503.Parsetree.Unit -> Ast_504.Parsetree.Unit + | Ast_503.Parsetree.Named (x0, x1) -> + Ast_504.Parsetree.Named + (copy_loc (fun x -> Option.map (fun x -> x) x) x0, copy_module_type x1) + +and copy_module_type : + Ast_503.Parsetree.module_type -> Ast_504.Parsetree.module_type = + fun { + Ast_503.Parsetree.pmty_desc; + Ast_503.Parsetree.pmty_loc; + Ast_503.Parsetree.pmty_attributes; + } -> + { + Ast_504.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_504.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_504.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_503.Parsetree.module_type_desc -> Ast_504.Parsetree.module_type_desc = + function + | Ast_503.Parsetree.Pmty_ident x0 -> + Ast_504.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_503.Parsetree.Pmty_signature x0 -> + Ast_504.Parsetree.Pmty_signature (copy_signature x0) + | Ast_503.Parsetree.Pmty_functor (x0, x1) -> + Ast_504.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_503.Parsetree.Pmty_with (x0, x1) -> + Ast_504.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_503.Parsetree.Pmty_typeof x0 -> + Ast_504.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_503.Parsetree.Pmty_extension x0 -> + Ast_504.Parsetree.Pmty_extension (copy_extension x0) + | Ast_503.Parsetree.Pmty_alias x0 -> + Ast_504.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) + +and copy_with_constraint : + Ast_503.Parsetree.with_constraint -> Ast_504.Parsetree.with_constraint = + function + | Ast_503.Parsetree.Pwith_type (x0, x1) -> + Ast_504.Parsetree.Pwith_type + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_503.Parsetree.Pwith_module (x0, x1) -> + Ast_504.Parsetree.Pwith_module + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + | Ast_503.Parsetree.Pwith_modtype (x0, x1) -> + Ast_504.Parsetree.Pwith_modtype + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_503.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_504.Parsetree.Pwith_modtypesubst + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_503.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_504.Parsetree.Pwith_typesubst + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_503.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_504.Parsetree.Pwith_modsubst + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + +and copy_signature : Ast_503.Parsetree.signature -> Ast_504.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_503.Parsetree.signature_item -> Ast_504.Parsetree.signature_item = + fun { Ast_503.Parsetree.psig_desc; Ast_503.Parsetree.psig_loc } -> + { + Ast_504.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_504.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_503.Parsetree.signature_item_desc -> + Ast_504.Parsetree.signature_item_desc = function + | Ast_503.Parsetree.Psig_value x0 -> + Ast_504.Parsetree.Psig_value (copy_value_description x0) + | Ast_503.Parsetree.Psig_type (x0, x1) -> + Ast_504.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_503.Parsetree.Psig_typesubst x0 -> + Ast_504.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_503.Parsetree.Psig_typext x0 -> + Ast_504.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_503.Parsetree.Psig_exception x0 -> + Ast_504.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_503.Parsetree.Psig_module x0 -> + Ast_504.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_503.Parsetree.Psig_modsubst x0 -> + Ast_504.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_503.Parsetree.Psig_recmodule x0 -> + Ast_504.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_503.Parsetree.Psig_modtype x0 -> + Ast_504.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_503.Parsetree.Psig_modtypesubst x0 -> + Ast_504.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_503.Parsetree.Psig_open x0 -> + Ast_504.Parsetree.Psig_open (copy_open_description x0) + | Ast_503.Parsetree.Psig_include x0 -> + Ast_504.Parsetree.Psig_include (copy_include_description x0) + | Ast_503.Parsetree.Psig_class x0 -> + Ast_504.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_503.Parsetree.Psig_class_type x0 -> + Ast_504.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_503.Parsetree.Psig_attribute x0 -> + Ast_504.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_503.Parsetree.Psig_extension (x0, x1) -> + Ast_504.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_class_type_declaration : + Ast_503.Parsetree.class_type_declaration -> + Ast_504.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_description : + Ast_503.Parsetree.class_description -> Ast_504.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type : + Ast_503.Parsetree.class_type -> Ast_504.Parsetree.class_type = + fun { + Ast_503.Parsetree.pcty_desc; + Ast_503.Parsetree.pcty_loc; + Ast_503.Parsetree.pcty_attributes; + } -> + { + Ast_504.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_504.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_504.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_503.Parsetree.class_type_desc -> Ast_504.Parsetree.class_type_desc = + function + | Ast_503.Parsetree.Pcty_constr (x0, x1) -> + Ast_504.Parsetree.Pcty_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_503.Parsetree.Pcty_signature x0 -> + Ast_504.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_503.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_504.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_503.Parsetree.Pcty_extension x0 -> + Ast_504.Parsetree.Pcty_extension (copy_extension x0) + | Ast_503.Parsetree.Pcty_open (x0, x1) -> + Ast_504.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_503.Parsetree.class_signature -> Ast_504.Parsetree.class_signature = + fun { Ast_503.Parsetree.pcsig_self; Ast_503.Parsetree.pcsig_fields } -> + { + Ast_504.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_504.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_503.Parsetree.class_type_field -> Ast_504.Parsetree.class_type_field = + fun { + Ast_503.Parsetree.pctf_desc; + Ast_503.Parsetree.pctf_loc; + Ast_503.Parsetree.pctf_attributes; + } -> + { + Ast_504.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_504.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_504.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_503.Parsetree.class_type_field_desc -> + Ast_504.Parsetree.class_type_field_desc = function + | Ast_503.Parsetree.Pctf_inherit x0 -> + Ast_504.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_503.Parsetree.Pctf_val x0 -> + Ast_504.Parsetree.Pctf_val + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_mutable_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_503.Parsetree.Pctf_method x0 -> + Ast_504.Parsetree.Pctf_method + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_private_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_503.Parsetree.Pctf_constraint x0 -> + Ast_504.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_503.Parsetree.Pctf_attribute x0 -> + Ast_504.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_503.Parsetree.Pctf_extension x0 -> + Ast_504.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : Ast_503.Parsetree.extension -> Ast_504.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_503.Parsetree.class_infos -> + 'g0 Ast_504.Parsetree.class_infos = + fun f0 + { + Ast_503.Parsetree.pci_virt; + Ast_503.Parsetree.pci_params; + Ast_503.Parsetree.pci_name; + Ast_503.Parsetree.pci_expr; + Ast_503.Parsetree.pci_loc; + Ast_503.Parsetree.pci_attributes; + } -> + { + Ast_504.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_504.Parsetree.pci_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + pci_params; + Ast_504.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_504.Parsetree.pci_expr = f0 pci_expr; + Ast_504.Parsetree.pci_loc = copy_location pci_loc; + Ast_504.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_virtual_flag : + Ast_503.Asttypes.virtual_flag -> Ast_504.Asttypes.virtual_flag = function + | Ast_503.Asttypes.Virtual -> Ast_504.Asttypes.Virtual + | Ast_503.Asttypes.Concrete -> Ast_504.Asttypes.Concrete + +and copy_include_description : + Ast_503.Parsetree.include_description -> + Ast_504.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_503.Parsetree.include_infos -> + 'g0 Ast_504.Parsetree.include_infos = + fun f0 + { + Ast_503.Parsetree.pincl_mod; + Ast_503.Parsetree.pincl_loc; + Ast_503.Parsetree.pincl_attributes; + } -> + { + Ast_504.Parsetree.pincl_mod = f0 pincl_mod; + Ast_504.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_504.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_open_description : + Ast_503.Parsetree.open_description -> Ast_504.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_503.Parsetree.open_infos -> + 'g0 Ast_504.Parsetree.open_infos = + fun f0 + { + Ast_503.Parsetree.popen_expr; + Ast_503.Parsetree.popen_override; + Ast_503.Parsetree.popen_loc; + Ast_503.Parsetree.popen_attributes; + } -> + { + Ast_504.Parsetree.popen_expr = f0 popen_expr; + Ast_504.Parsetree.popen_override = copy_override_flag popen_override; + Ast_504.Parsetree.popen_loc = copy_location popen_loc; + Ast_504.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_override_flag : + Ast_503.Asttypes.override_flag -> Ast_504.Asttypes.override_flag = function + | Ast_503.Asttypes.Override -> Ast_504.Asttypes.Override + | Ast_503.Asttypes.Fresh -> Ast_504.Asttypes.Fresh + +and copy_module_type_declaration : + Ast_503.Parsetree.module_type_declaration -> + Ast_504.Parsetree.module_type_declaration = + fun { + Ast_503.Parsetree.pmtd_name; + Ast_503.Parsetree.pmtd_type; + Ast_503.Parsetree.pmtd_attributes; + Ast_503.Parsetree.pmtd_loc; + } -> + { + Ast_504.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_504.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_504.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_504.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_module_substitution : + Ast_503.Parsetree.module_substitution -> + Ast_504.Parsetree.module_substitution = + fun { + Ast_503.Parsetree.pms_name; + Ast_503.Parsetree.pms_manifest; + Ast_503.Parsetree.pms_attributes; + Ast_503.Parsetree.pms_loc; + } -> + { + Ast_504.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_504.Parsetree.pms_manifest = copy_loc copy_Longident_t pms_manifest; + Ast_504.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_504.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_declaration : + Ast_503.Parsetree.module_declaration -> Ast_504.Parsetree.module_declaration + = + fun { + Ast_503.Parsetree.pmd_name; + Ast_503.Parsetree.pmd_type; + Ast_503.Parsetree.pmd_attributes; + Ast_503.Parsetree.pmd_loc; + } -> + { + Ast_504.Parsetree.pmd_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name; + Ast_504.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_504.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_504.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_type_exception : + Ast_503.Parsetree.type_exception -> Ast_504.Parsetree.type_exception = + fun { + Ast_503.Parsetree.ptyexn_constructor; + Ast_503.Parsetree.ptyexn_loc; + Ast_503.Parsetree.ptyexn_attributes; + } -> + { + Ast_504.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_504.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_504.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_type_extension : + Ast_503.Parsetree.type_extension -> Ast_504.Parsetree.type_extension = + fun { + Ast_503.Parsetree.ptyext_path; + Ast_503.Parsetree.ptyext_params; + Ast_503.Parsetree.ptyext_constructors; + Ast_503.Parsetree.ptyext_private; + Ast_503.Parsetree.ptyext_loc; + Ast_503.Parsetree.ptyext_attributes; + } -> + { + Ast_504.Parsetree.ptyext_path = copy_loc copy_Longident_t ptyext_path; + Ast_504.Parsetree.ptyext_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptyext_params; + Ast_504.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_504.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_504.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_504.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_503.Parsetree.extension_constructor -> + Ast_504.Parsetree.extension_constructor = + fun { + Ast_503.Parsetree.pext_name; + Ast_503.Parsetree.pext_kind; + Ast_503.Parsetree.pext_loc; + Ast_503.Parsetree.pext_attributes; + } -> + { + Ast_504.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_504.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_504.Parsetree.pext_loc = copy_location pext_loc; + Ast_504.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_extension_constructor_kind : + Ast_503.Parsetree.extension_constructor_kind -> + Ast_504.Parsetree.extension_constructor_kind = function + | Ast_503.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_504.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_503.Parsetree.Pext_rebind x0 -> + Ast_504.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) + +and copy_type_declaration : + Ast_503.Parsetree.type_declaration -> Ast_504.Parsetree.type_declaration = + fun { + Ast_503.Parsetree.ptype_name; + Ast_503.Parsetree.ptype_params; + Ast_503.Parsetree.ptype_cstrs; + Ast_503.Parsetree.ptype_kind; + Ast_503.Parsetree.ptype_private; + Ast_503.Parsetree.ptype_manifest; + Ast_503.Parsetree.ptype_attributes; + Ast_503.Parsetree.ptype_loc; + } -> + { + Ast_504.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_504.Parsetree.ptype_params = + List.map + (fun x -> + let x0, x1 = x in + ( copy_core_type x0, + let x0, x1 = x1 in + (copy_variance x0, copy_injectivity x1) )) + ptype_params; + Ast_504.Parsetree.ptype_cstrs = + List.map + (fun x -> + let x0, x1, x2 = x in + (copy_core_type x0, copy_core_type x1, copy_location x2)) + ptype_cstrs; + Ast_504.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_504.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_504.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_504.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_504.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_private_flag : + Ast_503.Asttypes.private_flag -> Ast_504.Asttypes.private_flag = function + | Ast_503.Asttypes.Private -> Ast_504.Asttypes.Private + | Ast_503.Asttypes.Public -> Ast_504.Asttypes.Public + +and copy_type_kind : Ast_503.Parsetree.type_kind -> Ast_504.Parsetree.type_kind + = function + | Ast_503.Parsetree.Ptype_abstract -> Ast_504.Parsetree.Ptype_abstract + | Ast_503.Parsetree.Ptype_variant x0 -> + Ast_504.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_503.Parsetree.Ptype_record x0 -> + Ast_504.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_503.Parsetree.Ptype_open -> Ast_504.Parsetree.Ptype_open + +and copy_constructor_declaration : + Ast_503.Parsetree.constructor_declaration -> + Ast_504.Parsetree.constructor_declaration = + fun { + Ast_503.Parsetree.pcd_name; + Ast_503.Parsetree.pcd_vars; + Ast_503.Parsetree.pcd_args; + Ast_503.Parsetree.pcd_res; + Ast_503.Parsetree.pcd_loc; + Ast_503.Parsetree.pcd_attributes; + } -> + { + Ast_504.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_504.Parsetree.pcd_vars = + List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars; + Ast_504.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_504.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_504.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_504.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_503.Parsetree.constructor_arguments -> + Ast_504.Parsetree.constructor_arguments = function + | Ast_503.Parsetree.Pcstr_tuple x0 -> + Ast_504.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_503.Parsetree.Pcstr_record x0 -> + Ast_504.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_label_declaration : + Ast_503.Parsetree.label_declaration -> Ast_504.Parsetree.label_declaration = + fun { + Ast_503.Parsetree.pld_name; + Ast_503.Parsetree.pld_mutable; + Ast_503.Parsetree.pld_type; + Ast_503.Parsetree.pld_loc; + Ast_503.Parsetree.pld_attributes; + } -> + { + Ast_504.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_504.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_504.Parsetree.pld_type = copy_core_type pld_type; + Ast_504.Parsetree.pld_loc = copy_location pld_loc; + Ast_504.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_mutable_flag : + Ast_503.Asttypes.mutable_flag -> Ast_504.Asttypes.mutable_flag = function + | Ast_503.Asttypes.Immutable -> Ast_504.Asttypes.Immutable + | Ast_503.Asttypes.Mutable -> Ast_504.Asttypes.Mutable + +and copy_injectivity : + Ast_503.Asttypes.injectivity -> Ast_504.Asttypes.injectivity = function + | Ast_503.Asttypes.Injective -> Ast_504.Asttypes.Injective + | Ast_503.Asttypes.NoInjectivity -> Ast_504.Asttypes.NoInjectivity + +and copy_variance : Ast_503.Asttypes.variance -> Ast_504.Asttypes.variance = + function + | Ast_503.Asttypes.Covariant -> Ast_504.Asttypes.Covariant + | Ast_503.Asttypes.Contravariant -> Ast_504.Asttypes.Contravariant + | Ast_503.Asttypes.NoVariance -> Ast_504.Asttypes.NoVariance + +and copy_value_description : + Ast_503.Parsetree.value_description -> Ast_504.Parsetree.value_description = + fun { + Ast_503.Parsetree.pval_name; + Ast_503.Parsetree.pval_type; + Ast_503.Parsetree.pval_prim; + Ast_503.Parsetree.pval_attributes; + Ast_503.Parsetree.pval_loc; + } -> + { + Ast_504.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_504.Parsetree.pval_type = copy_core_type pval_type; + Ast_504.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_504.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_504.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_object_field_desc : + Ast_503.Parsetree.object_field_desc -> Ast_504.Parsetree.object_field_desc = + function + | Ast_503.Parsetree.Otag (x0, x1) -> + Ast_504.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_503.Parsetree.Oinherit x0 -> + Ast_504.Parsetree.Oinherit (copy_core_type x0) + +and copy_arg_label : Ast_503.Asttypes.arg_label -> Ast_504.Asttypes.arg_label = + function + | Ast_503.Asttypes.Nolabel -> Ast_504.Asttypes.Nolabel + | Ast_503.Asttypes.Labelled x0 -> Ast_504.Asttypes.Labelled x0 + | Ast_503.Asttypes.Optional x0 -> Ast_504.Asttypes.Optional x0 + +and copy_closed_flag : + Ast_503.Asttypes.closed_flag -> Ast_504.Asttypes.closed_flag = function + | Ast_503.Asttypes.Closed -> Ast_504.Asttypes.Closed + | Ast_503.Asttypes.Open -> Ast_504.Asttypes.Open + +and copy_label : Ast_503.Asttypes.label -> Ast_504.Asttypes.label = fun x -> x + +and copy_rec_flag : Ast_503.Asttypes.rec_flag -> Ast_504.Asttypes.rec_flag = + function + | Ast_503.Asttypes.Nonrecursive -> Ast_504.Asttypes.Nonrecursive + | Ast_503.Asttypes.Recursive -> Ast_504.Asttypes.Recursive + +and copy_constant : Ast_503.Parsetree.constant -> Ast_504.Parsetree.constant = + fun c -> + let pconst_desc = + match c.pconst_desc with + | Ast_503.Parsetree.Pconst_integer (x0, x1) -> + Ast_504.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_503.Parsetree.Pconst_char x0 -> Ast_504.Parsetree.Pconst_char x0 + | Ast_503.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_504.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_503.Parsetree.Pconst_float (x0, x1) -> + Ast_504.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + in + { pconst_desc; pconst_loc = copy_location c.pconst_loc } + +and copy_Longident_t : Legacy_longident.t -> Longident.t = function + | Legacy_longident.Lident x0 -> Longident.Lident x0 + | Legacy_longident.Ldot (x0, x1) -> + Longident.Ldot + ( { txt = copy_Longident_t x0; loc = Location.none }, + { txt = x1; loc = Location.none } ) + | Legacy_longident.Lapply (x0, x1) -> + let x0 = Location.{ txt = copy_Longident_t x0; loc = Location.none } in + let x1 = Location.{ txt = copy_Longident_t x1; loc = Location.none } in + Longident.Lapply (x0, x1) + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_503.Asttypes.loc -> 'g0 Ast_504.Asttypes.loc = + fun f0 { Ast_503.Asttypes.txt; Ast_503.Asttypes.loc } -> + { Ast_504.Asttypes.txt = f0 txt; Ast_504.Asttypes.loc = copy_location loc } + +and copy_location : Location.t -> Location.t = fun x -> x diff --git a/astlib/migrate_504_503.ml b/astlib/migrate_504_503.ml new file mode 100644 index 000000000..8d27f2792 --- /dev/null +++ b/astlib/migrate_504_503.ml @@ -0,0 +1,1340 @@ +open Stdlib0 +module From = Ast_504 +module To = Ast_503 + +let migration_error loc missing_feature = + Location.raise_errorf ~loc + "migration error: %s are not supported before OCaml 5.4" missing_feature + +let rec copy_toplevel_phrase : + Ast_504.Parsetree.toplevel_phrase -> Ast_503.Parsetree.toplevel_phrase = + function + | Ast_504.Parsetree.Ptop_def x0 -> + Ast_503.Parsetree.Ptop_def (copy_structure x0) + | Ast_504.Parsetree.Ptop_dir x0 -> + Ast_503.Parsetree.Ptop_dir (copy_toplevel_directive x0) + +and copy_toplevel_directive : + Ast_504.Parsetree.toplevel_directive -> Ast_503.Parsetree.toplevel_directive + = + fun { + Ast_504.Parsetree.pdir_name; + Ast_504.Parsetree.pdir_arg; + Ast_504.Parsetree.pdir_loc; + } -> + { + Ast_503.Parsetree.pdir_name = copy_loc (fun x -> x) pdir_name; + Ast_503.Parsetree.pdir_arg = Option.map copy_directive_argument pdir_arg; + Ast_503.Parsetree.pdir_loc = copy_location pdir_loc; + } + +and copy_directive_argument : + Ast_504.Parsetree.directive_argument -> Ast_503.Parsetree.directive_argument + = + fun { Ast_504.Parsetree.pdira_desc; Ast_504.Parsetree.pdira_loc } -> + { + Ast_503.Parsetree.pdira_desc = copy_directive_argument_desc pdira_desc; + Ast_503.Parsetree.pdira_loc = copy_location pdira_loc; + } + +and copy_directive_argument_desc : + Ast_504.Parsetree.directive_argument_desc -> + Ast_503.Parsetree.directive_argument_desc = function + | Ast_504.Parsetree.Pdir_string x0 -> Ast_503.Parsetree.Pdir_string x0 + | Ast_504.Parsetree.Pdir_int (x0, x1) -> + Ast_503.Parsetree.Pdir_int (x0, Option.map (fun x -> x) x1) + | Ast_504.Parsetree.Pdir_ident x0 -> + Ast_503.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_504.Parsetree.Pdir_bool x0 -> Ast_503.Parsetree.Pdir_bool x0 + +and copy_expression : + Ast_504.Parsetree.expression -> Ast_503.Parsetree.expression = + fun { + Ast_504.Parsetree.pexp_desc; + Ast_504.Parsetree.pexp_loc; + Ast_504.Parsetree.pexp_loc_stack; + Ast_504.Parsetree.pexp_attributes; + } -> + { + Ast_503.Parsetree.pexp_desc = copy_expression_desc pexp_desc; + Ast_503.Parsetree.pexp_loc = copy_location pexp_loc; + Ast_503.Parsetree.pexp_loc_stack = copy_location_stack pexp_loc_stack; + Ast_503.Parsetree.pexp_attributes = copy_attributes pexp_attributes; + } + +and copy_expression_desc : + Ast_504.Parsetree.expression_desc -> Ast_503.Parsetree.expression_desc = + function + | Ast_504.Parsetree.Pexp_ident x0 -> + Ast_503.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_504.Parsetree.Pexp_constant x0 -> + Ast_503.Parsetree.Pexp_constant (copy_constant x0) + | Ast_504.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_503.Parsetree.Pexp_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_expression x2) + | Ast_504.Parsetree.Pexp_function (params, typ_constraint, fun_body) -> + let params = List.map copy_function_param params in + let typ_constraint = Option.map copy_type_constraint typ_constraint in + let fun_body = copy_function_body fun_body in + Ast_503.Parsetree.Pexp_function (params, typ_constraint, fun_body) + | Ast_504.Parsetree.Pexp_apply (x0, x1) -> + Ast_503.Parsetree.Pexp_apply + ( copy_expression x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_504.Parsetree.Pexp_match (x0, x1) -> + Ast_503.Parsetree.Pexp_match (copy_expression x0, List.map copy_case x1) + | Ast_504.Parsetree.Pexp_try (x0, x1) -> + Ast_503.Parsetree.Pexp_try (copy_expression x0, List.map copy_case x1) + | Ast_504.Parsetree.Pexp_tuple x0 -> + let args = + List.map + (function + | None, arg -> arg + | Some _l, (arg : Ast_504.Parsetree.expression) -> + migration_error arg.pexp_loc "labelled tuples") + x0 + in + Ast_503.Parsetree.Pexp_tuple (List.map copy_expression args) + | Ast_504.Parsetree.Pexp_construct (x0, x1) -> + Ast_503.Parsetree.Pexp_construct + (copy_loc copy_Longident_t x0, Option.map copy_expression x1) + | Ast_504.Parsetree.Pexp_variant (x0, x1) -> + Ast_503.Parsetree.Pexp_variant + (copy_label x0, Option.map copy_expression x1) + | Ast_504.Parsetree.Pexp_record (x0, x1) -> + Ast_503.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_504.Parsetree.Pexp_field (x0, x1) -> + Ast_503.Parsetree.Pexp_field + (copy_expression x0, copy_loc copy_Longident_t x1) + | Ast_504.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_503.Parsetree.Pexp_setfield + (copy_expression x0, copy_loc copy_Longident_t x1, copy_expression x2) + | Ast_504.Parsetree.Pexp_array x0 -> + Ast_503.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_504.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_503.Parsetree.Pexp_ifthenelse + (copy_expression x0, copy_expression x1, Option.map copy_expression x2) + | Ast_504.Parsetree.Pexp_sequence (x0, x1) -> + Ast_503.Parsetree.Pexp_sequence (copy_expression x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_while (x0, x1) -> + Ast_503.Parsetree.Pexp_while (copy_expression x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_503.Parsetree.Pexp_for + ( copy_pattern x0, + copy_expression x1, + copy_expression x2, + copy_direction_flag x3, + copy_expression x4 ) + | Ast_504.Parsetree.Pexp_constraint (x0, x1) -> + Ast_503.Parsetree.Pexp_constraint (copy_expression x0, copy_core_type x1) + | Ast_504.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_503.Parsetree.Pexp_coerce + (copy_expression x0, Option.map copy_core_type x1, copy_core_type x2) + | Ast_504.Parsetree.Pexp_send (x0, x1) -> + Ast_503.Parsetree.Pexp_send (copy_expression x0, copy_loc copy_label x1) + | Ast_504.Parsetree.Pexp_new x0 -> + Ast_503.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_504.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_503.Parsetree.Pexp_setinstvar + (copy_loc copy_label x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_override x0 -> + Ast_503.Parsetree.Pexp_override + (List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_label x0, copy_expression x1)) + x0) + | Ast_504.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_503.Parsetree.Pexp_letmodule + ( copy_loc (fun x -> Option.map (fun x -> x) x) x0, + copy_module_expr x1, + copy_expression x2 ) + | Ast_504.Parsetree.Pexp_letexception (x0, x1) -> + Ast_503.Parsetree.Pexp_letexception + (copy_extension_constructor x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_assert x0 -> + Ast_503.Parsetree.Pexp_assert (copy_expression x0) + | Ast_504.Parsetree.Pexp_lazy x0 -> + Ast_503.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_504.Parsetree.Pexp_poly (x0, x1) -> + Ast_503.Parsetree.Pexp_poly + (copy_expression x0, Option.map copy_core_type x1) + | Ast_504.Parsetree.Pexp_object x0 -> + Ast_503.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_504.Parsetree.Pexp_newtype (x0, x1) -> + Ast_503.Parsetree.Pexp_newtype + (copy_loc (fun x -> x) x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_pack (x0, Some c) -> + let module_exp = Ast_503.Parsetree.Pexp_pack (copy_module_expr x0) in + let package = Ast_503.Parsetree.Ptyp_package (copy_package_type c) in + let exp : Ast_503.Parsetree.expression = + { + pexp_desc = module_exp; + pexp_loc = Location.none; + pexp_loc_stack = []; + pexp_attributes = []; + } + in + let ct : Ast_503.Parsetree.core_type = + { + ptyp_desc = package; + ptyp_loc = Location.none; + ptyp_loc_stack = []; + ptyp_attributes = []; + } + in + Ast_503.Parsetree.Pexp_constraint (exp, ct) + | Ast_504.Parsetree.Pexp_pack (x0, None) -> + Ast_503.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_504.Parsetree.Pexp_open (x0, x1) -> + Ast_503.Parsetree.Pexp_open (copy_open_declaration x0, copy_expression x1) + | Ast_504.Parsetree.Pexp_letop x0 -> + Ast_503.Parsetree.Pexp_letop (copy_letop x0) + | Ast_504.Parsetree.Pexp_extension x0 -> + Ast_503.Parsetree.Pexp_extension (copy_extension x0) + | Ast_504.Parsetree.Pexp_unreachable -> Ast_503.Parsetree.Pexp_unreachable + +and copy_letop : Ast_504.Parsetree.letop -> Ast_503.Parsetree.letop = + fun { Ast_504.Parsetree.let_; Ast_504.Parsetree.ands; Ast_504.Parsetree.body } -> + { + Ast_503.Parsetree.let_ = copy_binding_op let_; + Ast_503.Parsetree.ands = List.map copy_binding_op ands; + Ast_503.Parsetree.body = copy_expression body; + } + +and copy_binding_op : + Ast_504.Parsetree.binding_op -> Ast_503.Parsetree.binding_op = + fun { + Ast_504.Parsetree.pbop_op; + Ast_504.Parsetree.pbop_pat; + Ast_504.Parsetree.pbop_exp; + Ast_504.Parsetree.pbop_loc; + } -> + { + Ast_503.Parsetree.pbop_op = copy_loc (fun x -> x) pbop_op; + Ast_503.Parsetree.pbop_pat = copy_pattern pbop_pat; + Ast_503.Parsetree.pbop_exp = copy_expression pbop_exp; + Ast_503.Parsetree.pbop_loc = copy_location pbop_loc; + } + +and copy_function_param_desc : + Ast_504.Parsetree.function_param_desc -> + Ast_503.Parsetree.function_param_desc = function + | Ast_504.Parsetree.Pparam_val (l, e, p) -> + Ast_503.Parsetree.Pparam_val + (copy_arg_label l, Option.map copy_expression e, copy_pattern p) + | Ast_504.Parsetree.Pparam_newtype x -> + Ast_503.Parsetree.Pparam_newtype (copy_loc (fun x -> x) x) + +and copy_function_param : + Ast_504.Parsetree.function_param -> Ast_503.Parsetree.function_param = + fun { Ast_504.Parsetree.pparam_loc; pparam_desc } -> + { + Ast_503.Parsetree.pparam_loc = copy_location pparam_loc; + pparam_desc = copy_function_param_desc pparam_desc; + } + +and copy_function_body : + Ast_504.Parsetree.function_body -> Ast_503.Parsetree.function_body = + function + | Ast_504.Parsetree.Pfunction_body e -> + Ast_503.Parsetree.Pfunction_body (copy_expression e) + | Ast_504.Parsetree.Pfunction_cases (cases, loc, attributes) -> + Ast_503.Parsetree.Pfunction_cases + (List.map copy_case cases, copy_location loc, copy_attributes attributes) + +and copy_type_constraint : + Ast_504.Parsetree.type_constraint -> Ast_503.Parsetree.type_constraint = + function + | Ast_504.Parsetree.Pconstraint t -> + Ast_503.Parsetree.Pconstraint (copy_core_type t) + | Ast_504.Parsetree.Pcoerce (t1, t2) -> + Ast_503.Parsetree.Pcoerce (Option.map copy_core_type t1, copy_core_type t2) + +and copy_direction_flag : + Ast_504.Asttypes.direction_flag -> Ast_503.Asttypes.direction_flag = + function + | Ast_504.Asttypes.Upto -> Ast_503.Asttypes.Upto + | Ast_504.Asttypes.Downto -> Ast_503.Asttypes.Downto + +and copy_case : Ast_504.Parsetree.case -> Ast_503.Parsetree.case = + fun { + Ast_504.Parsetree.pc_lhs; + Ast_504.Parsetree.pc_guard; + Ast_504.Parsetree.pc_rhs; + } -> + { + Ast_503.Parsetree.pc_lhs = copy_pattern pc_lhs; + Ast_503.Parsetree.pc_guard = Option.map copy_expression pc_guard; + Ast_503.Parsetree.pc_rhs = copy_expression pc_rhs; + } + +and copy_value_binding : + Ast_504.Parsetree.value_binding -> Ast_503.Parsetree.value_binding = + fun { + Ast_504.Parsetree.pvb_pat; + Ast_504.Parsetree.pvb_expr; + Ast_504.Parsetree.pvb_constraint; + Ast_504.Parsetree.pvb_attributes; + Ast_504.Parsetree.pvb_loc; + } -> + { + Ast_503.Parsetree.pvb_pat = copy_pattern pvb_pat; + Ast_503.Parsetree.pvb_expr = copy_expression pvb_expr; + Ast_503.Parsetree.pvb_constraint = + Option.map copy_value_constraint pvb_constraint; + Ast_503.Parsetree.pvb_attributes = copy_attributes pvb_attributes; + Ast_503.Parsetree.pvb_loc = copy_location pvb_loc; + } + +and copy_pattern : Ast_504.Parsetree.pattern -> Ast_503.Parsetree.pattern = + fun { + Ast_504.Parsetree.ppat_desc; + Ast_504.Parsetree.ppat_loc; + Ast_504.Parsetree.ppat_loc_stack; + Ast_504.Parsetree.ppat_attributes; + } -> + let ppat_loc = copy_location ppat_loc in + { + Ast_503.Parsetree.ppat_desc = copy_pattern_desc ppat_loc ppat_desc; + Ast_503.Parsetree.ppat_loc; + Ast_503.Parsetree.ppat_loc_stack = copy_location_stack ppat_loc_stack; + Ast_503.Parsetree.ppat_attributes = copy_attributes ppat_attributes; + } + +and copy_pattern_desc loc : + Ast_504.Parsetree.pattern_desc -> Ast_503.Parsetree.pattern_desc = function + | Ast_504.Parsetree.Ppat_any -> Ast_503.Parsetree.Ppat_any + | Ast_504.Parsetree.Ppat_var x0 -> + Ast_503.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_504.Parsetree.Ppat_alias (x0, x1) -> + Ast_503.Parsetree.Ppat_alias (copy_pattern x0, copy_loc (fun x -> x) x1) + | Ast_504.Parsetree.Ppat_constant x0 -> + Ast_503.Parsetree.Ppat_constant (copy_constant x0) + | Ast_504.Parsetree.Ppat_interval (x0, x1) -> + Ast_503.Parsetree.Ppat_interval (copy_constant x0, copy_constant x1) + | Ast_504.Parsetree.Ppat_tuple (x0, _) -> + let args = + List.map + (function + | None, arg -> arg + | Some l, _ -> migration_error loc "labelled tuples") + x0 + in + Ast_503.Parsetree.Ppat_tuple (List.map copy_pattern args) + | Ast_504.Parsetree.Ppat_construct (x0, x1) -> + Ast_503.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_504.Parsetree.Ppat_variant (x0, x1) -> + Ast_503.Parsetree.Ppat_variant (copy_label x0, Option.map copy_pattern x1) + | Ast_504.Parsetree.Ppat_record (x0, x1) -> + Ast_503.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_504.Parsetree.Ppat_array x0 -> + Ast_503.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_504.Parsetree.Ppat_or (x0, x1) -> + Ast_503.Parsetree.Ppat_or (copy_pattern x0, copy_pattern x1) + | Ast_504.Parsetree.Ppat_constraint (x0, x1) -> + Ast_503.Parsetree.Ppat_constraint (copy_pattern x0, copy_core_type x1) + | Ast_504.Parsetree.Ppat_type x0 -> + Ast_503.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_504.Parsetree.Ppat_lazy x0 -> + Ast_503.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_504.Parsetree.Ppat_unpack x0 -> + Ast_503.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_504.Parsetree.Ppat_exception x0 -> + Ast_503.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_504.Parsetree.Ppat_effect (e, c) -> + Ast_503.Parsetree.Ppat_extension + ( Location.{ txt = "ppxlib.migration.ppat_effect"; loc }, + Ast_503.Parsetree.PPat + ( { + ppat_desc = Ppat_tuple [ copy_pattern e; copy_pattern c ]; + ppat_attributes = []; + ppat_loc_stack = []; + ppat_loc = loc; + }, + None ) ) + | Ast_504.Parsetree.Ppat_extension x0 -> + Ast_503.Parsetree.Ppat_extension (copy_extension x0) + | Ast_504.Parsetree.Ppat_open (x0, x1) -> + Ast_503.Parsetree.Ppat_open (copy_loc copy_Longident_t x0, copy_pattern x1) + +and copy_value_constraint : + Ast_504.Parsetree.value_constraint -> Ast_503.Parsetree.value_constraint = + function + | Ast_504.Parsetree.Pvc_constraint { locally_abstract_univars; typ } -> + Ast_503.Parsetree.Pvc_constraint + { + locally_abstract_univars = + List.map (copy_loc (fun x -> x)) locally_abstract_univars; + typ = copy_core_type typ; + } + | Ast_504.Parsetree.Pvc_coercion { ground; coercion } -> + Ast_503.Parsetree.Pvc_coercion + { + ground = Option.map copy_core_type ground; + coercion = copy_core_type coercion; + } + +and copy_core_type : Ast_504.Parsetree.core_type -> Ast_503.Parsetree.core_type + = + fun { + Ast_504.Parsetree.ptyp_desc; + Ast_504.Parsetree.ptyp_loc; + Ast_504.Parsetree.ptyp_loc_stack; + Ast_504.Parsetree.ptyp_attributes; + } -> + { + Ast_503.Parsetree.ptyp_desc = copy_core_type_desc ptyp_desc; + Ast_503.Parsetree.ptyp_loc = copy_location ptyp_loc; + Ast_503.Parsetree.ptyp_loc_stack = copy_location_stack ptyp_loc_stack; + Ast_503.Parsetree.ptyp_attributes = copy_attributes ptyp_attributes; + } + +and copy_location_stack : + Ast_504.Parsetree.location_stack -> Ast_503.Parsetree.location_stack = + fun x -> List.map copy_location x + +and copy_core_type_desc : + Ast_504.Parsetree.core_type_desc -> Ast_503.Parsetree.core_type_desc = + function + | Ast_504.Parsetree.Ptyp_any -> Ast_503.Parsetree.Ptyp_any + | Ast_504.Parsetree.Ptyp_var x0 -> Ast_503.Parsetree.Ptyp_var x0 + | Ast_504.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_503.Parsetree.Ptyp_arrow + (copy_arg_label x0, copy_core_type x1, copy_core_type x2) + | Ast_504.Parsetree.Ptyp_tuple x0 -> + let args = + List.map + (function + | None, arg -> arg + | Some l, (arg : Ast_504.Parsetree.core_type) -> + migration_error arg.ptyp_loc "labelled tuples") + x0 (* TODO: Proper migration error *) + in + Ast_503.Parsetree.Ptyp_tuple (List.map copy_core_type args) + | Ast_504.Parsetree.Ptyp_constr (x0, x1) -> + Ast_503.Parsetree.Ptyp_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Ptyp_object (x0, x1) -> + Ast_503.Parsetree.Ptyp_object + (List.map copy_object_field x0, copy_closed_flag x1) + | Ast_504.Parsetree.Ptyp_class (x0, x1) -> + Ast_503.Parsetree.Ptyp_class + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Ptyp_alias (x0, x1) -> + Ast_503.Parsetree.Ptyp_alias (copy_core_type x0, copy_loc (fun x -> x) x1) + | Ast_504.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_503.Parsetree.Ptyp_variant + ( List.map copy_row_field x0, + copy_closed_flag x1, + Option.map (fun x -> List.map copy_label x) x2 ) + | Ast_504.Parsetree.Ptyp_poly (x0, x1) -> + Ast_503.Parsetree.Ptyp_poly + (List.map (fun x -> copy_loc (fun x -> x) x) x0, copy_core_type x1) + | Ast_504.Parsetree.Ptyp_package x0 -> + Ast_503.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_504.Parsetree.Ptyp_open (x0, ty) -> + Ast_503.Parsetree.Ptyp_open + (copy_loc copy_Longident_t x0, copy_core_type ty) + | Ast_504.Parsetree.Ptyp_extension x0 -> + Ast_503.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + Ast_504.Parsetree.package_type -> Ast_503.Parsetree.package_type = + fun { ppt_path; ppt_cstrs; ppt_loc = _; ppt_attrs = _ } -> + ( copy_loc copy_Longident_t ppt_path, + List.map + (fun x -> + let x0, x1 = x in + (copy_loc copy_Longident_t x0, copy_core_type x1)) + ppt_cstrs ) + +and copy_row_field : Ast_504.Parsetree.row_field -> Ast_503.Parsetree.row_field + = + fun { + Ast_504.Parsetree.prf_desc; + Ast_504.Parsetree.prf_loc; + Ast_504.Parsetree.prf_attributes; + } -> + { + Ast_503.Parsetree.prf_desc = copy_row_field_desc prf_desc; + Ast_503.Parsetree.prf_loc = copy_location prf_loc; + Ast_503.Parsetree.prf_attributes = copy_attributes prf_attributes; + } + +and copy_row_field_desc : + Ast_504.Parsetree.row_field_desc -> Ast_503.Parsetree.row_field_desc = + function + | Ast_504.Parsetree.Rtag (x0, x1, x2) -> + Ast_503.Parsetree.Rtag + (copy_loc copy_label x0, x1, List.map copy_core_type x2) + | Ast_504.Parsetree.Rinherit x0 -> + Ast_503.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + Ast_504.Parsetree.object_field -> Ast_503.Parsetree.object_field = + fun { + Ast_504.Parsetree.pof_desc; + Ast_504.Parsetree.pof_loc; + Ast_504.Parsetree.pof_attributes; + } -> + { + Ast_503.Parsetree.pof_desc = copy_object_field_desc pof_desc; + Ast_503.Parsetree.pof_loc = copy_location pof_loc; + Ast_503.Parsetree.pof_attributes = copy_attributes pof_attributes; + } + +and copy_attributes : + Ast_504.Parsetree.attributes -> Ast_503.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : Ast_504.Parsetree.attribute -> Ast_503.Parsetree.attribute + = + fun { + Ast_504.Parsetree.attr_name; + Ast_504.Parsetree.attr_payload; + Ast_504.Parsetree.attr_loc; + } -> + { + Ast_503.Parsetree.attr_name = copy_loc (fun x -> x) attr_name; + Ast_503.Parsetree.attr_payload = copy_payload attr_payload; + Ast_503.Parsetree.attr_loc = copy_location attr_loc; + } + +and copy_payload : Ast_504.Parsetree.payload -> Ast_503.Parsetree.payload = + function + | Ast_504.Parsetree.PStr x0 -> Ast_503.Parsetree.PStr (copy_structure x0) + | Ast_504.Parsetree.PSig x0 -> Ast_503.Parsetree.PSig (copy_signature x0) + | Ast_504.Parsetree.PTyp x0 -> Ast_503.Parsetree.PTyp (copy_core_type x0) + | Ast_504.Parsetree.PPat (x0, x1) -> + Ast_503.Parsetree.PPat (copy_pattern x0, Option.map copy_expression x1) + +and copy_structure : Ast_504.Parsetree.structure -> Ast_503.Parsetree.structure + = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + Ast_504.Parsetree.structure_item -> Ast_503.Parsetree.structure_item = + fun { Ast_504.Parsetree.pstr_desc; Ast_504.Parsetree.pstr_loc } -> + { + Ast_503.Parsetree.pstr_desc = copy_structure_item_desc pstr_desc; + Ast_503.Parsetree.pstr_loc = copy_location pstr_loc; + } + +and copy_structure_item_desc : + Ast_504.Parsetree.structure_item_desc -> + Ast_503.Parsetree.structure_item_desc = function + | Ast_504.Parsetree.Pstr_eval (x0, x1) -> + Ast_503.Parsetree.Pstr_eval (copy_expression x0, copy_attributes x1) + | Ast_504.Parsetree.Pstr_value (x0, x1) -> + Ast_503.Parsetree.Pstr_value + (copy_rec_flag x0, List.map copy_value_binding x1) + | Ast_504.Parsetree.Pstr_primitive x0 -> + Ast_503.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_504.Parsetree.Pstr_type (x0, x1) -> + Ast_503.Parsetree.Pstr_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_504.Parsetree.Pstr_typext x0 -> + Ast_503.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_504.Parsetree.Pstr_exception x0 -> + Ast_503.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_504.Parsetree.Pstr_module x0 -> + Ast_503.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_504.Parsetree.Pstr_recmodule x0 -> + Ast_503.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_504.Parsetree.Pstr_modtype x0 -> + Ast_503.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_504.Parsetree.Pstr_open x0 -> + Ast_503.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_504.Parsetree.Pstr_class x0 -> + Ast_503.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_504.Parsetree.Pstr_class_type x0 -> + Ast_503.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_504.Parsetree.Pstr_include x0 -> + Ast_503.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_504.Parsetree.Pstr_attribute x0 -> + Ast_503.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pstr_extension (x0, x1) -> + Ast_503.Parsetree.Pstr_extension (copy_extension x0, copy_attributes x1) + +and copy_include_declaration : + Ast_504.Parsetree.include_declaration -> + Ast_503.Parsetree.include_declaration = + fun x -> copy_include_infos copy_module_expr x + +and copy_class_declaration : + Ast_504.Parsetree.class_declaration -> Ast_503.Parsetree.class_declaration = + fun x -> copy_class_infos copy_class_expr x + +and copy_class_expr : + Ast_504.Parsetree.class_expr -> Ast_503.Parsetree.class_expr = + fun { + Ast_504.Parsetree.pcl_desc; + Ast_504.Parsetree.pcl_loc; + Ast_504.Parsetree.pcl_attributes; + } -> + { + Ast_503.Parsetree.pcl_desc = copy_class_expr_desc pcl_desc; + Ast_503.Parsetree.pcl_loc = copy_location pcl_loc; + Ast_503.Parsetree.pcl_attributes = copy_attributes pcl_attributes; + } + +and copy_class_expr_desc : + Ast_504.Parsetree.class_expr_desc -> Ast_503.Parsetree.class_expr_desc = + function + | Ast_504.Parsetree.Pcl_constr (x0, x1) -> + Ast_503.Parsetree.Pcl_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Pcl_structure x0 -> + Ast_503.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_504.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_503.Parsetree.Pcl_fun + ( copy_arg_label x0, + Option.map copy_expression x1, + copy_pattern x2, + copy_class_expr x3 ) + | Ast_504.Parsetree.Pcl_apply (x0, x1) -> + Ast_503.Parsetree.Pcl_apply + ( copy_class_expr x0, + List.map + (fun x -> + let x0, x1 = x in + (copy_arg_label x0, copy_expression x1)) + x1 ) + | Ast_504.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_503.Parsetree.Pcl_let + (copy_rec_flag x0, List.map copy_value_binding x1, copy_class_expr x2) + | Ast_504.Parsetree.Pcl_constraint (x0, x1) -> + Ast_503.Parsetree.Pcl_constraint (copy_class_expr x0, copy_class_type x1) + | Ast_504.Parsetree.Pcl_extension x0 -> + Ast_503.Parsetree.Pcl_extension (copy_extension x0) + | Ast_504.Parsetree.Pcl_open (x0, x1) -> + Ast_503.Parsetree.Pcl_open (copy_open_description x0, copy_class_expr x1) + +and copy_class_structure : + Ast_504.Parsetree.class_structure -> Ast_503.Parsetree.class_structure = + fun { Ast_504.Parsetree.pcstr_self; Ast_504.Parsetree.pcstr_fields } -> + { + Ast_503.Parsetree.pcstr_self = copy_pattern pcstr_self; + Ast_503.Parsetree.pcstr_fields = List.map copy_class_field pcstr_fields; + } + +and copy_class_field : + Ast_504.Parsetree.class_field -> Ast_503.Parsetree.class_field = + fun { + Ast_504.Parsetree.pcf_desc; + Ast_504.Parsetree.pcf_loc; + Ast_504.Parsetree.pcf_attributes; + } -> + { + Ast_503.Parsetree.pcf_desc = copy_class_field_desc pcf_desc; + Ast_503.Parsetree.pcf_loc = copy_location pcf_loc; + Ast_503.Parsetree.pcf_attributes = copy_attributes pcf_attributes; + } + +and copy_class_field_desc : + Ast_504.Parsetree.class_field_desc -> Ast_503.Parsetree.class_field_desc = + function + | Ast_504.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_503.Parsetree.Pcf_inherit + ( copy_override_flag x0, + copy_class_expr x1, + Option.map (fun x -> copy_loc (fun x -> x) x) x2 ) + | Ast_504.Parsetree.Pcf_val x0 -> + Ast_503.Parsetree.Pcf_val + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_mutable_flag x1, copy_class_field_kind x2)) + | Ast_504.Parsetree.Pcf_method x0 -> + Ast_503.Parsetree.Pcf_method + (let x0, x1, x2 = x0 in + (copy_loc copy_label x0, copy_private_flag x1, copy_class_field_kind x2)) + | Ast_504.Parsetree.Pcf_constraint x0 -> + Ast_503.Parsetree.Pcf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_504.Parsetree.Pcf_initializer x0 -> + Ast_503.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_504.Parsetree.Pcf_attribute x0 -> + Ast_503.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pcf_extension x0 -> + Ast_503.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + Ast_504.Parsetree.class_field_kind -> Ast_503.Parsetree.class_field_kind = + function + | Ast_504.Parsetree.Cfk_virtual x0 -> + Ast_503.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_504.Parsetree.Cfk_concrete (x0, x1) -> + Ast_503.Parsetree.Cfk_concrete (copy_override_flag x0, copy_expression x1) + +and copy_open_declaration : + Ast_504.Parsetree.open_declaration -> Ast_503.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x + +and copy_module_binding : + Ast_504.Parsetree.module_binding -> Ast_503.Parsetree.module_binding = + fun { + Ast_504.Parsetree.pmb_name; + Ast_504.Parsetree.pmb_expr; + Ast_504.Parsetree.pmb_attributes; + Ast_504.Parsetree.pmb_loc; + } -> + { + Ast_503.Parsetree.pmb_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name; + Ast_503.Parsetree.pmb_expr = copy_module_expr pmb_expr; + Ast_503.Parsetree.pmb_attributes = copy_attributes pmb_attributes; + Ast_503.Parsetree.pmb_loc = copy_location pmb_loc; + } + +and copy_module_expr : + Ast_504.Parsetree.module_expr -> Ast_503.Parsetree.module_expr = + fun { + Ast_504.Parsetree.pmod_desc; + Ast_504.Parsetree.pmod_loc; + Ast_504.Parsetree.pmod_attributes; + } -> + { + Ast_503.Parsetree.pmod_desc = copy_module_expr_desc pmod_desc; + Ast_503.Parsetree.pmod_loc = copy_location pmod_loc; + Ast_503.Parsetree.pmod_attributes = copy_attributes pmod_attributes; + } + +and copy_module_expr_desc : + Ast_504.Parsetree.module_expr_desc -> Ast_503.Parsetree.module_expr_desc = + function + | Ast_504.Parsetree.Pmod_ident x0 -> + Ast_503.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_504.Parsetree.Pmod_structure x0 -> + Ast_503.Parsetree.Pmod_structure (copy_structure x0) + | Ast_504.Parsetree.Pmod_functor (x0, x1) -> + Ast_503.Parsetree.Pmod_functor + (copy_functor_parameter x0, copy_module_expr x1) + | Ast_504.Parsetree.Pmod_apply (x0, x1) -> + Ast_503.Parsetree.Pmod_apply (copy_module_expr x0, copy_module_expr x1) + | Ast_504.Parsetree.Pmod_apply_unit x0 -> + Ast_503.Parsetree.Pmod_apply_unit (copy_module_expr x0) + | Ast_504.Parsetree.Pmod_constraint (x0, x1) -> + Ast_503.Parsetree.Pmod_constraint + (copy_module_expr x0, copy_module_type x1) + | Ast_504.Parsetree.Pmod_unpack x0 -> + Ast_503.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_504.Parsetree.Pmod_extension x0 -> + Ast_503.Parsetree.Pmod_extension (copy_extension x0) + +and copy_functor_parameter : + Ast_504.Parsetree.functor_parameter -> Ast_503.Parsetree.functor_parameter = + function + | Ast_504.Parsetree.Unit -> Ast_503.Parsetree.Unit + | Ast_504.Parsetree.Named (x0, x1) -> + Ast_503.Parsetree.Named + (copy_loc (fun x -> Option.map (fun x -> x) x) x0, copy_module_type x1) + +and copy_module_type : + Ast_504.Parsetree.module_type -> Ast_503.Parsetree.module_type = + fun { + Ast_504.Parsetree.pmty_desc; + Ast_504.Parsetree.pmty_loc; + Ast_504.Parsetree.pmty_attributes; + } -> + { + Ast_503.Parsetree.pmty_desc = copy_module_type_desc pmty_desc; + Ast_503.Parsetree.pmty_loc = copy_location pmty_loc; + Ast_503.Parsetree.pmty_attributes = copy_attributes pmty_attributes; + } + +and copy_module_type_desc : + Ast_504.Parsetree.module_type_desc -> Ast_503.Parsetree.module_type_desc = + function + | Ast_504.Parsetree.Pmty_ident x0 -> + Ast_503.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_504.Parsetree.Pmty_signature x0 -> + Ast_503.Parsetree.Pmty_signature (copy_signature x0) + | Ast_504.Parsetree.Pmty_functor (x0, x1) -> + Ast_503.Parsetree.Pmty_functor + (copy_functor_parameter x0, copy_module_type x1) + | Ast_504.Parsetree.Pmty_with (x0, x1) -> + Ast_503.Parsetree.Pmty_with + (copy_module_type x0, List.map copy_with_constraint x1) + | Ast_504.Parsetree.Pmty_typeof x0 -> + Ast_503.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_504.Parsetree.Pmty_extension x0 -> + Ast_503.Parsetree.Pmty_extension (copy_extension x0) + | Ast_504.Parsetree.Pmty_alias x0 -> + Ast_503.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) + +and copy_with_constraint : + Ast_504.Parsetree.with_constraint -> Ast_503.Parsetree.with_constraint = + function + | Ast_504.Parsetree.Pwith_type (x0, x1) -> + Ast_503.Parsetree.Pwith_type + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_504.Parsetree.Pwith_module (x0, x1) -> + Ast_503.Parsetree.Pwith_module + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + | Ast_504.Parsetree.Pwith_modtype (x0, x1) -> + Ast_503.Parsetree.Pwith_modtype + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_504.Parsetree.Pwith_modtypesubst (x0, x1) -> + Ast_503.Parsetree.Pwith_modtypesubst + (copy_loc copy_Longident_t x0, copy_module_type x1) + | Ast_504.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_503.Parsetree.Pwith_typesubst + (copy_loc copy_Longident_t x0, copy_type_declaration x1) + | Ast_504.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_503.Parsetree.Pwith_modsubst + (copy_loc copy_Longident_t x0, copy_loc copy_Longident_t x1) + +and copy_signature : Ast_504.Parsetree.signature -> Ast_503.Parsetree.signature + = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + Ast_504.Parsetree.signature_item -> Ast_503.Parsetree.signature_item = + fun { Ast_504.Parsetree.psig_desc; Ast_504.Parsetree.psig_loc } -> + { + Ast_503.Parsetree.psig_desc = copy_signature_item_desc psig_desc; + Ast_503.Parsetree.psig_loc = copy_location psig_loc; + } + +and copy_signature_item_desc : + Ast_504.Parsetree.signature_item_desc -> + Ast_503.Parsetree.signature_item_desc = function + | Ast_504.Parsetree.Psig_value x0 -> + Ast_503.Parsetree.Psig_value (copy_value_description x0) + | Ast_504.Parsetree.Psig_type (x0, x1) -> + Ast_503.Parsetree.Psig_type + (copy_rec_flag x0, List.map copy_type_declaration x1) + | Ast_504.Parsetree.Psig_typesubst x0 -> + Ast_503.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_504.Parsetree.Psig_typext x0 -> + Ast_503.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_504.Parsetree.Psig_exception x0 -> + Ast_503.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_504.Parsetree.Psig_module x0 -> + Ast_503.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_504.Parsetree.Psig_modsubst x0 -> + Ast_503.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_504.Parsetree.Psig_recmodule x0 -> + Ast_503.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_504.Parsetree.Psig_modtype x0 -> + Ast_503.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_504.Parsetree.Psig_modtypesubst x0 -> + Ast_503.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) + | Ast_504.Parsetree.Psig_open x0 -> + Ast_503.Parsetree.Psig_open (copy_open_description x0) + | Ast_504.Parsetree.Psig_include x0 -> + Ast_503.Parsetree.Psig_include (copy_include_description x0) + | Ast_504.Parsetree.Psig_class x0 -> + Ast_503.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_504.Parsetree.Psig_class_type x0 -> + Ast_503.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_504.Parsetree.Psig_attribute x0 -> + Ast_503.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_504.Parsetree.Psig_extension (x0, x1) -> + Ast_503.Parsetree.Psig_extension (copy_extension x0, copy_attributes x1) + +and copy_class_type_declaration : + Ast_504.Parsetree.class_type_declaration -> + Ast_503.Parsetree.class_type_declaration = + fun x -> copy_class_infos copy_class_type x + +and copy_class_description : + Ast_504.Parsetree.class_description -> Ast_503.Parsetree.class_description = + fun x -> copy_class_infos copy_class_type x + +and copy_class_type : + Ast_504.Parsetree.class_type -> Ast_503.Parsetree.class_type = + fun { + Ast_504.Parsetree.pcty_desc; + Ast_504.Parsetree.pcty_loc; + Ast_504.Parsetree.pcty_attributes; + } -> + { + Ast_503.Parsetree.pcty_desc = copy_class_type_desc pcty_desc; + Ast_503.Parsetree.pcty_loc = copy_location pcty_loc; + Ast_503.Parsetree.pcty_attributes = copy_attributes pcty_attributes; + } + +and copy_class_type_desc : + Ast_504.Parsetree.class_type_desc -> Ast_503.Parsetree.class_type_desc = + function + | Ast_504.Parsetree.Pcty_constr (x0, x1) -> + Ast_503.Parsetree.Pcty_constr + (copy_loc copy_Longident_t x0, List.map copy_core_type x1) + | Ast_504.Parsetree.Pcty_signature x0 -> + Ast_503.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_504.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_503.Parsetree.Pcty_arrow + (copy_arg_label x0, copy_core_type x1, copy_class_type x2) + | Ast_504.Parsetree.Pcty_extension x0 -> + Ast_503.Parsetree.Pcty_extension (copy_extension x0) + | Ast_504.Parsetree.Pcty_open (x0, x1) -> + Ast_503.Parsetree.Pcty_open (copy_open_description x0, copy_class_type x1) + +and copy_class_signature : + Ast_504.Parsetree.class_signature -> Ast_503.Parsetree.class_signature = + fun { Ast_504.Parsetree.pcsig_self; Ast_504.Parsetree.pcsig_fields } -> + { + Ast_503.Parsetree.pcsig_self = copy_core_type pcsig_self; + Ast_503.Parsetree.pcsig_fields = List.map copy_class_type_field pcsig_fields; + } + +and copy_class_type_field : + Ast_504.Parsetree.class_type_field -> Ast_503.Parsetree.class_type_field = + fun { + Ast_504.Parsetree.pctf_desc; + Ast_504.Parsetree.pctf_loc; + Ast_504.Parsetree.pctf_attributes; + } -> + { + Ast_503.Parsetree.pctf_desc = copy_class_type_field_desc pctf_desc; + Ast_503.Parsetree.pctf_loc = copy_location pctf_loc; + Ast_503.Parsetree.pctf_attributes = copy_attributes pctf_attributes; + } + +and copy_class_type_field_desc : + Ast_504.Parsetree.class_type_field_desc -> + Ast_503.Parsetree.class_type_field_desc = function + | Ast_504.Parsetree.Pctf_inherit x0 -> + Ast_503.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_504.Parsetree.Pctf_val x0 -> + Ast_503.Parsetree.Pctf_val + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_mutable_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_504.Parsetree.Pctf_method x0 -> + Ast_503.Parsetree.Pctf_method + (let x0, x1, x2, x3 = x0 in + ( copy_loc copy_label x0, + copy_private_flag x1, + copy_virtual_flag x2, + copy_core_type x3 )) + | Ast_504.Parsetree.Pctf_constraint x0 -> + Ast_503.Parsetree.Pctf_constraint + (let x0, x1 = x0 in + (copy_core_type x0, copy_core_type x1)) + | Ast_504.Parsetree.Pctf_attribute x0 -> + Ast_503.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_504.Parsetree.Pctf_extension x0 -> + Ast_503.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : Ast_504.Parsetree.extension -> Ast_503.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_504.Parsetree.class_infos -> + 'g0 Ast_503.Parsetree.class_infos = + fun f0 + { + Ast_504.Parsetree.pci_virt; + Ast_504.Parsetree.pci_params; + Ast_504.Parsetree.pci_name; + Ast_504.Parsetree.pci_expr; + Ast_504.Parsetree.pci_loc; + Ast_504.Parsetree.pci_attributes; + } -> + { + Ast_503.Parsetree.pci_virt = copy_virtual_flag pci_virt; + Ast_503.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_503.Parsetree.pci_name = copy_loc (fun x -> x) pci_name; + Ast_503.Parsetree.pci_expr = f0 pci_expr; + Ast_503.Parsetree.pci_loc = copy_location pci_loc; + Ast_503.Parsetree.pci_attributes = copy_attributes pci_attributes; + } + +and copy_virtual_flag : + Ast_504.Asttypes.virtual_flag -> Ast_503.Asttypes.virtual_flag = function + | Ast_504.Asttypes.Virtual -> Ast_503.Asttypes.Virtual + | Ast_504.Asttypes.Concrete -> Ast_503.Asttypes.Concrete + +and copy_include_description : + Ast_504.Parsetree.include_description -> + Ast_503.Parsetree.include_description = + fun x -> copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0. + ('f0 -> 'g0) -> + 'f0 Ast_504.Parsetree.include_infos -> + 'g0 Ast_503.Parsetree.include_infos = + fun f0 + { + Ast_504.Parsetree.pincl_mod; + Ast_504.Parsetree.pincl_loc; + Ast_504.Parsetree.pincl_attributes; + } -> + { + Ast_503.Parsetree.pincl_mod = f0 pincl_mod; + Ast_503.Parsetree.pincl_loc = copy_location pincl_loc; + Ast_503.Parsetree.pincl_attributes = copy_attributes pincl_attributes; + } + +and copy_open_description : + Ast_504.Parsetree.open_description -> Ast_503.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_504.Parsetree.open_infos -> + 'g0 Ast_503.Parsetree.open_infos = + fun f0 + { + Ast_504.Parsetree.popen_expr; + Ast_504.Parsetree.popen_override; + Ast_504.Parsetree.popen_loc; + Ast_504.Parsetree.popen_attributes; + } -> + { + Ast_503.Parsetree.popen_expr = f0 popen_expr; + Ast_503.Parsetree.popen_override = copy_override_flag popen_override; + Ast_503.Parsetree.popen_loc = copy_location popen_loc; + Ast_503.Parsetree.popen_attributes = copy_attributes popen_attributes; + } + +and copy_override_flag : + Ast_504.Asttypes.override_flag -> Ast_503.Asttypes.override_flag = function + | Ast_504.Asttypes.Override -> Ast_503.Asttypes.Override + | Ast_504.Asttypes.Fresh -> Ast_503.Asttypes.Fresh + +and copy_module_type_declaration : + Ast_504.Parsetree.module_type_declaration -> + Ast_503.Parsetree.module_type_declaration = + fun { + Ast_504.Parsetree.pmtd_name; + Ast_504.Parsetree.pmtd_type; + Ast_504.Parsetree.pmtd_attributes; + Ast_504.Parsetree.pmtd_loc; + } -> + { + Ast_503.Parsetree.pmtd_name = copy_loc (fun x -> x) pmtd_name; + Ast_503.Parsetree.pmtd_type = Option.map copy_module_type pmtd_type; + Ast_503.Parsetree.pmtd_attributes = copy_attributes pmtd_attributes; + Ast_503.Parsetree.pmtd_loc = copy_location pmtd_loc; + } + +and copy_module_substitution : + Ast_504.Parsetree.module_substitution -> + Ast_503.Parsetree.module_substitution = + fun { + Ast_504.Parsetree.pms_name; + Ast_504.Parsetree.pms_manifest; + Ast_504.Parsetree.pms_attributes; + Ast_504.Parsetree.pms_loc; + } -> + { + Ast_503.Parsetree.pms_name = copy_loc (fun x -> x) pms_name; + Ast_503.Parsetree.pms_manifest = copy_loc copy_Longident_t pms_manifest; + Ast_503.Parsetree.pms_attributes = copy_attributes pms_attributes; + Ast_503.Parsetree.pms_loc = copy_location pms_loc; + } + +and copy_module_declaration : + Ast_504.Parsetree.module_declaration -> Ast_503.Parsetree.module_declaration + = + fun { + Ast_504.Parsetree.pmd_name; + Ast_504.Parsetree.pmd_type; + Ast_504.Parsetree.pmd_attributes; + Ast_504.Parsetree.pmd_loc; + } -> + { + Ast_503.Parsetree.pmd_name = + copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name; + Ast_503.Parsetree.pmd_type = copy_module_type pmd_type; + Ast_503.Parsetree.pmd_attributes = copy_attributes pmd_attributes; + Ast_503.Parsetree.pmd_loc = copy_location pmd_loc; + } + +and copy_type_exception : + Ast_504.Parsetree.type_exception -> Ast_503.Parsetree.type_exception = + fun { + Ast_504.Parsetree.ptyexn_constructor; + Ast_504.Parsetree.ptyexn_loc; + Ast_504.Parsetree.ptyexn_attributes; + } -> + { + Ast_503.Parsetree.ptyexn_constructor = + copy_extension_constructor ptyexn_constructor; + Ast_503.Parsetree.ptyexn_loc = copy_location ptyexn_loc; + Ast_503.Parsetree.ptyexn_attributes = copy_attributes ptyexn_attributes; + } + +and copy_type_extension : + Ast_504.Parsetree.type_extension -> Ast_503.Parsetree.type_extension = + fun { + Ast_504.Parsetree.ptyext_path; + Ast_504.Parsetree.ptyext_params; + Ast_504.Parsetree.ptyext_constructors; + Ast_504.Parsetree.ptyext_private; + Ast_504.Parsetree.ptyext_loc; + Ast_504.Parsetree.ptyext_attributes; + } -> + { + Ast_503.Parsetree.ptyext_path = copy_loc copy_Longident_t ptyext_path; + Ast_503.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_503.Parsetree.ptyext_constructors = + List.map copy_extension_constructor ptyext_constructors; + Ast_503.Parsetree.ptyext_private = copy_private_flag ptyext_private; + Ast_503.Parsetree.ptyext_loc = copy_location ptyext_loc; + Ast_503.Parsetree.ptyext_attributes = copy_attributes ptyext_attributes; + } + +and copy_extension_constructor : + Ast_504.Parsetree.extension_constructor -> + Ast_503.Parsetree.extension_constructor = + fun { + Ast_504.Parsetree.pext_name; + Ast_504.Parsetree.pext_kind; + Ast_504.Parsetree.pext_loc; + Ast_504.Parsetree.pext_attributes; + } -> + { + Ast_503.Parsetree.pext_name = copy_loc (fun x -> x) pext_name; + Ast_503.Parsetree.pext_kind = copy_extension_constructor_kind pext_kind; + Ast_503.Parsetree.pext_loc = copy_location pext_loc; + Ast_503.Parsetree.pext_attributes = copy_attributes pext_attributes; + } + +and copy_extension_constructor_kind : + Ast_504.Parsetree.extension_constructor_kind -> + Ast_503.Parsetree.extension_constructor_kind = function + | Ast_504.Parsetree.Pext_decl (x0, x1, x2) -> + Ast_503.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_504.Parsetree.Pext_rebind x0 -> + Ast_503.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) + +and copy_type_declaration : + Ast_504.Parsetree.type_declaration -> Ast_503.Parsetree.type_declaration = + fun { + Ast_504.Parsetree.ptype_name; + Ast_504.Parsetree.ptype_params; + Ast_504.Parsetree.ptype_cstrs; + Ast_504.Parsetree.ptype_kind; + Ast_504.Parsetree.ptype_private; + Ast_504.Parsetree.ptype_manifest; + Ast_504.Parsetree.ptype_attributes; + Ast_504.Parsetree.ptype_loc; + } -> + { + Ast_503.Parsetree.ptype_name = copy_loc (fun x -> x) ptype_name; + Ast_503.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_503.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_503.Parsetree.ptype_kind = copy_type_kind ptype_kind; + Ast_503.Parsetree.ptype_private = copy_private_flag ptype_private; + Ast_503.Parsetree.ptype_manifest = Option.map copy_core_type ptype_manifest; + Ast_503.Parsetree.ptype_attributes = copy_attributes ptype_attributes; + Ast_503.Parsetree.ptype_loc = copy_location ptype_loc; + } + +and copy_private_flag : + Ast_504.Asttypes.private_flag -> Ast_503.Asttypes.private_flag = function + | Ast_504.Asttypes.Private -> Ast_503.Asttypes.Private + | Ast_504.Asttypes.Public -> Ast_503.Asttypes.Public + +and copy_type_kind : Ast_504.Parsetree.type_kind -> Ast_503.Parsetree.type_kind + = function + | Ast_504.Parsetree.Ptype_abstract -> Ast_503.Parsetree.Ptype_abstract + | Ast_504.Parsetree.Ptype_variant x0 -> + Ast_503.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) + | Ast_504.Parsetree.Ptype_record x0 -> + Ast_503.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_504.Parsetree.Ptype_open -> Ast_503.Parsetree.Ptype_open + +and copy_constructor_declaration : + Ast_504.Parsetree.constructor_declaration -> + Ast_503.Parsetree.constructor_declaration = + fun { + Ast_504.Parsetree.pcd_name; + Ast_504.Parsetree.pcd_vars; + Ast_504.Parsetree.pcd_args; + Ast_504.Parsetree.pcd_res; + Ast_504.Parsetree.pcd_loc; + Ast_504.Parsetree.pcd_attributes; + } -> + { + Ast_503.Parsetree.pcd_name = copy_loc (fun x -> x) pcd_name; + Ast_503.Parsetree.pcd_vars = + List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars; + Ast_503.Parsetree.pcd_args = copy_constructor_arguments pcd_args; + Ast_503.Parsetree.pcd_res = Option.map copy_core_type pcd_res; + Ast_503.Parsetree.pcd_loc = copy_location pcd_loc; + Ast_503.Parsetree.pcd_attributes = copy_attributes pcd_attributes; + } + +and copy_constructor_arguments : + Ast_504.Parsetree.constructor_arguments -> + Ast_503.Parsetree.constructor_arguments = function + | Ast_504.Parsetree.Pcstr_tuple x0 -> + Ast_503.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_504.Parsetree.Pcstr_record x0 -> + Ast_503.Parsetree.Pcstr_record (List.map copy_label_declaration x0) + +and copy_label_declaration : + Ast_504.Parsetree.label_declaration -> Ast_503.Parsetree.label_declaration = + fun { + Ast_504.Parsetree.pld_name; + Ast_504.Parsetree.pld_mutable; + Ast_504.Parsetree.pld_type; + Ast_504.Parsetree.pld_loc; + Ast_504.Parsetree.pld_attributes; + } -> + { + Ast_503.Parsetree.pld_name = copy_loc (fun x -> x) pld_name; + Ast_503.Parsetree.pld_mutable = copy_mutable_flag pld_mutable; + Ast_503.Parsetree.pld_type = copy_core_type pld_type; + Ast_503.Parsetree.pld_loc = copy_location pld_loc; + Ast_503.Parsetree.pld_attributes = copy_attributes pld_attributes; + } + +and copy_mutable_flag : + Ast_504.Asttypes.mutable_flag -> Ast_503.Asttypes.mutable_flag = function + | Ast_504.Asttypes.Immutable -> Ast_503.Asttypes.Immutable + | Ast_504.Asttypes.Mutable -> Ast_503.Asttypes.Mutable + +and copy_injectivity : + Ast_504.Asttypes.injectivity -> Ast_503.Asttypes.injectivity = function + | Ast_504.Asttypes.Injective -> Ast_503.Asttypes.Injective + | Ast_504.Asttypes.NoInjectivity -> Ast_503.Asttypes.NoInjectivity + +and copy_variance : Ast_504.Asttypes.variance -> Ast_503.Asttypes.variance = + function + | Ast_504.Asttypes.Covariant -> Ast_503.Asttypes.Covariant + | Ast_504.Asttypes.Contravariant -> Ast_503.Asttypes.Contravariant + | Ast_504.Asttypes.NoVariance -> Ast_503.Asttypes.NoVariance + | Ast_504.Asttypes.Bivariant -> migration_error Location.none "bivarance" + +and copy_value_description : + Ast_504.Parsetree.value_description -> Ast_503.Parsetree.value_description = + fun { + Ast_504.Parsetree.pval_name; + Ast_504.Parsetree.pval_type; + Ast_504.Parsetree.pval_prim; + Ast_504.Parsetree.pval_attributes; + Ast_504.Parsetree.pval_loc; + } -> + { + Ast_503.Parsetree.pval_name = copy_loc (fun x -> x) pval_name; + Ast_503.Parsetree.pval_type = copy_core_type pval_type; + Ast_503.Parsetree.pval_prim = List.map (fun x -> x) pval_prim; + Ast_503.Parsetree.pval_attributes = copy_attributes pval_attributes; + Ast_503.Parsetree.pval_loc = copy_location pval_loc; + } + +and copy_object_field_desc : + Ast_504.Parsetree.object_field_desc -> Ast_503.Parsetree.object_field_desc = + function + | Ast_504.Parsetree.Otag (x0, x1) -> + Ast_503.Parsetree.Otag (copy_loc copy_label x0, copy_core_type x1) + | Ast_504.Parsetree.Oinherit x0 -> + Ast_503.Parsetree.Oinherit (copy_core_type x0) + +and copy_arg_label : Ast_504.Asttypes.arg_label -> Ast_503.Asttypes.arg_label = + function + | Ast_504.Asttypes.Nolabel -> Ast_503.Asttypes.Nolabel + | Ast_504.Asttypes.Labelled x0 -> Ast_503.Asttypes.Labelled x0 + | Ast_504.Asttypes.Optional x0 -> Ast_503.Asttypes.Optional x0 + +and copy_closed_flag : + Ast_504.Asttypes.closed_flag -> Ast_503.Asttypes.closed_flag = function + | Ast_504.Asttypes.Closed -> Ast_503.Asttypes.Closed + | Ast_504.Asttypes.Open -> Ast_503.Asttypes.Open + +and copy_label : Ast_504.Asttypes.label -> Ast_503.Asttypes.label = fun x -> x + +and copy_rec_flag : Ast_504.Asttypes.rec_flag -> Ast_503.Asttypes.rec_flag = + function + | Ast_504.Asttypes.Nonrecursive -> Ast_503.Asttypes.Nonrecursive + | Ast_504.Asttypes.Recursive -> Ast_503.Asttypes.Recursive + +and copy_constant : Ast_504.Parsetree.constant -> Ast_503.Parsetree.constant = + fun const -> + let pconst_desc = + match const.pconst_desc with + | Ast_504.Parsetree.Pconst_integer (x0, x1) -> + Ast_503.Parsetree.Pconst_integer (x0, Option.map (fun x -> x) x1) + | Ast_504.Parsetree.Pconst_char x0 -> Ast_503.Parsetree.Pconst_char x0 + | Ast_504.Parsetree.Pconst_string (x0, x1, x2) -> + Ast_503.Parsetree.Pconst_string + (x0, copy_location x1, Option.map (fun x -> x) x2) + | Ast_504.Parsetree.Pconst_float (x0, x1) -> + Ast_503.Parsetree.Pconst_float (x0, Option.map (fun x -> x) x1) + in + { pconst_desc; pconst_loc = copy_location const.pconst_loc } + +and copy_Longident_t : Longident.t -> Legacy_longident.t = function + | Longident.Lident x0 -> Legacy_longident.Lident x0 + | Longident.Ldot (x0, x1) -> + Legacy_longident.Ldot (copy_Longident_t x0.txt, x1.txt) + | Longident.Lapply (x0, x1) -> + Legacy_longident.Lapply (copy_Longident_t x0.txt, copy_Longident_t x1.txt) + +and copy_loc : + 'f0 'g0. + ('f0 -> 'g0) -> 'f0 Ast_504.Asttypes.loc -> 'g0 Ast_503.Asttypes.loc = + fun f0 { Ast_504.Asttypes.txt; Ast_504.Asttypes.loc } -> + { Ast_503.Asttypes.txt = f0 txt; Ast_503.Asttypes.loc = copy_location loc } + +and copy_location : Location.t -> Location.t = fun x -> x diff --git a/astlib/pp/pp_rewrite.mll b/astlib/pp/pp_rewrite.mll index f33bffba1..699121111 100644 --- a/astlib/pp/pp_rewrite.mll +++ b/astlib/pp/pp_rewrite.mll @@ -7,7 +7,7 @@ rule rewrite is_current ocaml_version = parse print_string chunk; rewrite is_current ocaml_version lexbuf } - | "(*IF_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)" + | "(*IF_AT_LEAST " ([^'*' ' ']* as v) " " (([^'*'] | '*' [^')'])* as s) "*)" { let chunk = if (v <= ocaml_version) then " " ^ String.make (String.length v + 1) ' ' ^ s ^ " " else Lexing.lexeme lexbuf @@ -15,7 +15,7 @@ rule rewrite is_current ocaml_version = parse print_string chunk; rewrite is_current ocaml_version lexbuf } - | "(*IF_NOT_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)" + | "(*IF_NOT_AT_LEAST " ([^'*' ' ']* as v) " " (([^'*'] | '*' [^')'])* as s) "*)" { let chunk = if not (v <= ocaml_version) then " " ^ String.make (String.length v + 1) ' ' ^ s ^ " " else Lexing.lexeme lexbuf @@ -29,4 +29,3 @@ rule rewrite is_current ocaml_version = parse } | eof { () } - diff --git a/src/gen/import.ml b/src/gen/import.ml index 30fff3672..5001a5950 100644 --- a/src/gen/import.ml +++ b/src/gen/import.ml @@ -2,6 +2,7 @@ open Astlib include Ppxlib_ast include Ast open Ast_helper +module Longident = Legacy_longident let loc = (* This is fine, because the location info is thrown away when the generated code diff --git a/test/base/test.ml b/test/base/test.ml index 3f91af20a..6f94fbcb6 100644 --- a/test/base/test.ml +++ b/test/base/test.ml @@ -60,59 +60,96 @@ val convert_longident : string -> string * longident = |}] let _ = convert_longident "x" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("x", Ppxlib.Longident.Lident "x") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("x", Longident.Lident "x") +|}] let _ = convert_longident "(+)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( + )", Ppxlib.Longident.Lident "+") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( + )", Longident.Lident "+") +|}] let _ = convert_longident "( + )" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( + )", Ppxlib.Longident.Lident "+") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( + )", Longident.Lident "+") +|}] let _ = convert_longident "Base.x" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Base.x", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "x")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Base.x", Longident.Ldot (Longident.Lident "Base", "x")) +|}] let _ = convert_longident "Base.(+)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Base.( + )", Longident.Ldot (Longident.Lident "Base", "+")) +|}] let _ = convert_longident "Base.( + )" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Base.( + )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "+")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Base.( + )", Longident.Ldot (Longident.Lident "Base", "+")) +|}] let _ = convert_longident "Base.( land )" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Base.( land )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Base", "land")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Base.( land )", Longident.Ldot (Longident.Lident "Base", "land")) +|}] let _ = convert_longident "A(B)" -[%%expect{| +[%%expect_in <= 5.3 {| +Exception: +Invalid_argument "Ppxlib.Longident.parse(application in path): \"A(B)\"". +|}] +[%%expect_in >= 5.4 {| Exception: Invalid_argument "Ppxlib.Longident.parse(application in path): \"A(B)\"". |}] let _ = convert_longident "A.B(C)" -[%%expect{| +[%%expect_in <= 5.3 {| +Exception: +Invalid_argument "Ppxlib.Longident.parse(application in path): \"A.B(C)\"". +|}] +[%%expect_in >= 5.4 {| Exception: Invalid_argument "Ppxlib.Longident.parse(application in path): \"A.B(C)\"". |}] let _ = convert_longident ")" -[%%expect{| +[%%expect_in <= 5.3 {| +Exception: +Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \")\"". +|}] +[%%expect_in >= 5.4 {| Exception: Invalid_argument "Ppxlib.Longident.parse(unbalanced parenthesis): \")\"". |}] @@ -137,45 +174,69 @@ Invalid_argument |}] let _ = convert_longident "+." -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( +. )", Ppxlib.Longident.Lident "+.") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( +. )", Longident.Lident "+.") +|}] let _ = convert_longident "(+.)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( +. )", Ppxlib.Longident.Lident "+.") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( +. )", Longident.Lident "+.") +|}] let _ = convert_longident "Foo.(+.)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Foo.( +. )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Foo", "+.")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Foo.( +. )", Longident.Ldot (Longident.Lident "Foo", "+.")) +|}] let _ = convert_longident "Foo.( *. )" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Foo.( *. )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Foo", "*.")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Foo.( *. )", Longident.Ldot (Longident.Lident "Foo", "*.")) +|}] (* Indexing operators *) let _ = convert_longident "(.!())" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( .!() )", Ppxlib.Longident.Lident ".!()") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( .!() )", Longident.Lident ".!()") +|}] let _ = convert_longident "(.%(;..)<-)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("( .%(;..)<- )", Ppxlib.Longident.Lident ".%(;..)<-") |}] +[%%expect_in >= 5.4 {| +- : string * longident = ("( .%(;..)<- )", Longident.Lident ".%(;..)<-") +|}] let _ = convert_longident "Vec.(.%(;..)<-)" -[%%expect{| +[%%expect_in <= 5.3 {| - : string * longident = ("Vec.( .%(;..)<- )", Ppxlib.Longident.Ldot (Ppxlib.Longident.Lident "Vec", ".%(;..)<-")) |}] +[%%expect_in >= 5.4 {| +- : string * longident = +("Vec.( .%(;..)<- )", Longident.Ldot (Longident.Lident "Vec", ".%(;..)<-")) +|}] let _ = Ppxlib.Code_path.(file_path @@ top_level ~file_path:"dir/main.ml") [%%expect{| diff --git a/test/driver/ocaml-ppx-context-load-path-migration/driver.ml b/test/driver/ocaml-ppx-context-load-path-migration/driver.ml index da781e210..07802523b 100644 --- a/test/driver/ocaml-ppx-context-load-path-migration/driver.ml +++ b/test/driver/ocaml-ppx-context-load-path-migration/driver.ml @@ -10,10 +10,11 @@ module Before_502_to_ocaml = (Ppxlib_ast.Compiler_version) module OCaml_501 = Ppxlib_ast__.Versions.OCaml_501.Ast +module Longident = Astlib.Legacy_longident let rec unfold_list_lit x next = let open OCaml_501.Parsetree in - let open Astlib.Longident in + let open Longident in match next.pexp_desc with | Pexp_construct ({ txt = Lident "[]"; _ }, None) -> [ x ] | Pexp_construct @@ -25,7 +26,7 @@ let rec unfold_list_lit x next = (* Only deals with the basic blocks needed for ocaml.ppx.context *) let rec basic_expr_to_string expr = let open OCaml_501.Parsetree in - let open Astlib.Longident in + let open Longident in match expr.pexp_desc with | Pexp_constant (Pconst_string (s, _, None)) -> Printf.sprintf "%S" s | Pexp_ident { txt = Lident name; _ } -> name @@ -43,7 +44,7 @@ let rec basic_expr_to_string expr = let print_field (lident_loc, expr) = match lident_loc with - | { OCaml_501.Asttypes.txt = Astlib.Longident.Lident name; _ } -> + | { OCaml_501.Asttypes.txt = Longident.Lident name; _ } -> Printf.printf " %s: %s;\n" name (basic_expr_to_string expr) | _ -> () diff --git a/test/expect/dune b/test/expect/dune index 8c52730a9..e2b5ae12c 100644 --- a/test/expect/dune +++ b/test/expect/dune @@ -20,3 +20,7 @@ findlib.dynload)) (ocamllex expect_lexer) + +(cinaps + (files expect_test.ml) + (libraries ppxlib_cinaps_helpers)) diff --git a/test/expect/expect_test.ml b/test/expect/expect_test.ml index 248f956d5..558691b78 100644 --- a/test/expect/expect_test.ml +++ b/test/expect/expect_test.ml @@ -162,8 +162,10 @@ let main () = Oval_variant (name, Some (map_tree param)) | Oval_string (s, maxlen, kind) -> Oval_string (s, (if maxlen < 8 then 8 else maxlen), kind) - | Oval_tuple tl -> Oval_tuple (List.map ~f:map_tree tl) - | Oval_array tl -> Oval_array (List.map ~f:map_tree tl) + (*IF_NOT_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:map_tree tl) *) + (*IF_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:(fun (l, v) -> (l, map_tree v)) tl) *) + (*IF_NOT_AT_LEAST 504 | Oval_array tl -> Oval_array (List.map ~f:map_tree tl) *) + (*IF_AT_LEAST 504 | Oval_array (tl, v) -> Oval_array ((List.map ~f:map_tree tl), v) *) | Oval_list tl -> Oval_list (List.map ~f:map_tree tl) | Oval_record fel -> Oval_record diff --git a/test/type_is_recursive/test.ml b/test/type_is_recursive/test.ml index ae7a75e1f..dd133e673 100644 --- a/test/type_is_recursive/test.ml +++ b/test/type_is_recursive/test.ml @@ -11,7 +11,7 @@ val test_is_recursive : structure_item -> rec_flag = let loc = Location.none -[%%expect{| +[%%expect_in <= 5.3 {| val loc : location = {Ppxlib.Location.loc_start = {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1}; @@ -19,6 +19,14 @@ val loc : location = {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1}; loc_ghost = true} |}] +[%%expect_in >= 5.4 {| +val loc : location = + {Location.loc_start = + {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1}; + loc_end = + {Lexing.pos_fname = "_none_"; pos_lnum = 0; pos_bol = 0; pos_cnum = -1}; + loc_ghost = true} +|}] (* Should be Nonrecursive *) let base_type = test_is_recursive [%stri type t = int] From c83ce8939145d98e49cacc70faea6a8f68706bdb Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Sat, 19 Apr 2025 11:44:32 +0100 Subject: [PATCH 3/5] Bump the magic numbers for AST 504 Signed-off-by: Patrick Ferris --- astlib/ast_504.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/astlib/ast_504.ml b/astlib/ast_504.ml index f6e1a8319..d979e51d6 100644 --- a/astlib/ast_504.ml +++ b/astlib/ast_504.ml @@ -1173,6 +1173,6 @@ module Parsetree = struct end module Config = struct - let ast_impl_magic_number = "Caml1999M035" - let ast_intf_magic_number = "Caml1999N035" + let ast_impl_magic_number = "Caml1999M036" + let ast_intf_magic_number = "Caml1999N036" end From 14b01c11264eece2c85cdeb27520e651852dd39b Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Sat, 19 Apr 2025 11:46:32 +0100 Subject: [PATCH 4/5] Update Changes Signed-off-by: Patrick Ferris --- CHANGES.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 486ab4260..df45b425f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,12 @@ unreleased ---------- +### 5.4 Support + +- Add initial OCaml 5.4 support (#570, @patricoferris, @NathanReb) + +### Other Changes + - Bump ppxlib's AST to 5.3.0 (#558, @patricoferris) - Fix 5.2 -> 5.3 migration of constants. Those used to always have a `none` From d6853ef0723a62d395264fde95a011a50e11868c Mon Sep 17 00:00:00 2001 From: Patrick Ferris Date: Wed, 30 Apr 2025 13:17:09 +0100 Subject: [PATCH 5/5] Simplify Longident versioning for 5.4.0 support Signed-off-by: Patrick Ferris --- ast/ast.ml | 43 ++++++------ ast/ast_helper_lite.ml | 2 +- ast/ast_helper_lite.mli | 2 +- ast/import.ml | 2 +- astlib/ast_408.ml | 2 - astlib/ast_409.ml | 2 - astlib/ast_410.ml | 2 - astlib/ast_411.ml | 2 - astlib/ast_412.ml | 2 - astlib/ast_413.ml | 2 - astlib/ast_414.ml | 2 - astlib/ast_501.ml | 2 - astlib/ast_502.ml | 1 - astlib/ast_503.ml | 1 - astlib/ast_504.ml | 7 ++ astlib/astlib.ml | 1 - astlib/legacy_longident.ml | 31 --------- astlib/legacy_longident.mli | 15 ---- astlib/longident.ml | 68 ++++--------------- astlib/longident.mli | 8 +-- astlib/migrate_408_409.ml | 1 - astlib/migrate_409_408.ml | 1 - astlib/migrate_409_410.ml | 1 - astlib/migrate_410_409.ml | 1 - astlib/migrate_410_411.ml | 1 - astlib/migrate_411_410.ml | 1 - astlib/migrate_411_412.ml | 1 - astlib/migrate_412_411.ml | 1 - astlib/migrate_412_413.ml | 1 - astlib/migrate_413_412.ml | 1 - astlib/migrate_413_414.ml | 1 - astlib/migrate_414_413.ml | 1 - astlib/migrate_414_500.ml | 1 - astlib/migrate_500_414.ml | 1 - astlib/migrate_500_501.ml | 1 - astlib/migrate_501_500.ml | 1 - astlib/migrate_501_502.ml | 1 - astlib/migrate_502_501.ml | 1 - astlib/migrate_502_503.ml | 1 - astlib/migrate_503_502.ml | 1 - astlib/migrate_503_504.ml | 12 ++-- astlib/migrate_504_503.ml | 12 ++-- src/gen/import.ml | 1 - .../driver.ml | 7 +- test/expect/expect_test.ml | 4 +- 45 files changed, 68 insertions(+), 185 deletions(-) delete mode 100644 astlib/legacy_longident.ml delete mode 100644 astlib/legacy_longident.mli diff --git a/ast/ast.ml b/ast/ast.ml index 9572d1d98..217cfbeb9 100644 --- a/ast/ast.ml +++ b/ast/ast.ml @@ -663,25 +663,30 @@ and type_exception = Parsetree.type_exception = { and extension_constructor_kind = 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_decl(existentials, c_args, t_opt)] describes a new extension + constructor. It can be: + {ul + {- [C of T1 * ... * Tn] when: + - [existentials] is [[]], + - [c_args] is [[T1; ...; Tn]], + - [t_opt] is [None] + } + {- [C: T0] when + - [existentials] is [[]], + - [c_args] is [[]], + - [t_opt] is [Some T0]. + } + {- [C: T1 * ... * Tn -> T0] when + - [existentials] is [[]], + - [c_args] is [[T1; ...; Tn]], + - [t_opt] is [Some T0]. + } + {- [C: 'a... . T1 * ... * Tn -> T0] when + - [existentials] is [['a;...]], + - [c_args] is [[T1; ... ; Tn]], + - [t_opt] is [Some T0]. + } + } *) | Pext_rebind of longident_loc (** [Pext_rebind(D)] re-export the constructor [D] with the new name [C] *) diff --git a/ast/ast_helper_lite.ml b/ast/ast_helper_lite.ml index 2b30f33be..06b7f5c38 100644 --- a/ast/ast_helper_lite.ml +++ b/ast/ast_helper_lite.ml @@ -16,7 +16,7 @@ (* TODO: remove this open *) open Stdlib0 module Location = Astlib.Location -module Longident = Astlib.Legacy_longident +module Longident = Astlib.Longident open Astlib.Ast_503 [@@@warning "-9"] diff --git a/ast/ast_helper_lite.mli b/ast/ast_helper_lite.mli index 450ee126a..30a6d1c22 100644 --- a/ast/ast_helper_lite.mli +++ b/ast/ast_helper_lite.mli @@ -21,7 +21,7 @@ open Parsetree type 'a with_loc = 'a Astlib.Location.loc type loc = Astlib.Location.t -type lid = Astlib.Legacy_longident.t with_loc +type lid = Astlib.Longident.t with_loc type str = string with_loc type str_opt = string option with_loc type attrs = attribute list diff --git a/ast/import.ml b/ast/import.ml index 3c6603155..d281f178f 100644 --- a/ast/import.ml +++ b/ast/import.ml @@ -193,7 +193,7 @@ module Asttypes = Selected_ast.Ast.Asttypes (* Other Astlib modules *) module Location = Astlib.Location -module Longident = Astlib.Legacy_longident +module Longident = Astlib.Longident module Parse = struct include Astlib.Parse diff --git a/astlib/ast_408.ml b/astlib/ast_408.ml index 0edec1f55..af02b9f1c 100644 --- a/astlib/ast_408.ml +++ b/astlib/ast_408.ml @@ -27,8 +27,6 @@ Actually run all lib-unix tests [4.08] *) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_409.ml b/astlib/ast_409.ml index 5d881fa82..f4d63ef23 100644 --- a/astlib/ast_409.ml +++ b/astlib/ast_409.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = diff --git a/astlib/ast_410.ml b/astlib/ast_410.ml index eb17310b1..350473a8b 100644 --- a/astlib/ast_410.ml +++ b/astlib/ast_410.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_411.ml b/astlib/ast_411.ml index e9dea2cf2..df344035c 100644 --- a/astlib/ast_411.ml +++ b/astlib/ast_411.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_412.ml b/astlib/ast_412.ml index 08db298b8..48ddfe12d 100644 --- a/astlib/ast_412.ml +++ b/astlib/ast_412.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_413.ml b/astlib/ast_413.ml index f359ab4f5..fa99656df 100644 --- a/astlib/ast_413.ml +++ b/astlib/ast_413.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_414.ml b/astlib/ast_414.ml index 5ee67d8e4..b98c05b1e 100644 --- a/astlib/ast_414.ml +++ b/astlib/ast_414.ml @@ -16,8 +16,6 @@ (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_501.ml b/astlib/ast_501.ml index 3dfcb7f4a..4e0de3173 100644 --- a/astlib/ast_501.ml +++ b/astlib/ast_501.ml @@ -1,5 +1,3 @@ -module Longident = Legacy_longident - module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_502.ml b/astlib/ast_502.ml index 281a731ac..4a7fc1fde 100644 --- a/astlib/ast_502.ml +++ b/astlib/ast_502.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_503.ml b/astlib/ast_503.ml index 3665ca94c..637d2f21a 100644 --- a/astlib/ast_503.ml +++ b/astlib/ast_503.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/ast_504.ml b/astlib/ast_504.ml index d979e51d6..0d1a31266 100644 --- a/astlib/ast_504.ml +++ b/astlib/ast_504.ml @@ -1,3 +1,10 @@ +module Longident = struct + type t (*IF_CURRENT = Ocaml_common.Longident.t *) = + | Lident of string + | Ldot of t Location.loc * string Location.loc + | Lapply of t Location.loc * t Location.loc +end + module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int diff --git a/astlib/astlib.ml b/astlib/astlib.ml index c8525453d..b777eb8fc 100644 --- a/astlib/astlib.ml +++ b/astlib/astlib.ml @@ -71,7 +71,6 @@ module Ast_metadata = Ast_metadata module Config = Config module Keyword = Keyword module Location = Location -module Legacy_longident = Legacy_longident module Longident = Longident module Parse = Parse module Pprintast = Pprintast diff --git a/astlib/legacy_longident.ml b/astlib/legacy_longident.ml deleted file mode 100644 index a5bb3e8f9..000000000 --- a/astlib/legacy_longident.ml +++ /dev/null @@ -1,31 +0,0 @@ -type t = - (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) - | Lident of string - | Ldot of t * string - | Lapply of t * t - -let rec flat accu = function - | Lident s -> s :: accu - | Ldot (lid, s) -> flat (s :: accu) lid - | Lapply (_, _) -> Misc.fatal_error "Longident.flat" - -let flatten lid = flat [] lid - -let rec split_at_dots s pos = - try - let dot = String.index_from s pos '.' in - String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) - with Not_found -> [ String.sub s pos (String.length s - pos) ] - -let unflatten l = - match l with - | [] -> None - | hd :: tl -> Some (List.fold_left (fun p s -> Ldot (p, s)) (Lident hd) tl) - -let parse s = - match unflatten (split_at_dots s 0) with - | None -> - Lident "" - (* should not happen, but don't put assert false - so as not to crash the toplevel (see Genprintval) *) - | Some v -> v diff --git a/astlib/legacy_longident.mli b/astlib/legacy_longident.mli deleted file mode 100644 index c5fe735af..000000000 --- a/astlib/legacy_longident.mli +++ /dev/null @@ -1,15 +0,0 @@ -(** Long identifiers, used in parsetrees. *) - -(** The long identifier type *) -type t = - (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) - | Lident of string - | Ldot of t * string - | Lapply of t * t - -val flatten : t -> string list -(** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting - [Lapply].*) - -val parse : string -> t -(** Parse a string into a long identifier built upon [Lident] and [Ldot]. *) diff --git a/astlib/longident.ml b/astlib/longident.ml index 78d3ed722..a5bb3e8f9 100644 --- a/astlib/longident.ml +++ b/astlib/longident.ml @@ -1,73 +1,31 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) -open Location - -type t = (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *) - Lident of string - | Ldot of t loc * string loc - | Lapply of t loc * t loc - - -let rec same t t' = - t == t' - || match t, t' with - | Lident s, Lident s' -> - String.equal s s' - | Ldot ({ txt = t; _ }, { txt = s; _ }), - Ldot ({ txt = t'; _ }, { txt = s'; _ }) -> - if String.equal s s' then - same t t' - else - false - | Lapply ({ txt = tl; _ }, { txt = tr; _ }), - Lapply ({ txt = tl'; _ }, { txt = tr'; _ }) -> - same tl tl' && same tr tr' - | _, _ -> false - +type t = + (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) + | Lident of string + | Ldot of t * string + | Lapply of t * t let rec flat accu = function - Lident s -> s :: accu - | Ldot({ txt = lid; _ }, { txt = s; _ }) -> flat (s :: accu) lid - | Lapply(_, _) -> Misc.fatal_error "Longident.flat" + | Lident s -> s :: accu + | Ldot (lid, s) -> flat (s :: accu) lid + | Lapply (_, _) -> Misc.fatal_error "Longident.flat" let flatten lid = flat [] lid -let last = function - Lident s -> s - | Ldot(_, s) -> s.txt - | Lapply(_, _) -> Misc.fatal_error "Longident.last" - - let rec split_at_dots s pos = try let dot = String.index_from s pos '.' in String.sub s pos (dot - pos) :: split_at_dots s (dot + 1) - with Not_found -> - [String.sub s pos (String.length s - pos)] - -let mknoloc txt = { txt; loc = Location.none } + with Not_found -> [ String.sub s pos (String.length s - pos) ] let unflatten l = match l with | [] -> None - | hd :: tl -> - Some (List.fold_left (fun p s -> Ldot(mknoloc p, mknoloc s)) - (Lident hd) tl) + | hd :: tl -> Some (List.fold_left (fun p s -> Ldot (p, s)) (Lident hd) tl) let parse s = match unflatten (split_at_dots s 0) with - | None -> Lident "" (* should not happen, but don't put assert false + | None -> + Lident "" + (* should not happen, but don't put assert false so as not to crash the toplevel (see Genprintval) *) | Some v -> v diff --git a/astlib/longident.mli b/astlib/longident.mli index 3bca23837..c5fe735af 100644 --- a/astlib/longident.mli +++ b/astlib/longident.mli @@ -1,11 +1,11 @@ (** Long identifiers, used in parsetrees. *) -open Location (** The long identifier type *) -type t = (*IF_AT_LEAST 504 Ocaml_common.Longident.t = *) +type t = + (*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *) | Lident of string - | Ldot of t loc * string loc - | Lapply of t loc * t loc + | Ldot of t * string + | Lapply of t * t val flatten : t -> string list (** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting diff --git a/astlib/migrate_408_409.ml b/astlib/migrate_408_409.ml index f2042a9e0..754910f3a 100644 --- a/astlib/migrate_408_409.ml +++ b/astlib/migrate_408_409.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_408 module To = Ast_409 diff --git a/astlib/migrate_409_408.ml b/astlib/migrate_409_408.ml index 8d0e9ed8c..bc9ab219a 100644 --- a/astlib/migrate_409_408.ml +++ b/astlib/migrate_409_408.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_409 module To = Ast_408 diff --git a/astlib/migrate_409_410.ml b/astlib/migrate_409_410.ml index 89fca12f7..af4b7308f 100644 --- a/astlib/migrate_409_410.ml +++ b/astlib/migrate_409_410.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module From = Ast_409 module To = Ast_410 diff --git a/astlib/migrate_410_409.ml b/astlib/migrate_410_409.ml index 5bcb889ff..d1298e0c6 100644 --- a/astlib/migrate_410_409.ml +++ b/astlib/migrate_410_409.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module From = Ast_410 module To = Ast_409 diff --git a/astlib/migrate_410_411.ml b/astlib/migrate_410_411.ml index 1b66d9691..be4d78e46 100644 --- a/astlib/migrate_410_411.ml +++ b/astlib/migrate_410_411.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_410 module To = Ast_411 diff --git a/astlib/migrate_411_410.ml b/astlib/migrate_411_410.ml index 20a80eef1..ad1def34a 100644 --- a/astlib/migrate_411_410.ml +++ b/astlib/migrate_411_410.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_411 module To = Ast_410 diff --git a/astlib/migrate_411_412.ml b/astlib/migrate_411_412.ml index a9165b53e..7861486e6 100644 --- a/astlib/migrate_411_412.ml +++ b/astlib/migrate_411_412.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_411 module To = Ast_412 diff --git a/astlib/migrate_412_411.ml b/astlib/migrate_412_411.ml index bcab203c4..8d423c7f6 100644 --- a/astlib/migrate_412_411.ml +++ b/astlib/migrate_412_411.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_412 module To = Ast_411 diff --git a/astlib/migrate_412_413.ml b/astlib/migrate_412_413.ml index 7e97eeb45..26c15e8f2 100644 --- a/astlib/migrate_412_413.ml +++ b/astlib/migrate_412_413.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_412 module To = Ast_413 diff --git a/astlib/migrate_413_412.ml b/astlib/migrate_413_412.ml index c84a05e61..350882ac6 100644 --- a/astlib/migrate_413_412.ml +++ b/astlib/migrate_413_412.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_413 module To = Ast_412 diff --git a/astlib/migrate_413_414.ml b/astlib/migrate_413_414.ml index d7e1b61e9..7a9fe7f2a 100644 --- a/astlib/migrate_413_414.ml +++ b/astlib/migrate_413_414.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_413 module To = Ast_414 diff --git a/astlib/migrate_414_413.ml b/astlib/migrate_414_413.ml index e5963d82e..90c268ba9 100644 --- a/astlib/migrate_414_413.ml +++ b/astlib/migrate_414_413.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_414 module To = Ast_413 diff --git a/astlib/migrate_414_500.ml b/astlib/migrate_414_500.ml index 6aee122a8..084692807 100644 --- a/astlib/migrate_414_500.ml +++ b/astlib/migrate_414_500.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module From = Ast_414 module To = Ast_500 diff --git a/astlib/migrate_500_414.ml b/astlib/migrate_500_414.ml index da2604a0e..6b625e209 100644 --- a/astlib/migrate_500_414.ml +++ b/astlib/migrate_500_414.ml @@ -1,4 +1,3 @@ -module Longident = Legacy_longident module From = Ast_500 module To = Ast_414 diff --git a/astlib/migrate_500_501.ml b/astlib/migrate_500_501.ml index 8c2dd1d30..c7d41dbc3 100644 --- a/astlib/migrate_500_501.ml +++ b/astlib/migrate_500_501.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_500 module To = Ast_501 diff --git a/astlib/migrate_501_500.ml b/astlib/migrate_501_500.ml index 3d6be3c49..4c6f05e1e 100644 --- a/astlib/migrate_501_500.ml +++ b/astlib/migrate_501_500.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_501 module To = Ast_500 diff --git a/astlib/migrate_501_502.ml b/astlib/migrate_501_502.ml index 68693f088..102118c05 100644 --- a/astlib/migrate_501_502.ml +++ b/astlib/migrate_501_502.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_501 module To = Ast_502 diff --git a/astlib/migrate_502_501.ml b/astlib/migrate_502_501.ml index 4818c8f8c..50ae5c76c 100644 --- a/astlib/migrate_502_501.ml +++ b/astlib/migrate_502_501.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_502 module To = Ast_501 diff --git a/astlib/migrate_502_503.ml b/astlib/migrate_502_503.ml index 1624cccdb..fe600b21f 100644 --- a/astlib/migrate_502_503.ml +++ b/astlib/migrate_502_503.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_502 module To = Ast_503 diff --git a/astlib/migrate_503_502.ml b/astlib/migrate_503_502.ml index f852832ba..3f55081d3 100644 --- a/astlib/migrate_503_502.ml +++ b/astlib/migrate_503_502.ml @@ -1,5 +1,4 @@ open Stdlib0 -module Longident = Legacy_longident module From = Ast_503 module To = Ast_502 diff --git a/astlib/migrate_503_504.ml b/astlib/migrate_503_504.ml index b5d111be1..55237beca 100644 --- a/astlib/migrate_503_504.ml +++ b/astlib/migrate_503_504.ml @@ -1303,16 +1303,16 @@ and copy_constant : Ast_503.Parsetree.constant -> Ast_504.Parsetree.constant = in { pconst_desc; pconst_loc = copy_location c.pconst_loc } -and copy_Longident_t : Legacy_longident.t -> Longident.t = function - | Legacy_longident.Lident x0 -> Longident.Lident x0 - | Legacy_longident.Ldot (x0, x1) -> - Longident.Ldot +and copy_Longident_t : Longident.t -> Ast_504.Longident.t = function + | Longident.Lident x0 -> Ast_504.Longident.Lident x0 + | Longident.Ldot (x0, x1) -> + Ast_504.Longident.Ldot ( { txt = copy_Longident_t x0; loc = Location.none }, { txt = x1; loc = Location.none } ) - | Legacy_longident.Lapply (x0, x1) -> + | Longident.Lapply (x0, x1) -> let x0 = Location.{ txt = copy_Longident_t x0; loc = Location.none } in let x1 = Location.{ txt = copy_Longident_t x1; loc = Location.none } in - Longident.Lapply (x0, x1) + Ast_504.Longident.Lapply (x0, x1) and copy_loc : 'f0 'g0. diff --git a/astlib/migrate_504_503.ml b/astlib/migrate_504_503.ml index 8d27f2792..dacfd0da9 100644 --- a/astlib/migrate_504_503.ml +++ b/astlib/migrate_504_503.ml @@ -1324,12 +1324,12 @@ and copy_constant : Ast_504.Parsetree.constant -> Ast_503.Parsetree.constant = in { pconst_desc; pconst_loc = copy_location const.pconst_loc } -and copy_Longident_t : Longident.t -> Legacy_longident.t = function - | Longident.Lident x0 -> Legacy_longident.Lident x0 - | Longident.Ldot (x0, x1) -> - Legacy_longident.Ldot (copy_Longident_t x0.txt, x1.txt) - | Longident.Lapply (x0, x1) -> - Legacy_longident.Lapply (copy_Longident_t x0.txt, copy_Longident_t x1.txt) +and copy_Longident_t : Ast_504.Longident.t -> Longident.t = function + | Ast_504.Longident.Lident x0 -> Longident.Lident x0 + | Ast_504.Longident.Ldot (x0, x1) -> + Longident.Ldot (copy_Longident_t x0.txt, x1.txt) + | Ast_504.Longident.Lapply (x0, x1) -> + Longident.Lapply (copy_Longident_t x0.txt, copy_Longident_t x1.txt) and copy_loc : 'f0 'g0. diff --git a/src/gen/import.ml b/src/gen/import.ml index 5001a5950..30fff3672 100644 --- a/src/gen/import.ml +++ b/src/gen/import.ml @@ -2,7 +2,6 @@ open Astlib include Ppxlib_ast include Ast open Ast_helper -module Longident = Legacy_longident let loc = (* This is fine, because the location info is thrown away when the generated code diff --git a/test/driver/ocaml-ppx-context-load-path-migration/driver.ml b/test/driver/ocaml-ppx-context-load-path-migration/driver.ml index 07802523b..da781e210 100644 --- a/test/driver/ocaml-ppx-context-load-path-migration/driver.ml +++ b/test/driver/ocaml-ppx-context-load-path-migration/driver.ml @@ -10,11 +10,10 @@ module Before_502_to_ocaml = (Ppxlib_ast.Compiler_version) module OCaml_501 = Ppxlib_ast__.Versions.OCaml_501.Ast -module Longident = Astlib.Legacy_longident let rec unfold_list_lit x next = let open OCaml_501.Parsetree in - let open Longident in + let open Astlib.Longident in match next.pexp_desc with | Pexp_construct ({ txt = Lident "[]"; _ }, None) -> [ x ] | Pexp_construct @@ -26,7 +25,7 @@ let rec unfold_list_lit x next = (* Only deals with the basic blocks needed for ocaml.ppx.context *) let rec basic_expr_to_string expr = let open OCaml_501.Parsetree in - let open Longident in + let open Astlib.Longident in match expr.pexp_desc with | Pexp_constant (Pconst_string (s, _, None)) -> Printf.sprintf "%S" s | Pexp_ident { txt = Lident name; _ } -> name @@ -44,7 +43,7 @@ let rec basic_expr_to_string expr = let print_field (lident_loc, expr) = match lident_loc with - | { OCaml_501.Asttypes.txt = Longident.Lident name; _ } -> + | { OCaml_501.Asttypes.txt = Astlib.Longident.Lident name; _ } -> Printf.printf " %s: %s;\n" name (basic_expr_to_string expr) | _ -> () diff --git a/test/expect/expect_test.ml b/test/expect/expect_test.ml index 558691b78..05d7892a1 100644 --- a/test/expect/expect_test.ml +++ b/test/expect/expect_test.ml @@ -163,9 +163,9 @@ let main () = | Oval_string (s, maxlen, kind) -> Oval_string (s, (if maxlen < 8 then 8 else maxlen), kind) (*IF_NOT_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:map_tree tl) *) - (*IF_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:(fun (l, v) -> (l, map_tree v)) tl) *) + (*IF_AT_LEAST 504 | Oval_tuple tl -> Oval_tuple (List.map ~f:(fun (label, v) -> (label, map_tree v)) tl) *) (*IF_NOT_AT_LEAST 504 | Oval_array tl -> Oval_array (List.map ~f:map_tree tl) *) - (*IF_AT_LEAST 504 | Oval_array (tl, v) -> Oval_array ((List.map ~f:map_tree tl), v) *) + (*IF_AT_LEAST 504 | Oval_array (tl, mutable_) -> Oval_array ((List.map ~f:map_tree tl), mutable_) *) | Oval_list tl -> Oval_list (List.map ~f:map_tree tl) | Oval_record fel -> Oval_record