From 6cb30e23a65028c9b7df82fe55867e360ac57679 Mon Sep 17 00:00:00 2001 From: Jordan Date: Mon, 17 Aug 2020 00:59:00 -0700 Subject: [PATCH] Vendor OCaml Migrate ParseTree. Summary: Problem: There exists reason packages in the wild that have `omp: *` as a dependency. A new breaking change was released in omp 2.0.0. We cannot compile against it. We also cannot upgrade to the intended replacement for the old functionality we were using `ppxlib` because it doesn't support older versions of omp. The only solution is to vendor. This should unbreak existing libraries that depend on older versions of Reason. We should have had a constraint of `omp: < 2.0.0`, but even in that case the package ecosystem essentially breaks because it splits into two sides - ones that can use 2.0.0 omp and ones that cannot. Vendoring omp solves that problem. It might not work during the next compiler upgrade though (estimated six months). Test Plan: Reviewers: CC: --- HISTORY.md | 12 +- esy.json | 5 +- esy.lock/index.json | 32 +- reason.esy.lock/.gitattributes | 3 + reason.esy.lock/.gitignore | 3 + reason.esy.lock/index.json | 549 +++ reason.esy.lock/opam/base-threads.base/opam | 6 + reason.esy.lock/opam/base-unix.base/opam | 6 + reason.esy.lock/opam/biniou.1.2.1/opam | 45 + reason.esy.lock/opam/conf-m4.1/opam | 22 + reason.esy.lock/opam/cppo.1.6.6/opam | 37 + reason.esy.lock/opam/dune.2.6.2/opam | 55 + reason.esy.lock/opam/easy-format.1.3.2/opam | 46 + reason.esy.lock/opam/fix.20200131/opam | 24 + reason.esy.lock/opam/menhir.20200624/opam | 27 + reason.esy.lock/opam/menhirLib.20200624/opam | 28 + reason.esy.lock/opam/menhirSdk.20200624/opam | 28 + reason.esy.lock/opam/merlin-extend.0.6/opam | 30 + ...Don-t-build-manpages-for-stdlib-docs.patch | 24 + ...1-Fix-failure-to-install-tools-links.patch | 26 + .../files/fix-gcc10.patch | 34 + .../ocaml-secondary-compiler.4.08.1-1/opam | 51 + .../ocamlfind-secondary.1.8.1/files/META.in | 3 + .../files/ocaml-secondary-compiler.conf.in | 10 + .../opam/ocamlfind-secondary.1.8.1/opam | 32 + .../opam/ocamlfind.1.8.1/files/ocaml-stub | 4 + .../ocamlfind.1.8.1/files/ocamlfind.install | 6 + reason.esy.lock/opam/ocamlfind.1.8.1/opam | 50 + reason.esy.lock/opam/ppx_derivers.1.2.1/opam | 23 + reason.esy.lock/opam/result.1.5/opam | 22 + reason.esy.lock/opam/yojson.1.7.0/opam | 38 + .../package.json | 34 + .../files/clone-flexdll | 16 + .../files/configure-windows | 22 + .../files/esy-build | 24 + .../files/esy-configure | 29 + .../package.json | 28 + .../files/findlib-1.8.1.patch | 471 ++ .../package.json | 61 + .../files/findlib-1.8.1.patch | 471 ++ .../files/gen-findlib-conf.sh | 14 + .../files/gen-meta.sh | 7 + .../package.json | 47 + reason.json | 2 +- .../ocaml-migrate-parsetree-v1.7.3.tbz | Bin 0 -> 166267 bytes src/ppx/dune | 2 +- src/ppx/reactjs_jsx_ppx_v2.ml | 2 +- src/reason-parser-tests/testOprint.cppo.ml | 6 +- src/reason-parser/dune | 2 +- src/reason-parser/reason_attributes.ml | 2 +- src/reason-parser/reason_errors.ml | 2 +- src/reason-parser/reason_errors.mli | 2 +- src/reason-parser/reason_heuristics.ml | 2 +- src/reason-parser/reason_oprint.cppo.ml | 2 +- src/reason-parser/reason_parser.mly | 18 +- src/reason-parser/reason_parser_def.ml | 2 +- src/reason-parser/reason_pprint_ast.ml | 2 +- src/reason-parser/reason_pprint_ast.mli | 2 +- src/reason-parser/reason_syntax_util.cppo.ml | 2 +- src/reason-parser/reason_syntax_util.cppo.mli | 2 +- src/reason-parser/reason_toolchain.ml | 2 +- src/reason-parser/reason_toolchain_conf.ml | 2 +- src/refmt/printer_maker.ml | 2 +- src/refmt/reason_implementation_printer.ml | 2 +- src/refmt/reason_interface_printer.ml | 2 +- src/rtop/dune | 2 +- src/rtop/rtop.ml | 2 +- .../CHANGES.md | 198 + .../LICENSE.md | 203 + .../MANUAL.md | 339 ++ .../Makefile | 42 + .../README.md | 164 + .../dune | 4 + .../dune-project-old | 4 + .../dune-workspace.dev | 11 + .../examples/omp_ppx_define/META | 8 + .../examples/omp_ppx_define/Makefile | 40 + .../examples/omp_ppx_define/ppx_define.ml | 80 + .../examples/omp_ppx_define/standalone.ml | 4 + .../examples/omp_ppx_define/test.ml | 1 + .../examples/omp_ppx_here/META | 8 + .../examples/omp_ppx_here/Makefile | 34 + .../examples/omp_ppx_here/ppx_here.ml | 29 + .../examples/omp_ppx_here/standalone.ml | 4 + .../examples/omp_ppx_parse/META | 8 + .../examples/omp_ppx_parse/Makefile | 34 + .../examples/omp_ppx_parse/ppx_parse.ml | 40 + .../examples/omp_ppx_parse/standalone.ml | 4 + .../examples/omp_ppx_parse/test.ml | 5 + .../ocaml-migrate-parsetree.backup-opam | 13 +- .../.gitattributes | 3 + .../.gitignore | 3 + .../index.json | 283 ++ .../opam/base-threads.base/opam | 6 + .../opam/base-unix.base/opam | 6 + .../opam/conf-m4.1/opam | 22 + .../opam/dune.2.6.2/opam | 55 + ...Don-t-build-manpages-for-stdlib-docs.patch | 24 + ...1-Fix-failure-to-install-tools-links.patch | 26 + .../files/fix-gcc10.patch | 34 + .../ocaml-secondary-compiler.4.08.1-1/opam | 51 + .../ocamlfind-secondary.1.8.1/files/META.in | 3 + .../files/ocaml-secondary-compiler.conf.in | 10 + .../opam/ocamlfind-secondary.1.8.1/opam | 32 + .../opam/ocamlfind.1.8.1/files/ocaml-stub | 4 + .../ocamlfind.1.8.1/files/ocamlfind.install | 6 + .../opam/ocamlfind.1.8.1/opam | 50 + .../opam/ppx_derivers.1.2.1/opam | 23 + .../opam/result.1.5/opam | 22 + .../package.json | 34 + .../files/clone-flexdll | 16 + .../files/configure-windows | 22 + .../files/esy-build | 24 + .../files/esy-configure | 29 + .../package.json | 28 + .../files/findlib-1.8.1.patch | 471 ++ .../package.json | 61 + .../files/findlib-1.8.1.patch | 471 ++ .../files/gen-findlib-conf.sh | 14 + .../files/gen-meta.sh | 7 + .../package.json | 47 + .../src/ast_402.ml | 2851 +++++++++++ .../src/ast_403.ml | 2950 ++++++++++++ .../src/ast_404.ml | 2968 ++++++++++++ .../src/ast_405.ml | 3041 ++++++++++++ .../src/ast_406.ml | 3083 ++++++++++++ .../src/ast_407.ml | 3099 ++++++++++++ .../src/ast_408.ml | 4156 ++++++++++++++++ .../src/ast_408_helper.ml | 24 + .../src/ast_409.ml | 4145 ++++++++++++++++ .../src/ast_409_helper.ml | 24 + .../src/ast_410.ml | 4166 ++++++++++++++++ .../src/ast_411.ml | 4185 +++++++++++++++++ .../src/cinaps_helpers | 74 + .../compiler-functions/ge_406_and_lt_408.ml | 19 + .../compiler-functions/ge_408_and_lt_410.ml | 19 + .../src/compiler-functions/ge_410.ml | 19 + .../src/compiler-functions/lt_406.ml | 15 + .../src/config/gen.ml | 34 + .../src/dune | 31 + .../src/locations.ml | 135 + .../src/migrate_parsetree_402_403.ml | 130 + .../src/migrate_parsetree_402_403_migrate.ml | 1884 ++++++++ .../src/migrate_parsetree_403_402.ml | 130 + .../src/migrate_parsetree_403_402_migrate.ml | 1941 ++++++++ .../src/migrate_parsetree_403_404.ml | 130 + .../src/migrate_parsetree_403_404_migrate.ml | 1907 ++++++++ .../src/migrate_parsetree_404_403.ml | 130 + .../src/migrate_parsetree_404_403_migrate.ml | 1916 ++++++++ .../src/migrate_parsetree_404_405.ml | 130 + .../src/migrate_parsetree_404_405_migrate.ml | 1716 +++++++ .../src/migrate_parsetree_405_404.ml | 130 + .../src/migrate_parsetree_405_404_migrate.ml | 1716 +++++++ .../src/migrate_parsetree_405_406.ml | 130 + .../src/migrate_parsetree_405_406_migrate.ml | 1714 +++++++ .../src/migrate_parsetree_406_405.ml | 130 + .../src/migrate_parsetree_406_405_migrate.ml | 1724 +++++++ .../src/migrate_parsetree_406_407.ml | 130 + .../src/migrate_parsetree_406_407_migrate.ml | 1734 +++++++ .../src/migrate_parsetree_407_406.ml | 130 + .../src/migrate_parsetree_407_406_migrate.ml | 1730 +++++++ .../src/migrate_parsetree_407_408.ml | 138 + .../src/migrate_parsetree_407_408_migrate.ml | 1808 +++++++ .../src/migrate_parsetree_408_407.ml | 135 + .../src/migrate_parsetree_408_407_migrate.ml | 1819 +++++++ .../src/migrate_parsetree_408_409.ml | 140 + .../src/migrate_parsetree_408_409_migrate.ml | 1501 ++++++ .../src/migrate_parsetree_409_408.ml | 140 + .../src/migrate_parsetree_409_408_migrate.ml | 1501 ++++++ .../src/migrate_parsetree_409_410.ml | 140 + .../src/migrate_parsetree_409_410_migrate.ml | 1514 ++++++ .../src/migrate_parsetree_410_409.ml | 140 + .../src/migrate_parsetree_410_409_migrate.ml | 1543 ++++++ .../src/migrate_parsetree_410_411.ml | 141 + .../src/migrate_parsetree_410_411_migrate.ml | 1522 ++++++ .../src/migrate_parsetree_411_410.ml | 142 + .../src/migrate_parsetree_411_410_migrate.ml | 1523 ++++++ .../src/migrate_parsetree_ast_io.ml | 102 + .../src/migrate_parsetree_ast_io.mli | 50 + .../src/migrate_parsetree_def.ml | 138 + .../src/migrate_parsetree_def.mli | 52 + .../src/migrate_parsetree_driver.ml | 599 +++ .../src/migrate_parsetree_driver.mli | 113 + .../src/migrate_parsetree_driver_main.ml | 1 + .../src/migrate_parsetree_parse.ml | 53 + .../src/migrate_parsetree_parse.mli | 32 + .../src/migrate_parsetree_versions.ml | 761 +++ .../src/migrate_parsetree_versions.mli | 314 ++ .../src/reason_migrate_parsetree.ml | 113 + .../src/stdlib0.ml | 10 + .../test/driver/manual/dune | 17 + .../test/driver/null/dune | 16 + .../test/driver/null/ppx.ml | 1 + .../test/driver/ppx-user/dune | 13 + .../test/driver/ppx-user/foo.expected | 3 + .../test/driver/ppx-user/foo.ml | 3 + .../test/driver/ppx1/dune | 4 + .../test/driver/ppx1/ppx1.ml | 20 + .../test/driver/ppx2/dune | 4 + .../test/driver/ppx2/ppx2.ml | 32 + .../tools/add_special_comments.ml | 66 + .../tools/add_special_comments.mli | 1 + .../tools/dune | 6 + .../tools/gencopy.ml | 343 ++ .../tools/pp.ml | 13 + .../tools/pp.mli | 1 + .../tools/pp_rewrite.mli | 1 + .../tools/pp_rewrite.mll | 45 + 208 files changed, 76751 insertions(+), 78 deletions(-) create mode 100644 reason.esy.lock/.gitattributes create mode 100644 reason.esy.lock/.gitignore create mode 100644 reason.esy.lock/index.json create mode 100644 reason.esy.lock/opam/base-threads.base/opam create mode 100644 reason.esy.lock/opam/base-unix.base/opam create mode 100644 reason.esy.lock/opam/biniou.1.2.1/opam create mode 100644 reason.esy.lock/opam/conf-m4.1/opam create mode 100644 reason.esy.lock/opam/cppo.1.6.6/opam create mode 100644 reason.esy.lock/opam/dune.2.6.2/opam create mode 100644 reason.esy.lock/opam/easy-format.1.3.2/opam create mode 100644 reason.esy.lock/opam/fix.20200131/opam create mode 100644 reason.esy.lock/opam/menhir.20200624/opam create mode 100644 reason.esy.lock/opam/menhirLib.20200624/opam create mode 100644 reason.esy.lock/opam/menhirSdk.20200624/opam create mode 100644 reason.esy.lock/opam/merlin-extend.0.6/opam create mode 100644 reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch create mode 100644 reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch create mode 100644 reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch create mode 100644 reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam create mode 100644 reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in create mode 100644 reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in create mode 100644 reason.esy.lock/opam/ocamlfind-secondary.1.8.1/opam create mode 100644 reason.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub create mode 100644 reason.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install create mode 100644 reason.esy.lock/opam/ocamlfind.1.8.1/opam create mode 100644 reason.esy.lock/opam/ppx_derivers.1.2.1/opam create mode 100644 reason.esy.lock/opam/result.1.5/opam create mode 100644 reason.esy.lock/opam/yojson.1.7.0/opam create mode 100644 reason.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json create mode 100644 reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll create mode 100644 reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows create mode 100644 reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build create mode 100644 reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure create mode 100644 reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-meta.sh create mode 100644 reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/package.json create mode 100644 src/ocaml-migrate-parsetree-v1.7.3-old/ocaml-migrate-parsetree-v1.7.3.tbz create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/CHANGES.md create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/LICENSE.md create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/MANUAL.md create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/Makefile create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/README.md create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-project-old create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-workspace.dev create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/META create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/Makefile create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/ppx_define.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/standalone.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/test.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/META create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/Makefile create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/ppx_here.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/standalone.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/META create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/Makefile create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/ppx_parse.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/standalone.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/test.ml rename esy.lock/opam/ocaml-migrate-parsetree.1.7.3/opam => src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.backup-opam (69%) create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitattributes create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitignore create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/index.json create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-threads.base/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-unix.base/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/conf-m4.1/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/dune.2.6.2/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ppx_derivers.1.2.1/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/result.1.5/opam create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-meta.sh create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/package.json create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_402.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_403.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_404.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_405.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_406.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_407.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408_helper.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409_helper.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_410.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_411.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/cinaps_helpers create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_406_and_lt_408.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_408_and_lt_410.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_410.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/lt_406.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/config/gen.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/locations.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410_migrate.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver_main.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/reason_migrate_parsetree.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/src/stdlib0.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/manual/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/ppx.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.expected create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/ppx1.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/ppx2.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/dune create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/gencopy.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.ml create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mli create mode 100644 src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mll diff --git a/HISTORY.md b/HISTORY.md index 2cb43ec42..bc20fbd3a 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,11 +1,19 @@ -## 3.7.0 +## 3.6.1 + **New Feature, Non Breaking:** -- Reason Syntax v4 [NEW-FEATURE-NON-BREAKING]: Angle Brackets Type Parameters (PARSING) (@jordwalke)[https://github.com/facebook/reason/pull/2604] +- Reason Syntax v4 [NEW-FEATURE-NON-BREAKING]: Angle Brackets Type Parameters (PARSING) (@jordwalke)[#2604][https://github.com/facebook/reason/pull/2604] **Bug Fixes:** - Fix printing of externals that happen to have newlines/quotes in them (@jordwalke)[#2593](https://github.com/facebook/reason/pull/2593) - Fix parsing/printing of attributes on patterns (@jordwalke)[#2592](https://github.com/facebook/reason/pull/2592) +- Fix Windows CI (@ManasJayanth) [#2611](https://github.com/facebook/reason/pull/2611) +- Fix uncurry attribute on function application(@anmonteiro) [#2566](https://github.com/facebook/reason/pull/2566) +- Support OCaml 4.11 (@anmonteiro) [#2582](https://github.com/facebook/reason/pull/2582) +- Vendor ocaml-migrate-parsetree for greater compatibility (@jordwalke) [#2623](https://github.com/facebook/reason/pull/2623) + +**Docs:** +- README Reason logo (@iamdarshshah)[#2609][https://github.com/facebook/reason/pull/2609] ## 3.6.0 diff --git a/esy.json b/esy.json index eb376cfae..3a6d2cd3b 100644 --- a/esy.json +++ b/esy.json @@ -11,8 +11,8 @@ "@opam/utop": " >= 1.17.0 < 2.5.0", "@opam/merlin-extend": " >= 0.6", "@opam/result": "*", - "@opam/ocaml-migrate-parsetree": " < 2.0.0", - "@opam/dune": "< 2.0.0" + "@opam/dune": "< 2.0.0", + "@opam/ppx_derivers": "< 2.0.0" }, "devDependencies": { "@opam/merlin": "*", @@ -69,7 +69,6 @@ "@opam/menhir", "@opam/mmap", "@opam/ocplib-endian", - "@opam/ocaml-migrate-parsetree", "@opam/ocamlfind", "@opam/ppx_derivers", "@opam/react", diff --git a/esy.lock/index.json b/esy.lock/index.json index ea68aff9d..920ddb241 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "559f81908b26d25a7139ff3185f8afb0", + "checksum": "e8e240af3b787952cf8746dcdba4ace1", "root": "reason-cli@link-dev:./esy.json", "node": { "reason-cli@link-dev:./esy.json": { @@ -11,8 +11,8 @@ "dependencies": [ "ocaml@4.6.1000@d41d8cd9", "@opam/utop@opam:2.4.3@5dd230c9", "@opam/result@opam:1.5@6b753c82", + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocaml-migrate-parsetree@opam:1.7.3@dbcf3b47", "@opam/merlin-extend@opam:0.6@404f814c", "@opam/menhir@opam:20190924@004407ff", "@opam/fix@opam:20200131@0ecd2f01", "@opam/dune@opam:1.11.4@e1a68403" @@ -459,34 +459,6 @@ ], "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] }, - "@opam/ocaml-migrate-parsetree@opam:1.7.3@dbcf3b47": { - "id": "@opam/ocaml-migrate-parsetree@opam:1.7.3@dbcf3b47", - "name": "@opam/ocaml-migrate-parsetree", - "version": "opam:1.7.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/6d/6d85717bcf476b87f290714872ed4fbde0233dc899c3158a27f439d70224fb55#sha256:6d85717bcf476b87f290714872ed4fbde0233dc899c3158a27f439d70224fb55", - "archive:https://github.com/ocaml-ppx/ocaml-migrate-parsetree/releases/download/v1.7.3/ocaml-migrate-parsetree-v1.7.3.tbz#sha256:6d85717bcf476b87f290714872ed4fbde0233dc899c3158a27f439d70224fb55" - ], - "opam": { - "name": "ocaml-migrate-parsetree", - "version": "1.7.3", - "path": "esy.lock/opam/ocaml-migrate-parsetree.1.7.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/dune@opam:1.11.4@e1a68403", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.6.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/dune@opam:1.11.4@e1a68403" - ] - }, "@opam/mmap@opam:1.1.0@b85334ff": { "id": "@opam/mmap@opam:1.1.0@b85334ff", "name": "@opam/mmap", diff --git a/reason.esy.lock/.gitattributes b/reason.esy.lock/.gitattributes new file mode 100644 index 000000000..e0b4e26c5 --- /dev/null +++ b/reason.esy.lock/.gitattributes @@ -0,0 +1,3 @@ + +# Set eol to LF so files aren't converted to CRLF-eol on Windows. +* text eol=lf linguist-generated diff --git a/reason.esy.lock/.gitignore b/reason.esy.lock/.gitignore new file mode 100644 index 000000000..a221be227 --- /dev/null +++ b/reason.esy.lock/.gitignore @@ -0,0 +1,3 @@ + +# Reset any possible .gitignore, we want all esy.lock to be un-ignored. +!* diff --git a/reason.esy.lock/index.json b/reason.esy.lock/index.json new file mode 100644 index 000000000..a62805527 --- /dev/null +++ b/reason.esy.lock/index.json @@ -0,0 +1,549 @@ +{ + "checksum": "0d494166e4dc799699579ffc9e1ac5a3", + "root": "@esy-ocaml/reason@link-dev:./reason.json", + "node": { + "ocaml@4.6.1000@d41d8cd9": { + "id": "ocaml@4.6.1000@d41d8cd9", + "name": "ocaml", + "version": "4.6.1000", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.6.1000.tgz#sha1:99525ef559353481396454f9a072dedc96b52f44" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + }, + "@opam/yojson@opam:1.7.0@7056d985": { + "id": "@opam/yojson@opam:1.7.0@7056d985", + "name": "@opam/yojson", + "version": "opam:1.7.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/b8/b89d39ca3f8c532abe5f547ad3b8f84d#md5:b89d39ca3f8c532abe5f547ad3b8f84d", + "archive:https://github.com/ocaml-community/yojson/releases/download/1.7.0/yojson-1.7.0.tbz#md5:b89d39ca3f8c532abe5f547ad3b8f84d" + ], + "opam": { + "name": "yojson", + "version": "1.7.0", + "path": "reason.esy.lock/opam/yojson.1.7.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", + "@opam/dune@opam:2.6.2@20433b4f", "@opam/cppo@opam:1.6.6@f4f83858", + "@opam/biniou@opam:1.2.1@d7570399", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", + "@opam/dune@opam:2.6.2@20433b4f", "@opam/biniou@opam:1.2.1@d7570399" + ] + }, + "@opam/result@opam:1.5@6b753c82": { + "id": "@opam/result@opam:1.5@6b753c82", + "name": "@opam/result", + "version": "opam:1.5", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/1b/1b82dec78849680b49ae9a8a365b831b#md5:1b82dec78849680b49ae9a8a365b831b", + "archive:https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz#md5:1b82dec78849680b49ae9a8a365b831b" + ], + "opam": { + "name": "result", + "version": "1.5", + "path": "reason.esy.lock/opam/result.1.5" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45": { + "id": "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", + "name": "@opam/ppx_derivers", + "version": "opam:1.2.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/5d/5dc2bf130c1db3c731fe0fffc5648b41#md5:5dc2bf130c1db3c731fe0fffc5648b41", + "archive:https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz#md5:5dc2bf130c1db3c731fe0fffc5648b41" + ], + "opam": { + "name": "ppx_derivers", + "version": "1.2.1", + "path": "reason.esy.lock/opam/ppx_derivers.1.2.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2": { + "id": "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "name": "@opam/ocamlfind-secondary", + "version": "opam:1.8.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/18/18ca650982c15536616dea0e422cbd8c#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download2.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c" + ], + "opam": { + "name": "ocamlfind-secondary", + "version": "1.8.1", + "path": "reason.esy.lock/opam/ocamlfind-secondary.1.8.1" + } + }, + "overrides": [ + { + "opamoverride": + "reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override" + } + ], + "dependencies": [ + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f" + ] + }, + "@opam/ocamlfind@opam:1.8.1@ff07b0f9": { + "id": "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "name": "@opam/ocamlfind", + "version": "opam:1.8.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/18/18ca650982c15536616dea0e422cbd8c#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download2.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c" + ], + "opam": { + "name": "ocamlfind", + "version": "1.8.1", + "path": "reason.esy.lock/opam/ocamlfind.1.8.1" + } + }, + "overrides": [ + { + "opamoverride": + "reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override" + } + ], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/conf-m4@opam:1@3b2b148a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] + }, + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f": { + "id": "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f", + "name": "@opam/ocaml-secondary-compiler", + "version": "opam:4.08.1-1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/72/723b6bfe8cf5abcbccc6911143f71055#md5:723b6bfe8cf5abcbccc6911143f71055", + "archive:https://github.com/ocaml/ocaml/archive/4.08.1.tar.gz#md5:723b6bfe8cf5abcbccc6911143f71055" + ], + "opam": { + "name": "ocaml-secondary-compiler", + "version": "4.08.1-1", + "path": "reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1" + } + }, + "overrides": [ + { + "opamoverride": + "reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override" + } + ], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.6.1000@d41d8cd9" ] + }, + "@opam/merlin-extend@opam:0.6@404f814c": { + "id": "@opam/merlin-extend@opam:0.6@404f814c", + "name": "@opam/merlin-extend", + "version": "opam:0.6", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/c2/c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43#sha256:c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43", + "archive:https://github.com/let-def/merlin-extend/releases/download/v0.6/merlin-extend-v0.6.tbz#sha256:c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43" + ], + "opam": { + "name": "merlin-extend", + "version": "0.6", + "path": "reason.esy.lock/opam/merlin-extend.0.6" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@opam/cppo@opam:1.6.6@f4f83858", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/menhirSdk@opam:20200624@2a05b5a7": { + "id": "@opam/menhirSdk@opam:20200624@2a05b5a7", + "name": "@opam/menhirSdk", + "version": "opam:20200624", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/c3/c37ff53a4a69059e1f8223067b91bb8b#md5:c37ff53a4a69059e1f8223067b91bb8b", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz#md5:c37ff53a4a69059e1f8223067b91bb8b" + ], + "opam": { + "name": "menhirSdk", + "version": "20200624", + "path": "reason.esy.lock/opam/menhirSdk.20200624" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/menhirLib@opam:20200624@8bdd2b0e": { + "id": "@opam/menhirLib@opam:20200624@8bdd2b0e", + "name": "@opam/menhirLib", + "version": "opam:20200624", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/c3/c37ff53a4a69059e1f8223067b91bb8b#md5:c37ff53a4a69059e1f8223067b91bb8b", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz#md5:c37ff53a4a69059e1f8223067b91bb8b" + ], + "opam": { + "name": "menhirLib", + "version": "20200624", + "path": "reason.esy.lock/opam/menhirLib.20200624" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/menhir@opam:20200624@8629ff13": { + "id": "@opam/menhir@opam:20200624@8629ff13", + "name": "@opam/menhir", + "version": "opam:20200624", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/c3/c37ff53a4a69059e1f8223067b91bb8b#md5:c37ff53a4a69059e1f8223067b91bb8b", + "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz#md5:c37ff53a4a69059e1f8223067b91bb8b" + ], + "opam": { + "name": "menhir", + "version": "20200624", + "path": "reason.esy.lock/opam/menhir.20200624" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/menhirSdk@opam:20200624@2a05b5a7", + "@opam/menhirLib@opam:20200624@8bdd2b0e", + "@opam/dune@opam:2.6.2@20433b4f", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/menhirSdk@opam:20200624@2a05b5a7", + "@opam/menhirLib@opam:20200624@8bdd2b0e", + "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/fix@opam:20200131@0ecd2f01": { + "id": "@opam/fix@opam:20200131@0ecd2f01", + "name": "@opam/fix", + "version": "opam:20200131", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/99/991ff031666c662eaab638d2e0f4ac1d#md5:991ff031666c662eaab638d2e0f4ac1d", + "archive:https://gitlab.inria.fr/fpottier/fix/repository/20200131/archive.tar.gz#md5:991ff031666c662eaab638d2e0f4ac1d" + ], + "opam": { + "name": "fix", + "version": "20200131", + "path": "reason.esy.lock/opam/fix.20200131" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/easy-format@opam:1.3.2@0484b3c4": { + "id": "@opam/easy-format@opam:1.3.2@0484b3c4", + "name": "@opam/easy-format", + "version": "opam:1.3.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/34/3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926", + "archive:https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz#sha256:3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" + ], + "opam": { + "name": "easy-format", + "version": "1.3.2", + "path": "reason.esy.lock/opam/easy-format.1.3.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/dune@opam:2.6.2@20433b4f": { + "id": "@opam/dune@opam:2.6.2@20433b4f", + "name": "@opam/dune", + "version": "opam:2.6.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/4f/4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9#sha256:4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9", + "archive:https://github.com/ocaml/dune/releases/download/2.6.2/dune-2.6.2.tbz#sha256:4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9" + ], + "opam": { + "name": "dune", + "version": "2.6.2", + "path": "reason.esy.lock/opam/dune.2.6.2" + } + }, + "overrides": [ + { + "opamoverride": + "reason.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override" + } + ], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084" + ] + }, + "@opam/cppo@opam:1.6.6@f4f83858": { + "id": "@opam/cppo@opam:1.6.6@f4f83858", + "name": "@opam/cppo", + "version": "opam:1.6.6", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/e7/e7272996a7789175b87bb998efd079794a8db6625aae990d73f7b4484a07b8a0#sha256:e7272996a7789175b87bb998efd079794a8db6625aae990d73f7b4484a07b8a0", + "archive:https://github.com/ocaml-community/cppo/releases/download/v1.6.6/cppo-v1.6.6.tbz#sha256:e7272996a7789175b87bb998efd079794a8db6625aae990d73f7b4484a07b8a0" + ], + "opam": { + "name": "cppo", + "version": "1.6.6", + "path": "reason.esy.lock/opam/cppo.1.6.6" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@opam/base-unix@opam:base@87d0b2eb", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@opam/base-unix@opam:base@87d0b2eb" + ] + }, + "@opam/conf-m4@opam:1@3b2b148a": { + "id": "@opam/conf-m4@opam:1@3b2b148a", + "name": "@opam/conf-m4", + "version": "opam:1", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "conf-m4", + "version": "1", + "path": "reason.esy.lock/opam/conf-m4.1" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@opam/biniou@opam:1.2.1@d7570399": { + "id": "@opam/biniou@opam:1.2.1@d7570399", + "name": "@opam/biniou", + "version": "opam:1.2.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/35/35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335#sha256:35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335", + "archive:https://github.com/mjambon/biniou/releases/download/1.2.1/biniou-1.2.1.tbz#sha256:35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335" + ], + "opam": { + "name": "biniou", + "version": "1.2.1", + "path": "reason.esy.lock/opam/biniou.1.2.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", + "@opam/dune@opam:2.6.2@20433b4f", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", + "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/base-unix@opam:base@87d0b2eb": { + "id": "@opam/base-unix@opam:base@87d0b2eb", + "name": "@opam/base-unix", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "base-unix", + "version": "base", + "path": "reason.esy.lock/opam/base-unix.base" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@opam/base-threads@opam:base@36803084": { + "id": "@opam/base-threads@opam:base@36803084", + "name": "@opam/base-threads", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "base-threads", + "version": "base", + "path": "reason.esy.lock/opam/base-threads.base" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@esy-ocaml/substs@0.0.1@d41d8cd9": { + "id": "@esy-ocaml/substs@0.0.1@d41d8cd9", + "name": "@esy-ocaml/substs", + "version": "0.0.1", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/@esy-ocaml/substs/-/substs-0.0.1.tgz#sha1:59ebdbbaedcda123fc7ed8fb2b302b7d819e9a46" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + }, + "@esy-ocaml/reason@link-dev:./reason.json": { + "id": "@esy-ocaml/reason@link-dev:./reason.json", + "name": "@esy-ocaml/reason", + "version": "link-dev:./reason.json", + "source": { + "type": "link-dev", + "path": ".", + "manifest": "reason.json" + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@opam/merlin-extend@opam:0.6@404f814c", + "@opam/menhir@opam:20200624@8629ff13", + "@opam/fix@opam:20200131@0ecd2f01", "@opam/dune@opam:2.6.2@20433b4f" + ], + "devDependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@esy-ocaml/merlin@3.0.5005@d41d8cd9" + ] + }, + "@esy-ocaml/merlin@3.0.5005@d41d8cd9": { + "id": "@esy-ocaml/merlin@3.0.5005@d41d8cd9", + "name": "@esy-ocaml/merlin", + "version": "3.0.5005", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/@esy-ocaml/merlin/-/merlin-3.0.5005.tgz#sha1:4a9e2b4df20672524603b7b1797b7761d5d0d9ad" + ] + }, + "overrides": [], + "dependencies": [ + "ocaml@4.6.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@esy-ocaml/substs@0.0.1@d41d8cd9", + "@esy-ocaml/esy-installer@0.0.0@d41d8cd9" + ], + "devDependencies": [] + }, + "@esy-ocaml/esy-installer@0.0.0@d41d8cd9": { + "id": "@esy-ocaml/esy-installer@0.0.0@d41d8cd9", + "name": "@esy-ocaml/esy-installer", + "version": "0.0.0", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/@esy-ocaml/esy-installer/-/esy-installer-0.0.0.tgz#sha1:6b0e2bd4ee43531ac74793fe55cfcc3aca197a66" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + } + } +} \ No newline at end of file diff --git a/reason.esy.lock/opam/base-threads.base/opam b/reason.esy.lock/opam/base-threads.base/opam new file mode 100644 index 000000000..914ff50ce --- /dev/null +++ b/reason.esy.lock/opam/base-threads.base/opam @@ -0,0 +1,6 @@ +opam-version: "2.0" +maintainer: "https://github.com/ocaml/opam-repository/issues" +description: """ +Threads library distributed with the OCaml compiler +""" + diff --git a/reason.esy.lock/opam/base-unix.base/opam b/reason.esy.lock/opam/base-unix.base/opam new file mode 100644 index 000000000..b973540bc --- /dev/null +++ b/reason.esy.lock/opam/base-unix.base/opam @@ -0,0 +1,6 @@ +opam-version: "2.0" +maintainer: "https://github.com/ocaml/opam-repository/issues" +description: """ +Unix library distributed with the OCaml compiler +""" + diff --git a/reason.esy.lock/opam/biniou.1.2.1/opam b/reason.esy.lock/opam/biniou.1.2.1/opam new file mode 100644 index 000000000..b706b4251 --- /dev/null +++ b/reason.esy.lock/opam/biniou.1.2.1/opam @@ -0,0 +1,45 @@ +opam-version: "2.0" +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} +] +maintainer: ["martin@mjambon.com"] +authors: ["Martin Jambon"] +bug-reports: "https://github.com/mjambon/biniou/issues" +homepage: "https://github.com/mjambon/biniou" +doc: "https://mjambon.github.io/biniou/" +license: "BSD-3-Clause" +dev-repo: "git+https://github.com/mjambon/biniou.git" +synopsis: + "Binary data format designed for speed, safety, ease of use and backward compatibility as protocols evolve" +description: """ + +Biniou (pronounced "be new") is a binary data format designed for speed, safety, +ease of use and backward compatibility as protocols evolve. Biniou is vastly +equivalent to JSON in terms of functionality but allows implementations several +times faster (4 times faster than yojson), with 25-35% space savings. + +Biniou data can be decoded into human-readable form without knowledge of type +definitions except for field and variant names which are represented by 31-bit +hashes. A program named bdump is provided for routine visualization of biniou +data files. + +The program atdgen is used to derive OCaml-Biniou serializers and deserializers +from type definitions. + +Biniou format specification: mjambon.github.io/atdgen-doc/biniou-format.txt""" +depends: [ + "easy-format" + "dune" {>= "1.10"} + "ocaml" {>= "4.02.3"} +] +url { + src: + "https://github.com/mjambon/biniou/releases/download/1.2.1/biniou-1.2.1.tbz" + checksum: [ + "sha256=35546c68b1929a8e6d27a3b39ecd17b38303a0d47e65eb9d1480c2061ea84335" + "sha512=82670cc77bf3e869ee26e5fbe5a5affa45a22bc8b6c4bd7e85473912780e0111baca59b34a2c14feae3543ce6e239d7fddaeab24b686a65bfe642cdb91d27ebf" + ] +} diff --git a/reason.esy.lock/opam/conf-m4.1/opam b/reason.esy.lock/opam/conf-m4.1/opam new file mode 100644 index 000000000..c6feb2a74 --- /dev/null +++ b/reason.esy.lock/opam/conf-m4.1/opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +maintainer: "tim@gfxmonk.net" +homepage: "http://www.gnu.org/software/m4/m4.html" +bug-reports: "https://github.com/ocaml/opam-repository/issues" +authors: "GNU Project" +license: "GPL-3.0-only" +build: [["sh" "-exc" "echo | m4"]] +depexts: [ + ["m4"] {os-family = "debian"} + ["m4"] {os-distribution = "fedora"} + ["m4"] {os-distribution = "rhel"} + ["m4"] {os-distribution = "centos"} + ["m4"] {os-distribution = "alpine"} + ["m4"] {os-distribution = "nixos"} + ["m4"] {os-family = "suse"} + ["m4"] {os-distribution = "ol"} + ["m4"] {os-distribution = "arch"} +] +synopsis: "Virtual package relying on m4" +description: + "This package can only install if the m4 binary is installed on the system." +flags: conf diff --git a/reason.esy.lock/opam/cppo.1.6.6/opam b/reason.esy.lock/opam/cppo.1.6.6/opam new file mode 100644 index 000000000..f683f8b41 --- /dev/null +++ b/reason.esy.lock/opam/cppo.1.6.6/opam @@ -0,0 +1,37 @@ +opam-version: "2.0" +maintainer: "martin@mjambon.com" +authors: "Martin Jambon" +license: "BSD-3-Clause" +homepage: "http://mjambon.com/cppo.html" +doc: "https://ocaml-community.github.io/cppo/" +bug-reports: "https://github.com/ocaml-community/cppo/issues" +depends: [ + "ocaml" {>= "4.03"} + "dune" {>= "1.0"} + "base-unix" +] +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +dev-repo: "git+https://github.com/ocaml-community/cppo.git" +synopsis: "Code preprocessor like cpp for OCaml" +description: """ +Cppo is an equivalent of the C preprocessor for OCaml programs. +It allows the definition of simple macros and file inclusion. + +Cppo is: + +* more OCaml-friendly than cpp +* easy to learn without consulting a manual +* reasonably fast +* simple to install and to maintain +""" +url { + src: "https://github.com/ocaml-community/cppo/releases/download/v1.6.6/cppo-v1.6.6.tbz" + checksum: [ + "sha256=e7272996a7789175b87bb998efd079794a8db6625aae990d73f7b4484a07b8a0" + "sha512=44ecf9d225d9e45490a2feac0bde04865ca398dba6c3579e3370fcd1ea255707b8883590852af8b2df87123801062b9f3acce2455c092deabf431f9c4fb8d8eb" + ] +} diff --git a/reason.esy.lock/opam/dune.2.6.2/opam b/reason.esy.lock/opam/dune.2.6.2/opam new file mode 100644 index 000000000..655fb0111 --- /dev/null +++ b/reason.esy.lock/opam/dune.2.6.2/opam @@ -0,0 +1,55 @@ +opam-version: "2.0" +synopsis: "Fast, portable, and opinionated build system" +description: """ + +dune is a build system that was designed to simplify the release of +Jane Street packages. It reads metadata from "dune" files following a +very simple s-expression syntax. + +dune is fast, has very low-overhead, and supports parallel builds on +all platforms. It has no system dependencies; all you need to build +dune or packages using dune is OCaml. You don't need make or bash +as long as the packages themselves don't use bash explicitly. + +dune supports multi-package development by simply dropping multiple +repositories into the same directory. + +It also supports multi-context builds, such as building against +several opam roots/switches simultaneously. This helps maintaining +packages across several versions of OCaml and gives cross-compilation +for free. +""" +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml/dune" +doc: "https://dune.readthedocs.io/" +bug-reports: "https://github.com/ocaml/dune/issues" +conflicts: [ + "dune-configurator" {< "2.3.0"} + "odoc" {< "1.3.0"} + "dune-release" {< "1.3.0"} + "js_of_ocaml-compiler" {< "3.6.0"} + "jbuilder" {= "transition"} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + # opam 2 sets OPAM_SWITCH_PREFIX, so we don't need a hardcoded path + ["ocaml" "configure.ml" "--libdir" lib] {opam-version < "2"} + ["ocaml" "bootstrap.ml" "-j" jobs] + ["./dune.exe" "build" "-p" name "--profile" "dune-bootstrap" "-j" jobs] +] +depends: [ + # Please keep the lower bound in sync with .travis.yml, dune-project + # and min_ocaml_version in bootstrap.ml + ("ocaml" {>= "4.07"} | ("ocaml" {< "4.07~~"} & "ocamlfind-secondary")) + "base-unix" + "base-threads" +] +url { + src: "https://github.com/ocaml/dune/releases/download/2.6.2/dune-2.6.2.tbz" + checksum: [ + "sha256=4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9" + "sha512=d195479c99a59edb0cb7674375f45e518389b2f251b02e5f603c196b9592acbcf2a12193b3de70831a543fa477f57abb101fdd210660e25805b147c66877cafa" + ] +} diff --git a/reason.esy.lock/opam/easy-format.1.3.2/opam b/reason.esy.lock/opam/easy-format.1.3.2/opam new file mode 100644 index 000000000..138d0fb23 --- /dev/null +++ b/reason.esy.lock/opam/easy-format.1.3.2/opam @@ -0,0 +1,46 @@ +opam-version: "2.0" +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} +] +maintainer: ["martin@mjambon.com" "rudi.grinberg@gmail.com"] +authors: ["Martin Jambon"] +bug-reports: "https://github.com/mjambon/easy-format/issues" +homepage: "https://github.com/mjambon/easy-format" +doc: "https://mjambon.github.io/easy-format/" +license: "BSD-3-Clause" +dev-repo: "git+https://github.com/mjambon/easy-format.git" +synopsis: + "High-level and functional interface to the Format module of the OCaml standard library" +description: """ + +This module offers a high-level and functional interface to the Format module of +the OCaml standard library. It is a pretty-printing facility, i.e. it takes as +input some code represented as a tree and formats this code into the most +visually satisfying result, breaking and indenting lines of code where +appropriate. + +Input data must be first modelled and converted into a tree using 3 kinds of +nodes: + +* atoms +* lists +* labelled nodes + +Atoms represent any text that is guaranteed to be printed as-is. Lists can model +any sequence of items such as arrays of data or lists of definitions that are +labelled with something like "int main", "let x =" or "x:".""" +depends: [ + "dune" {>= "1.10"} + "ocaml" {>= "4.02.3"} +] +url { + src: + "https://github.com/mjambon/easy-format/releases/download/1.3.2/easy-format-1.3.2.tbz" + checksum: [ + "sha256=3440c2b882d537ae5e9011eb06abb53f5667e651ea4bb3b460ea8230fa8c1926" + "sha512=e39377a2ff020ceb9ac29e8515a89d9bdbc91dfcfa871c4e3baafa56753fac2896768e5d9822a050dc1e2ade43c8967afb69391a386c0a8ecd4e1f774e236135" + ] +} diff --git a/reason.esy.lock/opam/fix.20200131/opam b/reason.esy.lock/opam/fix.20200131/opam new file mode 100644 index 000000000..4babcba82 --- /dev/null +++ b/reason.esy.lock/opam/fix.20200131/opam @@ -0,0 +1,24 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " +] +homepage: "https://gitlab.inria.fr/fpottier/fix" +dev-repo: "git+https://gitlab.inria.fr/fpottier/fix.git" +bug-reports: "francois.pottier@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.03" } + "dune" { >= "1.3" } +] +synopsis: "Facilities for memoization and fixed points" +url { + src: + "https://gitlab.inria.fr/fpottier/fix/repository/20200131/archive.tar.gz" + checksum: [ + "md5=991ff031666c662eaab638d2e0f4ac1d" + "sha512=01c45a1d90b02ec0939e968b185a6a373ac6117e2287b9a26d3db9d71e9569d086cea50da60710fcab5c2ed9d3b4c72b76839c0651e436f1fb39c77dc7c04b5e" + ] +} diff --git a/reason.esy.lock/opam/menhir.20200624/opam b/reason.esy.lock/opam/menhir.20200624/opam new file mode 100644 index 000000000..37637fcf6 --- /dev/null +++ b/reason.esy.lock/opam/menhir.20200624/opam @@ -0,0 +1,27 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "dune" { >= "2.2.0"} + "menhirLib" {= version} + "menhirSdk" {= version} +] +synopsis: "An LR(1) parser generator" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz" + checksum: [ + "md5=c37ff53a4a69059e1f8223067b91bb8b" + "sha512=68cd165bd65c93fc9b14820a032b6d760674b3e811d8536c2e26e10f9fc5892720564f109484f12f8d08d849c2983c2eaf350d76ab1122a5b8a3c7674ab2bd39" + ] +} diff --git a/reason.esy.lock/opam/menhirLib.20200624/opam b/reason.esy.lock/opam/menhirLib.20200624/opam new file mode 100644 index 000000000..afcbe5d5e --- /dev/null +++ b/reason.esy.lock/opam/menhirLib.20200624/opam @@ -0,0 +1,28 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.02.3" } + "dune" { >= "2.0.0" } +] +conflicts: [ + "menhir" { != version } +] +synopsis: "Runtime support library for parsers generated by Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz" + checksum: [ + "md5=c37ff53a4a69059e1f8223067b91bb8b" + "sha512=68cd165bd65c93fc9b14820a032b6d760674b3e811d8536c2e26e10f9fc5892720564f109484f12f8d08d849c2983c2eaf350d76ab1122a5b8a3c7674ab2bd39" + ] +} diff --git a/reason.esy.lock/opam/menhirSdk.20200624/opam b/reason.esy.lock/opam/menhirSdk.20200624/opam new file mode 100644 index 000000000..af1221633 --- /dev/null +++ b/reason.esy.lock/opam/menhirSdk.20200624/opam @@ -0,0 +1,28 @@ +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " + "Yann Régis-Gianas " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "menhir@inria.fr" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.02.3" } + "dune" { >= "2.0.0" } +] +conflicts: [ + "menhir" { != version } +] +synopsis: "Compile-time library for auxiliary tools related to Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/repository/20200624/archive.tar.gz" + checksum: [ + "md5=c37ff53a4a69059e1f8223067b91bb8b" + "sha512=68cd165bd65c93fc9b14820a032b6d760674b3e811d8536c2e26e10f9fc5892720564f109484f12f8d08d849c2983c2eaf350d76ab1122a5b8a3c7674ab2bd39" + ] +} diff --git a/reason.esy.lock/opam/merlin-extend.0.6/opam b/reason.esy.lock/opam/merlin-extend.0.6/opam new file mode 100644 index 000000000..39b337577 --- /dev/null +++ b/reason.esy.lock/opam/merlin-extend.0.6/opam @@ -0,0 +1,30 @@ +opam-version: "2.0" +maintainer: "Frederic Bour " +authors: "Frederic Bour " +homepage: "https://github.com/let-def/merlin-extend" +bug-reports: "https://github.com/let-def/merlin-extend" +license: "MIT" +dev-repo: "git+https://github.com/let-def/merlin-extend.git" +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "dune" {>= "1.0"} + "cppo" {build} + "ocaml" {>= "4.02.3"} +] +synopsis: "A protocol to provide custom frontend to Merlin" +description: """ +This protocol allows to replace the OCaml frontend of Merlin. +It extends what used to be done with the `-pp' flag to handle a few more cases.""" +doc: "https://let-def.github.io/merlin-extend" +x-commit-hash: "640620568a5f5c7798239ecf7c707c813e3df3cf" +url { + src: + "https://github.com/let-def/merlin-extend/releases/download/v0.6/merlin-extend-v0.6.tbz" + checksum: [ + "sha256=c2f236ae97feb6ba0bc90f33beb7b7343e42f9871b66de9ba07974917e256c43" + "sha512=4c64a490e2ece04fc89aef679c1d9202175df4fe045b5fdc7a37cd7cebe861226fddd9648c1bf4f06175ecfcd2ed7686c96bd6a8cae003a5096f6134c240f857" + ] +} diff --git a/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch new file mode 100644 index 000000000..cda19dd2d --- /dev/null +++ b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch @@ -0,0 +1,24 @@ +From 0cf3c6ad7ce2a2b2806faceccfb0a9321da5e22a Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Fri, 26 Jul 2019 12:12:19 +0100 +Subject: [PATCH] Don't build manpages for stdlib docs +--- + ocamldoc/Makefile | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile +index b109815071..e31e441f61 100644 +--- a/ocamldoc/Makefile ++++ b/ocamldoc/Makefile +@@ -170,7 +170,7 @@ LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi) + + + .PHONY: all +-all: lib exe generators manpages ++all: lib exe generators + + manpages: generators + +-- +2.20.1 + diff --git a/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch new file mode 100644 index 000000000..41f5f7704 --- /dev/null +++ b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch @@ -0,0 +1,26 @@ +From 705739fa54260b7a0e6cbba0b5a99e52c79f9c09 Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Tue, 6 Aug 2019 09:23:06 +0100 +Subject: [PATCH] Fix failure to install tools links + +In --disable-installing-bytecode-programs mode, the .opt version of the +tools is installed, but the symlink for the tool itself is not created. +--- + tools/Makefile | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/tools/Makefile b/tools/Makefile +index 530dd37f34..1b3014a3ab 100644 +--- a/tools/Makefile ++++ b/tools/Makefile +@@ -197,6 +197,7 @@ else + do \ + if test -f "$$i".opt; then \ + $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)"; \ ++ (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \ + fi; \ + done + endif +-- +2.20.1 + diff --git a/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch new file mode 100644 index 000000000..e37b5e883 --- /dev/null +++ b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch @@ -0,0 +1,34 @@ +commit 3f10a16153308f967149917585d2bc0b9c06492c +Author: Anil Madhavapeddy +Date: Sun Jun 21 18:40:27 2020 +0100 + + Add `-fcommon` unconditionally to CFLAGS to fix gcc10 build + + Signed-off-by: Anil Madhavapeddy + +diff --git a/configure b/configure +index 9a78a4554..0c54b560b 100755 +--- a/configure ++++ b/configure +@@ -12424,7 +12424,7 @@ $as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;}; + -fno-builtin-memcmp"; + internal_cflags="$gcc_warnings" ;; #( + gcc-*) : +- common_cflags="-O2 -fno-strict-aliasing -fwrapv"; ++ common_cflags="-O2 -fno-strict-aliasing -fwrapv -fcommon"; + internal_cflags="$gcc_warnings" ;; #( + msvc-*) : + common_cflags="-nologo -O2 -Gy- -MD" +diff --git a/configure.ac b/configure.ac +index f5d8a2687..775e0e2db 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -540,7 +540,7 @@ AS_CASE([$host], + -fno-builtin-memcmp"; + internal_cflags="$gcc_warnings"], + [gcc-*], +- [common_cflags="-O2 -fno-strict-aliasing -fwrapv"; ++ [common_cflags="-O2 -fno-strict-aliasing -fwrapv -fcommon"; + internal_cflags="$gcc_warnings"], + [msvc-*], + [common_cflags="-nologo -O2 -Gy- -MD" diff --git a/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam new file mode 100644 index 000000000..905f9b3dd --- /dev/null +++ b/reason.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam @@ -0,0 +1,51 @@ +opam-version: "2.0" +synopsis: "OCaml 4.08.1 Secondary Switch Compiler" +maintainer: "platform@lists.ocaml.org" +authors: "Xavier Leroy and many contributors" +homepage: "https://ocaml.org" +bug-reports: "https://github.com/ocaml/ocaml/issues" +dev-repo: "git://github.com/ocaml/ocaml" +depends: "ocaml" {< "4.08.0" | >= "4.09~"} +build: [ + [ + "./configure" + "--prefix=%{_:share}%" + "--libdir=%{_:share}%/lib" + "--disable-debugger" + "--disable-installing-bytecode-programs" + "--disable-debug-runtime" + "--disable-instrumented-runtime" + "--disable-graph-lib" + "CC=cc" {os = "openbsd" | os = "freebsd" | os = "macos"} + "ASPP=cc -c" {os = "openbsd" | os = "freebsd" | os = "macos"} + ] + [make "-j%{jobs}%" {os != "cygwin"} "world.opt"] +] +install: [make "install"] +url { + src: "https://github.com/ocaml/ocaml/archive/4.08.1.tar.gz" + checksum: "md5=723b6bfe8cf5abcbccc6911143f71055" +} +extra-files: [ + ["0001-Don-t-build-manpages-for-stdlib-docs.patch" "md5=6caa580fe6031c109d2dc96b19bd40cd"] + ["0001-Fix-failure-to-install-tools-links.patch" "md5=e973762c0b3d62b0b25a26468086fae3"] + ["fix-gcc10.patch" "md5=17ecd696a8f5647a4c543280599f6974"] +] +patches: [ + "0001-Don-t-build-manpages-for-stdlib-docs.patch" + "0001-Fix-failure-to-install-tools-links.patch" + "fix-gcc10.patch" +] + +post-messages: [ + "A failure in the middle of the build may be caused by build parallelism + (enabled by default). + Please file a bug report at https://github.com/ocaml/ocaml/issues" + {failure & jobs > 1 & os != "cygwin"} + "You can try installing again including --jobs=1 + to force a sequential build instead." + {failure & jobs > 1 & os != "cygwin" & opam-version >= "2.0.5"} +] +description: "Installs an additional compiler to the opam switch in +%{_:share}%/ocaml-secondary-compiler which can be accessed using +`ocamlfind -toolchain secondary`." diff --git a/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in new file mode 100644 index 000000000..12e3ee661 --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in @@ -0,0 +1,3 @@ +description = "OCaml Secondary Compiler" +version = "%{ocaml-secondary-compiler:version}%" +directory = "%{ocaml-secondary-compiler:share}%/bin" diff --git a/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in new file mode 100644 index 000000000..d13023c9f --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in @@ -0,0 +1,10 @@ +path(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +destdir(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +stdlib(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +ocamlc(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlc" +ocamlopt(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlopt" +ocamlcp(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlcp" +ocamlmklib(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlmklib" +ocamlmktop(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlmktop" +ocamldoc(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamldoc" +ocamldep(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamldep" diff --git a/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/opam b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/opam new file mode 100644 index 000000000..acdb57645 --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind-secondary.1.8.1/opam @@ -0,0 +1,32 @@ +opam-version: "2.0" +maintainer: "David Allsopp " +homepage: "https://github.com/ocaml/opam-repository" +bug-reports: "https://github.com/ocaml/opam-repository/issues" +build: ["./configure" "-sitelib" "%{ocaml-secondary-compiler:share}%/lib" "-no-camlp4"] +install: [ + [make "install-meta"] + ["mkdir" "-p" "%{lib}%/findlib.conf.d/"] + ["cp" "ocaml-secondary-compiler.conf" "%{lib}%/findlib.conf.d/"] + ["mkdir" "-p" "%{ocaml-secondary-compiler:share}%/lib/ocaml"] + ["cp" "META" "%{ocaml-secondary-compiler:share}%/lib/ocaml"] +] +depends: [ + "ocaml-secondary-compiler" + "ocamlfind" {= "1.8.1"} +] +synopsis: "ocamlfind support for ocaml-secondary-compiler" +description: """ +Exposes the compiler built by the ocaml-secondary-compielr package via +-toolchain secondary. A virtual package called ocaml is also installed to +locate the binary directory via `ocamlfind -toolchain secondary query ocaml`.""" +authors: ["Gerd Stolpmann " "David Allsopp "] +substs: ["META" "ocaml-secondary-compiler.conf"] +extra-files: [ + ["META.in" "md5=8c6ea8a0158a33ed87e6c38a7d686d49"] + ["ocaml-secondary-compiler.conf.in" "md5=367a7bb68e2e1e65a31356421ddc809c"] +] +url { + src: "http://download.camlcity.org/download/findlib-1.8.1.tar.gz" + checksum: "md5=18ca650982c15536616dea0e422cbd8c" + mirrors: "http://download2.camlcity.org/download/findlib-1.8.1.tar.gz" +} diff --git a/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub b/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub new file mode 100644 index 000000000..e5ad9907e --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub @@ -0,0 +1,4 @@ +#!/bin/sh + +BINDIR=$(dirname "$(command -v ocamlc)") +"$BINDIR/ocaml" -I "$OCAML_TOPLEVEL_PATH" "$@" diff --git a/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install b/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install new file mode 100644 index 000000000..295c62545 --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install @@ -0,0 +1,6 @@ +bin: [ + "src/findlib/ocamlfind" {"ocamlfind"} + "?src/findlib/ocamlfind_opt" {"ocamlfind"} + "?tools/safe_camlp4" +] +toplevel: ["src/findlib/topfind"] diff --git a/reason.esy.lock/opam/ocamlfind.1.8.1/opam b/reason.esy.lock/opam/ocamlfind.1.8.1/opam new file mode 100644 index 000000000..d757d669c --- /dev/null +++ b/reason.esy.lock/opam/ocamlfind.1.8.1/opam @@ -0,0 +1,50 @@ +opam-version: "2.0" +synopsis: "A library manager for OCaml" +maintainer: "Thomas Gazagnaire " +authors: "Gerd Stolpmann " +homepage: "http://projects.camlcity.org/projects/findlib.html" +bug-reports: "https://gitlab.camlcity.org/gerd/lib-findlib/issues" +dev-repo: "git+https://gitlab.camlcity.org/gerd/lib-findlib.git" +description: """ +Findlib is a library manager for OCaml. It provides a convention how +to store libraries, and a file format ("META") to describe the +properties of libraries. There is also a tool (ocamlfind) for +interpreting the META files, so that it is very easy to use libraries +in programs and scripts. +""" +build: [ + [ + "./configure" + "-bindir" + bin + "-sitelib" + lib + "-mandir" + man + "-config" + "%{lib}%/findlib.conf" + "-no-custom" + "-no-camlp4" {!ocaml:preinstalled & ocaml:version >= "4.02.0"} + "-no-topfind" {ocaml:preinstalled} + ] + [make "all"] + [make "opt"] {ocaml:native} +] +install: [ + [make "install"] + ["install" "-m" "0755" "ocaml-stub" "%{bin}%/ocaml"] {ocaml:preinstalled} +] +depends: [ + "ocaml" {>= "4.00.0"} + "conf-m4" {build} +] +extra-files: [ + ["ocamlfind.install" "md5=06f2c282ab52d93aa6adeeadd82a2543"] + ["ocaml-stub" "md5=181f259c9e0bad9ef523e7d4abfdf87a"] +] +url { + src: "http://download.camlcity.org/download/findlib-1.8.1.tar.gz" + checksum: "md5=18ca650982c15536616dea0e422cbd8c" + mirrors: "http://download2.camlcity.org/download/findlib-1.8.1.tar.gz" +} +depopts: ["graphics"] diff --git a/reason.esy.lock/opam/ppx_derivers.1.2.1/opam b/reason.esy.lock/opam/ppx_derivers.1.2.1/opam new file mode 100644 index 000000000..3d10814e0 --- /dev/null +++ b/reason.esy.lock/opam/ppx_derivers.1.2.1/opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +maintainer: "jeremie@dimino.org" +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-ppx/ppx_derivers" +bug-reports: "https://github.com/ocaml-ppx/ppx_derivers/issues" +dev-repo: "git://github.com/ocaml-ppx/ppx_derivers.git" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" + "dune" +] +synopsis: "Shared [@@deriving] plugin registry" +description: """ +Ppx_derivers is a tiny package whose sole purpose is to allow +ppx_deriving and ppx_type_conv to inter-operate gracefully when linked +as part of the same ocaml-migrate-parsetree driver.""" +url { + src: "https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz" + checksum: "md5=5dc2bf130c1db3c731fe0fffc5648b41" +} diff --git a/reason.esy.lock/opam/result.1.5/opam b/reason.esy.lock/opam/result.1.5/opam new file mode 100644 index 000000000..671af042a --- /dev/null +++ b/reason.esy.lock/opam/result.1.5/opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +maintainer: "opensource@janestreet.com" +authors: ["Jane Street Group, LLC "] +homepage: "https://github.com/janestreet/result" +dev-repo: "git+https://github.com/janestreet/result.git" +bug-reports: "https://github.com/janestreet/result/issues" +license: "BSD-3-Clause" +build: [["dune" "build" "-p" name "-j" jobs]] +depends: [ + "ocaml" + "dune" {>= "1.0"} +] +synopsis: "Compatibility Result module" +description: """ +Projects that want to use the new result type defined in OCaml >= 4.03 +while staying compatible with older version of OCaml should use the +Result module defined in this library.""" +url { + src: + "https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz" + checksum: "md5=1b82dec78849680b49ae9a8a365b831b" +} diff --git a/reason.esy.lock/opam/yojson.1.7.0/opam b/reason.esy.lock/opam/yojson.1.7.0/opam new file mode 100644 index 000000000..ffef0682a --- /dev/null +++ b/reason.esy.lock/opam/yojson.1.7.0/opam @@ -0,0 +1,38 @@ +opam-version: "2.0" +maintainer: "martin@mjambon.com" +authors: ["Martin Jambon"] +homepage: "https://github.com/ocaml-community/yojson" +bug-reports: "https://github.com/ocaml-community/yojson/issues" +dev-repo: "git+https://github.com/ocaml-community/yojson.git" +doc: "https://ocaml-community.github.io/yojson/" +build: [ + ["dune" "subst"] {pinned} + ["dune" "build" "-p" name "-j" jobs] +] +run-test: [["dune" "runtest" "-p" name "-j" jobs]] +depends: [ + "ocaml" {>= "4.02.3"} + "dune" + "cppo" {build} + "easy-format" + "biniou" {>= "1.2.0"} + "alcotest" {with-test & >= "0.8.5"} +] +synopsis: + "Yojson is an optimized parsing and printing library for the JSON format" +description: """ +Yojson is an optimized parsing and printing library for the JSON format. + +It addresses a few shortcomings of json-wheel including 2x speedup, +polymorphic variants and optional syntax for tuples and variants. + +ydump is a pretty-printing command-line program provided with the +yojson package. + +The program atdgen can be used to derive OCaml-JSON serializers and +deserializers from type definitions.""" +url { + src: + "https://github.com/ocaml-community/yojson/releases/download/1.7.0/yojson-1.7.0.tbz" + checksum: "md5=b89d39ca3f8c532abe5f547ad3b8f84d" +} diff --git a/reason.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json b/reason.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json new file mode 100644 index 000000000..f2b2e9f48 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json @@ -0,0 +1,34 @@ +{ + "buildsInSource": true, + "build": [ + [ + "ocaml", + "configure.ml", + "--libdir", + "#{self.lib}" + ], + [ + "env", + "-u", + "OCAMLLIB", + "ocaml", + "bootstrap.ml" + ], + [ + "./dune.exe", + "build", + "-p", + "dune", + "--profile", + "dune-bootstrap" + ] + ], + "install": "esy-installer dune.install", + "buildEnv": { + "OCAMLFIND_CONF": "$OCAMLFIND_SECONDARY_PREFIX/lib/findlib.conf.d/ocaml-secondary-compiler.conf", + "OCAMLPATH": "#{ $OCAMLFIND_SECONDARY_PREFIX / 'lib' : ocaml.lib : $OCAML_SECONDARY_COMPILER_PREFIX / 'share' / 'ocaml-secondary-compiler' / 'lib' }" + }, + "dependencies": { + "ocaml": "*" + } +} diff --git a/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll new file mode 100644 index 000000000..26301ddd3 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll @@ -0,0 +1,16 @@ +#! /bin/sh + +# clone-flexdll +# +# Brings in flexdll, if necessary + +if [ -d "flexdll" ] && [ -f "flexdll/flexdll.c" ]; then + echo "[Flexdll] Already present, no need to clone." +else + echo "[Flexdll] Cloning..." + git clone https://github.com/esy-ocaml/flexdll.git + cd flexdll + git checkout f84baaeae463f96f9582883a9cfb7dd1096757ff + cd .. + echo "[Flexdll] Clone successful!" +fi \ No newline at end of file diff --git a/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows new file mode 100644 index 000000000..4040b49ea --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows @@ -0,0 +1,22 @@ +#! /bin/sh + +# configure-windows +# +# Creates a native Windows MingW build, based on: +# https://github.com/ocaml/ocaml/blob/trunk/README.win32.adoc + + +export prefix=C:/ocamlmgw64 +while : ; do + case "$1" in + "") break;; + -prefix|--prefix) + prefix=$2; shift;; + esac + shift +done + +echo "[configure-windows] Setting up flexdll" +./clone-flexdll +./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32 --prefix=$prefix +make flexdll diff --git a/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build new file mode 100644 index 000000000..b95356a53 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build @@ -0,0 +1,24 @@ +#! /usr/bin/env bash + +# esy-build +# +# Wrapper to execute appropriate build strategy, based on platform + +set -u +set -e +set -o pipefail + +case "$(uname -s)" in + CYGWIN*|MINGW32*|MSYS*) + echo "[esy-build] Detected windows environment..." + make -j4 world.opt + make flexlink.opt + ;; + *) + echo "[esy-build] Detected OSX / Linux environment" + make -j4 world.opt + ;; +esac + +# Common build steps +make install \ No newline at end of file diff --git a/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure new file mode 100644 index 000000000..fd196c517 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure @@ -0,0 +1,29 @@ +#! /usr/bin/env bash + +# esy-configure +# +# Wrapper to delegate to configuration to the +# appropriate `configure` strategy based on the active platform. +# +# Today, OCaml has separate build strategies: +# - Linux, OSX, Cygwin (gcc) - https://github.com/ocaml/ocaml/blob/trunk/INSTALL.adoc +# - Windows, Cygin (mingw) - https://github.com/ocaml/ocaml/blob/trunk/README.win32.adoc +# +# We want `esy` to work cross-platform, so this is a shim script that will delegate to the +# appropriate script depending on the platform. We assume that if the platform is `CYGWIN` +# that the `mingw` (native executable) strategy is desired. + +set -u +set -e +set -o pipefail + +case "$(uname -s)" in + CYGWIN*|MINGW32*|MSYS*) + echo "[esy-configure] Detected windows environment..." + ./configure-windows "$@" + ;; + *) + echo "[esy-configure] Detected OSX / Linux environment" + ./configure "$@" + ;; +esac \ No newline at end of file diff --git a/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json new file mode 100644 index 000000000..948455caf --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json @@ -0,0 +1,28 @@ +{ + "buildEnv": { + "PATH": "/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin" + }, + "build": [ + [ + "env", + "-u", + "OCAMLLIB", + "bash", "./esy-configure", + "--disable-cfi", + "--prefix", "$cur__install/share/ocaml-secondary-compiler", + "--libdir", "$cur__install/share/ocaml-secondary-compiler/lib", + "--disable-debugger", + "--disable-installing-bytecode-programs", + "--disable-debug-runtime", + "--disable-instrumented-runtime", + "--disable-graph-lib" + ], + [ + "env", + "-u", + "OCAMLLIB", + "bash", "./esy-build" + ] + ], + "buildsInSource": true +} diff --git a/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch new file mode 100644 index 000000000..3e3ee5a24 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch @@ -0,0 +1,471 @@ +--- ./Makefile ++++ ./Makefile +@@ -57,16 +57,16 @@ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ +- echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ ++ echo 'ocamlc="ocamlc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamlopt; then \ +- echo 'ocamlopt="ocamlopt.opt"' >>findlib.conf; \ ++ echo 'ocamlopt="ocamlopt.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldep; then \ +- echo 'ocamldep="ocamldep.opt"' >>findlib.conf; \ ++ echo 'ocamldep="ocamldep.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldoc; then \ +- echo 'ocamldoc="ocamldoc.opt"' >>findlib.conf; \ ++ echo 'ocamldoc="ocamldoc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + + .PHONY: install-doc +--- ./src/findlib/findlib_config.mlp ++++ ./src/findlib/findlib_config.mlp +@@ -24,3 +24,5 @@ + | "MacOS" -> "" (* don't know *) + | _ -> failwith "Unknown Sys.os_type" + ;; ++ ++let exec_suffix = "@EXEC_SUFFIX@";; +--- ./src/findlib/findlib.ml ++++ ./src/findlib/findlib.ml +@@ -28,15 +28,20 @@ + let conf_ldconf = ref "";; + let conf_ignore_dups_in = ref ([] : string list);; + +-let ocamlc_default = "ocamlc";; +-let ocamlopt_default = "ocamlopt";; +-let ocamlcp_default = "ocamlcp";; +-let ocamloptp_default = "ocamloptp";; +-let ocamlmklib_default = "ocamlmklib";; +-let ocamlmktop_default = "ocamlmktop";; +-let ocamldep_default = "ocamldep";; +-let ocamlbrowser_default = "ocamlbrowser";; +-let ocamldoc_default = "ocamldoc";; ++let add_exec str = ++ match Findlib_config.exec_suffix with ++ | "" -> str ++ | a -> str ^ a ;; ++let ocamlc_default = add_exec "ocamlc";; ++let ocamlopt_default = add_exec "ocamlopt";; ++let ocamlcp_default = add_exec "ocamlcp";; ++let ocamloptp_default = add_exec "ocamloptp";; ++let ocamlmklib_default = add_exec "ocamlmklib";; ++let ocamlmktop_default = add_exec "ocamlmktop";; ++let ocamldep_default = add_exec "ocamldep";; ++let ocamlbrowser_default = add_exec "ocamlbrowser";; ++let ocamldoc_default = add_exec "ocamldoc";; ++ + + + let init_manually +--- ./src/findlib/fl_package_base.ml ++++ ./src/findlib/fl_package_base.ml +@@ -133,7 +133,15 @@ + List.find (fun def -> def.def_var = "exists_if") p.package_defs in + let files = Fl_split.in_words def.def_value in + List.exists +- (fun file -> Sys.file_exists (Filename.concat d' file)) ++ (fun file -> ++ let fln = Filename.concat d' file in ++ let e = Sys.file_exists fln in ++ (* necessary for ppx executables *) ++ if e || Sys.os_type <> "Win32" || Filename.check_suffix fln ".exe" then ++ e ++ else ++ Sys.file_exists (fln ^ ".exe") ++ ) + files + with Not_found -> true in + +--- ./src/findlib/fl_split.ml ++++ ./src/findlib/fl_split.ml +@@ -126,10 +126,17 @@ + | '/' | '\\' -> true + | _ -> false in + let norm_dir_win() = +- if l >= 1 && s.[0] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[0]; +- if l >= 2 && s.[1] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[1]; ++ if l >= 1 then ( ++ if s.[0] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[0] ; ++ if l >= 2 then ++ if s.[1] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[1]; ++ ); + for k = 2 to l - 1 do + let c = s.[k] in + if is_slash c then ( +--- ./src/findlib/frontend.ml ++++ ./src/findlib/frontend.ml +@@ -31,10 +31,18 @@ + else + Sys_error (arg ^ ": " ^ Unix.error_message code) + ++let is_win = Sys.os_type = "Win32" ++ ++let () = ++ match Findlib_config.system with ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> ++ (try set_binary_mode_out stdout true with _ -> ()); ++ (try set_binary_mode_out stderr true with _ -> ()); ++ | _ -> () + + let slashify s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> + let b = Buffer.create 80 in + String.iter + (function +@@ -49,7 +57,7 @@ + + let out_path ?(prefix="") s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "mingw64" | "cygwin" -> + let u = slashify s in + prefix ^ + (if String.contains u ' ' then +@@ -273,11 +281,9 @@ + + + let identify_dir d = +- match Sys.os_type with +- | "Win32" -> +- failwith "identify_dir" (* not available *) +- | _ -> +- let s = Unix.stat d in ++ if is_win then ++ failwith "identify_dir"; (* not available *) ++ let s = Unix.stat d in + (s.Unix.st_dev, s.Unix.st_ino) + ;; + +@@ -459,6 +465,96 @@ + ) + packages + ++let rewrite_cmd s = ++ if s = "" || not is_win then ++ s ++ else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_cmd s = ++ if s = "" || not is_win then s else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_pp cmd = ++ if not is_win then cmd else ++ let module T = struct exception Keep end in ++ let is_whitespace = function ++ | ' ' | '\011' | '\012' | '\n' | '\r' | '\t' -> true ++ | _ -> false in ++ (* characters that triggers special behaviour (cmd.exe, not unix shell) *) ++ let is_unsafe_char = function ++ | '(' | ')' | '%' | '!' | '^' | '<' | '>' | '&' -> true ++ | _ -> false in ++ let len = String.length cmd in ++ let buf = Buffer.create (len + 4) in ++ let buf_cmd = Buffer.create len in ++ let rec iter_ws i = ++ if i >= len then () else ++ let cur = cmd.[i] in ++ if is_whitespace cur then ( ++ Buffer.add_char buf cur; ++ iter_ws (succ i) ++ ) ++ else ++ iter_cmd i ++ and iter_cmd i = ++ if i >= len then add_buf_cmd () else ++ let cur = cmd.[i] in ++ if is_unsafe_char cur || cur = '"' || cur = '\'' then ++ raise T.Keep; ++ if is_whitespace cur then ( ++ add_buf_cmd (); ++ Buffer.add_substring buf cmd i (len - i) ++ ) ++ else ( ++ Buffer.add_char buf_cmd cur; ++ iter_cmd (succ i) ++ ) ++ and add_buf_cmd () = ++ if Buffer.length buf_cmd > 0 then ++ Buffer.add_string buf (rewrite_cmd (Buffer.contents buf_cmd)) ++ in ++ try ++ iter_ws 0; ++ Buffer.contents buf ++ with ++ | T.Keep -> cmd + + let process_pp_spec syntax_preds packages pp_opts = + (* Returns: pp_command *) +@@ -549,7 +645,7 @@ + None -> [] + | Some cmd -> + ["-pp"; +- cmd ^ " " ^ ++ (rewrite_cmd cmd) ^ " " ^ + String.concat " " (List.map Filename.quote pp_i_options) ^ " " ^ + String.concat " " (List.map Filename.quote pp_archives) ^ " " ^ + String.concat " " (List.map Filename.quote pp_opts)] +@@ -625,9 +721,11 @@ + in + try + let preprocessor = ++ rewrite_cmd ( + resolve_path + ~base ~explicit:true +- (package_property predicates pname "ppx") in ++ (package_property predicates pname "ppx") ) ++ in + ["-ppx"; String.concat " " (preprocessor :: options)] + with Not_found -> [] + ) +@@ -895,6 +993,14 @@ + switch (e.g. -L instead of -L ) + *) + ++(* We may need to remove files on which we do not have complete control. ++ On Windows, removing a read-only file fails so try to change the ++ mode of the file first. *) ++let remove_file fname = ++ try Sys.remove fname ++ with Sys_error _ when is_win -> ++ (try Unix.chmod fname 0o666 with Unix.Unix_error _ -> ()); ++ Sys.remove fname + + let ocamlc which () = + +@@ -1022,9 +1128,12 @@ + + "-intf", + Arg.String (fun s -> pass_files := !pass_files @ [ Intf(slashify s) ]); +- ++ + "-pp", +- Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" s); ++ Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" (rewrite_pp s)); ++ ++ "-ppx", ++ Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); + + "-thread", + Arg.Unit (fun _ -> threads := threads_default); +@@ -1237,7 +1346,7 @@ + with + any -> + close_out initl; +- Sys.remove initl_file_name; ++ remove_file initl_file_name; + raise any + end; + +@@ -1245,9 +1354,9 @@ + at_exit + (fun () -> + let tr f x = try f x with _ -> () in +- tr Sys.remove initl_file_name; +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmi"); +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmo"); ++ tr remove_file initl_file_name; ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmi"); ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmo"); + ); + + let exclude_list = [ stdlibdir; threads_dir; vmthreads_dir ] in +@@ -1493,7 +1602,9 @@ + [ "-v", Arg.Unit (fun () -> verbose := Verbose); + "-pp", Arg.String (fun s -> + pp_specified := true; +- options := !options @ ["-pp"; s]); ++ options := !options @ ["-pp"; rewrite_pp s]); ++ "-ppx", Arg.String (fun s -> ++ options := !options @ ["-ppx"; rewrite_pp s]); + ] + ) + ) +@@ -1672,7 +1783,9 @@ + Arg.String (fun s -> add_spec_fn "-I" (slashify (resolve_path s))); + + "-pp", Arg.String (fun s -> pp_specified := true; +- add_spec_fn "-pp" s); ++ add_spec_fn "-pp" (rewrite_pp s)); ++ "-ppx", Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); ++ + ] + ) + ) +@@ -1830,7 +1943,10 @@ + output_string ch_out append; + close_out ch_out; + close_in ch_in; +- Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime; ++ (try Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime ++ with Unix.Unix_error(e,_,_) -> ++ prerr_endline("Warning: setting utimes for " ^ outpath ++ ^ ": " ^ Unix.error_message e)); + + prerr_endline("Installed " ^ outpath); + with +@@ -1882,6 +1998,8 @@ + Unix.openfile (Filename.concat dir owner_file) [Unix.O_RDONLY] 0 in + let f = + Unix.in_channel_of_descr fd in ++ if is_win then ++ set_binary_mode_in f false; + try + let line = input_line f in + let is_my_file = (line = pkg) in +@@ -2208,7 +2326,7 @@ + let lines = read_ldconf !ldconf in + let dlldir_norm = Fl_split.norm_dir dlldir in + let dlldir_norm_lc = string_lowercase_ascii dlldir_norm in +- let ci_filesys = (Sys.os_type = "Win32") in ++ let ci_filesys = is_win in + let check_dir d = + let d' = Fl_split.norm_dir d in + (d' = dlldir_norm) || +@@ -2356,7 +2474,7 @@ + List.iter + (fun file -> + let absfile = Filename.concat dlldir file in +- Sys.remove absfile; ++ remove_file absfile; + prerr_endline ("Removed " ^ absfile) + ) + dll_files +@@ -2365,7 +2483,7 @@ + (* Remove the files from the package directory: *) + if Sys.file_exists pkgdir then begin + let files = Sys.readdir pkgdir in +- Array.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files; ++ Array.iter (fun f -> remove_file (Filename.concat pkgdir f)) files; + Unix.rmdir pkgdir; + prerr_endline ("Removed " ^ pkgdir) + end +@@ -2415,7 +2533,9 @@ + + + let print_configuration() = ++ let sl = slashify in + let dir s = ++ let s = sl s in + if Sys.file_exists s then + s + else +@@ -2453,27 +2573,27 @@ + if md = "" then "the corresponding package directories" else dir md + ); + Printf.printf "The standard library is assumed to reside in:\n %s\n" +- (Findlib.ocaml_stdlib()); ++ (sl (Findlib.ocaml_stdlib())); + Printf.printf "The ld.conf file can be found here:\n %s\n" +- (Findlib.ocaml_ldconf()); ++ (sl (Findlib.ocaml_ldconf())); + flush stdout + | Some "conf" -> +- print_endline (Findlib.config_file()) ++ print_endline (sl (Findlib.config_file())) + | Some "path" -> +- List.iter print_endline (Findlib.search_path()) ++ List.iter ( fun x -> print_endline (sl x)) (Findlib.search_path()) + | Some "destdir" -> +- print_endline (Findlib.default_location()) ++ print_endline ( sl (Findlib.default_location())) + | Some "metadir" -> +- print_endline (Findlib.meta_directory()) ++ print_endline ( sl (Findlib.meta_directory())) + | Some "metapath" -> + let mdir = Findlib.meta_directory() in + let ddir = Findlib.default_location() in +- print_endline +- (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META") ++ print_endline ( sl ++ (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META")) + | Some "stdlib" -> +- print_endline (Findlib.ocaml_stdlib()) ++ print_endline ( sl (Findlib.ocaml_stdlib())) + | Some "ldconf" -> +- print_endline (Findlib.ocaml_ldconf()) ++ print_endline ( sl (Findlib.ocaml_ldconf())) + | _ -> + assert false + ;; +@@ -2481,7 +2601,7 @@ + + let ocamlcall pkg cmd = + let dir = package_directory pkg in +- let path = Filename.concat dir cmd in ++ let path = rewrite_cmd (Filename.concat dir cmd) in + begin + try Unix.access path [ Unix.X_OK ] + with +@@ -2647,6 +2767,10 @@ + | Sys_error f -> + prerr_endline ("ocamlfind: " ^ f); + exit 2 ++ | Unix.Unix_error (e, fn, f) -> ++ prerr_endline ("ocamlfind: " ^ fn ^ " " ^ f ++ ^ ": " ^ Unix.error_message e); ++ exit 2 + | Findlib.No_such_package(pkg,info) -> + prerr_endline ("ocamlfind: Package `" ^ pkg ^ "' not found" ^ + (if info <> "" then " - " ^ info else "")); +--- ./src/findlib/Makefile ++++ ./src/findlib/Makefile +@@ -90,6 +90,7 @@ + cat findlib_config.mlp | \ + $(SH) $(TOP)/tools/patch '@CONFIGFILE@' '$(OCAMLFIND_CONF)' | \ + $(SH) $(TOP)/tools/patch '@STDLIB@' '$(OCAML_CORE_STDLIB)' | \ ++ $(SH) $(TOP)/tools/patch '@EXEC_SUFFIX@' '$(EXEC_SUFFIX)' | \ + sed -e 's;@AUTOLINK@;$(OCAML_AUTOLINK);g' \ + -e 's;@SYSTEM@;$(SYSTEM);g' \ + >findlib_config.ml diff --git a/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json b/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json new file mode 100644 index 000000000..9314f8708 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json @@ -0,0 +1,61 @@ +{ + "build": [ + [ + "bash", + "-c", + "#{os == 'windows' ? 'patch -p1 < findlib-1.8.1.patch' : 'true'}" + ], + [ + "./configure", + "-bindir", + "#{self.bin}", + "-sitelib", + "#{self.lib}", + "-mandir", + "#{self.man}", + "-config", + "#{self.lib}/findlib.conf", + "-no-custom", + "-no-topfind" + ], + [ + "make", + "all" + ], + [ + "make", + "opt" + ] + ], + "install": [ + [ + "make", + "install" + ], + [ + "install", + "-m", + "0755", + "ocaml-stub", + "#{self.bin}/ocaml" + ], + [ + "mkdir", + "-p", + "#{self.toplevel}" + ], + [ + "install", + "-m", + "0644", + "src/findlib/topfind", + "#{self.toplevel}/topfind" + ] + ], + "exportedEnv": { + "OCAML_TOPLEVEL_PATH": { + "val": "#{self.toplevel}", + "scope": "global" + } + } +} diff --git a/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch new file mode 100644 index 000000000..3e3ee5a24 --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch @@ -0,0 +1,471 @@ +--- ./Makefile ++++ ./Makefile +@@ -57,16 +57,16 @@ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ +- echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ ++ echo 'ocamlc="ocamlc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamlopt; then \ +- echo 'ocamlopt="ocamlopt.opt"' >>findlib.conf; \ ++ echo 'ocamlopt="ocamlopt.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldep; then \ +- echo 'ocamldep="ocamldep.opt"' >>findlib.conf; \ ++ echo 'ocamldep="ocamldep.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldoc; then \ +- echo 'ocamldoc="ocamldoc.opt"' >>findlib.conf; \ ++ echo 'ocamldoc="ocamldoc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + + .PHONY: install-doc +--- ./src/findlib/findlib_config.mlp ++++ ./src/findlib/findlib_config.mlp +@@ -24,3 +24,5 @@ + | "MacOS" -> "" (* don't know *) + | _ -> failwith "Unknown Sys.os_type" + ;; ++ ++let exec_suffix = "@EXEC_SUFFIX@";; +--- ./src/findlib/findlib.ml ++++ ./src/findlib/findlib.ml +@@ -28,15 +28,20 @@ + let conf_ldconf = ref "";; + let conf_ignore_dups_in = ref ([] : string list);; + +-let ocamlc_default = "ocamlc";; +-let ocamlopt_default = "ocamlopt";; +-let ocamlcp_default = "ocamlcp";; +-let ocamloptp_default = "ocamloptp";; +-let ocamlmklib_default = "ocamlmklib";; +-let ocamlmktop_default = "ocamlmktop";; +-let ocamldep_default = "ocamldep";; +-let ocamlbrowser_default = "ocamlbrowser";; +-let ocamldoc_default = "ocamldoc";; ++let add_exec str = ++ match Findlib_config.exec_suffix with ++ | "" -> str ++ | a -> str ^ a ;; ++let ocamlc_default = add_exec "ocamlc";; ++let ocamlopt_default = add_exec "ocamlopt";; ++let ocamlcp_default = add_exec "ocamlcp";; ++let ocamloptp_default = add_exec "ocamloptp";; ++let ocamlmklib_default = add_exec "ocamlmklib";; ++let ocamlmktop_default = add_exec "ocamlmktop";; ++let ocamldep_default = add_exec "ocamldep";; ++let ocamlbrowser_default = add_exec "ocamlbrowser";; ++let ocamldoc_default = add_exec "ocamldoc";; ++ + + + let init_manually +--- ./src/findlib/fl_package_base.ml ++++ ./src/findlib/fl_package_base.ml +@@ -133,7 +133,15 @@ + List.find (fun def -> def.def_var = "exists_if") p.package_defs in + let files = Fl_split.in_words def.def_value in + List.exists +- (fun file -> Sys.file_exists (Filename.concat d' file)) ++ (fun file -> ++ let fln = Filename.concat d' file in ++ let e = Sys.file_exists fln in ++ (* necessary for ppx executables *) ++ if e || Sys.os_type <> "Win32" || Filename.check_suffix fln ".exe" then ++ e ++ else ++ Sys.file_exists (fln ^ ".exe") ++ ) + files + with Not_found -> true in + +--- ./src/findlib/fl_split.ml ++++ ./src/findlib/fl_split.ml +@@ -126,10 +126,17 @@ + | '/' | '\\' -> true + | _ -> false in + let norm_dir_win() = +- if l >= 1 && s.[0] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[0]; +- if l >= 2 && s.[1] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[1]; ++ if l >= 1 then ( ++ if s.[0] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[0] ; ++ if l >= 2 then ++ if s.[1] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[1]; ++ ); + for k = 2 to l - 1 do + let c = s.[k] in + if is_slash c then ( +--- ./src/findlib/frontend.ml ++++ ./src/findlib/frontend.ml +@@ -31,10 +31,18 @@ + else + Sys_error (arg ^ ": " ^ Unix.error_message code) + ++let is_win = Sys.os_type = "Win32" ++ ++let () = ++ match Findlib_config.system with ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> ++ (try set_binary_mode_out stdout true with _ -> ()); ++ (try set_binary_mode_out stderr true with _ -> ()); ++ | _ -> () + + let slashify s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> + let b = Buffer.create 80 in + String.iter + (function +@@ -49,7 +57,7 @@ + + let out_path ?(prefix="") s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "mingw64" | "cygwin" -> + let u = slashify s in + prefix ^ + (if String.contains u ' ' then +@@ -273,11 +281,9 @@ + + + let identify_dir d = +- match Sys.os_type with +- | "Win32" -> +- failwith "identify_dir" (* not available *) +- | _ -> +- let s = Unix.stat d in ++ if is_win then ++ failwith "identify_dir"; (* not available *) ++ let s = Unix.stat d in + (s.Unix.st_dev, s.Unix.st_ino) + ;; + +@@ -459,6 +465,96 @@ + ) + packages + ++let rewrite_cmd s = ++ if s = "" || not is_win then ++ s ++ else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_cmd s = ++ if s = "" || not is_win then s else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_pp cmd = ++ if not is_win then cmd else ++ let module T = struct exception Keep end in ++ let is_whitespace = function ++ | ' ' | '\011' | '\012' | '\n' | '\r' | '\t' -> true ++ | _ -> false in ++ (* characters that triggers special behaviour (cmd.exe, not unix shell) *) ++ let is_unsafe_char = function ++ | '(' | ')' | '%' | '!' | '^' | '<' | '>' | '&' -> true ++ | _ -> false in ++ let len = String.length cmd in ++ let buf = Buffer.create (len + 4) in ++ let buf_cmd = Buffer.create len in ++ let rec iter_ws i = ++ if i >= len then () else ++ let cur = cmd.[i] in ++ if is_whitespace cur then ( ++ Buffer.add_char buf cur; ++ iter_ws (succ i) ++ ) ++ else ++ iter_cmd i ++ and iter_cmd i = ++ if i >= len then add_buf_cmd () else ++ let cur = cmd.[i] in ++ if is_unsafe_char cur || cur = '"' || cur = '\'' then ++ raise T.Keep; ++ if is_whitespace cur then ( ++ add_buf_cmd (); ++ Buffer.add_substring buf cmd i (len - i) ++ ) ++ else ( ++ Buffer.add_char buf_cmd cur; ++ iter_cmd (succ i) ++ ) ++ and add_buf_cmd () = ++ if Buffer.length buf_cmd > 0 then ++ Buffer.add_string buf (rewrite_cmd (Buffer.contents buf_cmd)) ++ in ++ try ++ iter_ws 0; ++ Buffer.contents buf ++ with ++ | T.Keep -> cmd + + let process_pp_spec syntax_preds packages pp_opts = + (* Returns: pp_command *) +@@ -549,7 +645,7 @@ + None -> [] + | Some cmd -> + ["-pp"; +- cmd ^ " " ^ ++ (rewrite_cmd cmd) ^ " " ^ + String.concat " " (List.map Filename.quote pp_i_options) ^ " " ^ + String.concat " " (List.map Filename.quote pp_archives) ^ " " ^ + String.concat " " (List.map Filename.quote pp_opts)] +@@ -625,9 +721,11 @@ + in + try + let preprocessor = ++ rewrite_cmd ( + resolve_path + ~base ~explicit:true +- (package_property predicates pname "ppx") in ++ (package_property predicates pname "ppx") ) ++ in + ["-ppx"; String.concat " " (preprocessor :: options)] + with Not_found -> [] + ) +@@ -895,6 +993,14 @@ + switch (e.g. -L instead of -L ) + *) + ++(* We may need to remove files on which we do not have complete control. ++ On Windows, removing a read-only file fails so try to change the ++ mode of the file first. *) ++let remove_file fname = ++ try Sys.remove fname ++ with Sys_error _ when is_win -> ++ (try Unix.chmod fname 0o666 with Unix.Unix_error _ -> ()); ++ Sys.remove fname + + let ocamlc which () = + +@@ -1022,9 +1128,12 @@ + + "-intf", + Arg.String (fun s -> pass_files := !pass_files @ [ Intf(slashify s) ]); +- ++ + "-pp", +- Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" s); ++ Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" (rewrite_pp s)); ++ ++ "-ppx", ++ Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); + + "-thread", + Arg.Unit (fun _ -> threads := threads_default); +@@ -1237,7 +1346,7 @@ + with + any -> + close_out initl; +- Sys.remove initl_file_name; ++ remove_file initl_file_name; + raise any + end; + +@@ -1245,9 +1354,9 @@ + at_exit + (fun () -> + let tr f x = try f x with _ -> () in +- tr Sys.remove initl_file_name; +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmi"); +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmo"); ++ tr remove_file initl_file_name; ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmi"); ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmo"); + ); + + let exclude_list = [ stdlibdir; threads_dir; vmthreads_dir ] in +@@ -1493,7 +1602,9 @@ + [ "-v", Arg.Unit (fun () -> verbose := Verbose); + "-pp", Arg.String (fun s -> + pp_specified := true; +- options := !options @ ["-pp"; s]); ++ options := !options @ ["-pp"; rewrite_pp s]); ++ "-ppx", Arg.String (fun s -> ++ options := !options @ ["-ppx"; rewrite_pp s]); + ] + ) + ) +@@ -1672,7 +1783,9 @@ + Arg.String (fun s -> add_spec_fn "-I" (slashify (resolve_path s))); + + "-pp", Arg.String (fun s -> pp_specified := true; +- add_spec_fn "-pp" s); ++ add_spec_fn "-pp" (rewrite_pp s)); ++ "-ppx", Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); ++ + ] + ) + ) +@@ -1830,7 +1943,10 @@ + output_string ch_out append; + close_out ch_out; + close_in ch_in; +- Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime; ++ (try Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime ++ with Unix.Unix_error(e,_,_) -> ++ prerr_endline("Warning: setting utimes for " ^ outpath ++ ^ ": " ^ Unix.error_message e)); + + prerr_endline("Installed " ^ outpath); + with +@@ -1882,6 +1998,8 @@ + Unix.openfile (Filename.concat dir owner_file) [Unix.O_RDONLY] 0 in + let f = + Unix.in_channel_of_descr fd in ++ if is_win then ++ set_binary_mode_in f false; + try + let line = input_line f in + let is_my_file = (line = pkg) in +@@ -2208,7 +2326,7 @@ + let lines = read_ldconf !ldconf in + let dlldir_norm = Fl_split.norm_dir dlldir in + let dlldir_norm_lc = string_lowercase_ascii dlldir_norm in +- let ci_filesys = (Sys.os_type = "Win32") in ++ let ci_filesys = is_win in + let check_dir d = + let d' = Fl_split.norm_dir d in + (d' = dlldir_norm) || +@@ -2356,7 +2474,7 @@ + List.iter + (fun file -> + let absfile = Filename.concat dlldir file in +- Sys.remove absfile; ++ remove_file absfile; + prerr_endline ("Removed " ^ absfile) + ) + dll_files +@@ -2365,7 +2483,7 @@ + (* Remove the files from the package directory: *) + if Sys.file_exists pkgdir then begin + let files = Sys.readdir pkgdir in +- Array.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files; ++ Array.iter (fun f -> remove_file (Filename.concat pkgdir f)) files; + Unix.rmdir pkgdir; + prerr_endline ("Removed " ^ pkgdir) + end +@@ -2415,7 +2533,9 @@ + + + let print_configuration() = ++ let sl = slashify in + let dir s = ++ let s = sl s in + if Sys.file_exists s then + s + else +@@ -2453,27 +2573,27 @@ + if md = "" then "the corresponding package directories" else dir md + ); + Printf.printf "The standard library is assumed to reside in:\n %s\n" +- (Findlib.ocaml_stdlib()); ++ (sl (Findlib.ocaml_stdlib())); + Printf.printf "The ld.conf file can be found here:\n %s\n" +- (Findlib.ocaml_ldconf()); ++ (sl (Findlib.ocaml_ldconf())); + flush stdout + | Some "conf" -> +- print_endline (Findlib.config_file()) ++ print_endline (sl (Findlib.config_file())) + | Some "path" -> +- List.iter print_endline (Findlib.search_path()) ++ List.iter ( fun x -> print_endline (sl x)) (Findlib.search_path()) + | Some "destdir" -> +- print_endline (Findlib.default_location()) ++ print_endline ( sl (Findlib.default_location())) + | Some "metadir" -> +- print_endline (Findlib.meta_directory()) ++ print_endline ( sl (Findlib.meta_directory())) + | Some "metapath" -> + let mdir = Findlib.meta_directory() in + let ddir = Findlib.default_location() in +- print_endline +- (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META") ++ print_endline ( sl ++ (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META")) + | Some "stdlib" -> +- print_endline (Findlib.ocaml_stdlib()) ++ print_endline ( sl (Findlib.ocaml_stdlib())) + | Some "ldconf" -> +- print_endline (Findlib.ocaml_ldconf()) ++ print_endline ( sl (Findlib.ocaml_ldconf())) + | _ -> + assert false + ;; +@@ -2481,7 +2601,7 @@ + + let ocamlcall pkg cmd = + let dir = package_directory pkg in +- let path = Filename.concat dir cmd in ++ let path = rewrite_cmd (Filename.concat dir cmd) in + begin + try Unix.access path [ Unix.X_OK ] + with +@@ -2647,6 +2767,10 @@ + | Sys_error f -> + prerr_endline ("ocamlfind: " ^ f); + exit 2 ++ | Unix.Unix_error (e, fn, f) -> ++ prerr_endline ("ocamlfind: " ^ fn ^ " " ^ f ++ ^ ": " ^ Unix.error_message e); ++ exit 2 + | Findlib.No_such_package(pkg,info) -> + prerr_endline ("ocamlfind: Package `" ^ pkg ^ "' not found" ^ + (if info <> "" then " - " ^ info else "")); +--- ./src/findlib/Makefile ++++ ./src/findlib/Makefile +@@ -90,6 +90,7 @@ + cat findlib_config.mlp | \ + $(SH) $(TOP)/tools/patch '@CONFIGFILE@' '$(OCAMLFIND_CONF)' | \ + $(SH) $(TOP)/tools/patch '@STDLIB@' '$(OCAML_CORE_STDLIB)' | \ ++ $(SH) $(TOP)/tools/patch '@EXEC_SUFFIX@' '$(EXEC_SUFFIX)' | \ + sed -e 's;@AUTOLINK@;$(OCAML_AUTOLINK);g' \ + -e 's;@SYSTEM@;$(SYSTEM);g' \ + >findlib_config.ml diff --git a/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh b/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh new file mode 100644 index 000000000..c923ef49e --- /dev/null +++ b/reason.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh @@ -0,0 +1,14 @@ +OCAML_SECONDARY_COMPILER=$1 + +cat >ocaml-secondary-compiler.conf <META <= 20170418.0.0", "@opam/merlin-extend": " >= 0.3", "@opam/result": "*", - "@opam/ocaml-migrate-parsetree": " < 2.0.0", + "@opam/ppx_derivers": "< 2.0.0", "@opam/dune": "*" }, "devDependencies": { diff --git a/src/ocaml-migrate-parsetree-v1.7.3-old/ocaml-migrate-parsetree-v1.7.3.tbz b/src/ocaml-migrate-parsetree-v1.7.3-old/ocaml-migrate-parsetree-v1.7.3.tbz new file mode 100644 index 0000000000000000000000000000000000000000..46fd48653180484072898f408e910ec4b8edf439 GIT binary patch literal 166267 zcmV)uK$gEkT4*^jL0KkKS+eEqlm!EWfA|0Y|Nnpg|NsC0|NsC0|NjvqfB?QV2qX{z zPyzr5VW&L%qwC)HP3xU92DPi*YuA7bp4jl1LDQ!4-ov;C;b2b6!U5XNXi~a$-P#MA zsv?%?B#PK5IP}F2LTtlXz0QVIcK~5@02gmwt~YjjF|2eQcXpgr*`k+Y%pgaY&lh^y z0Cd1!-N3*uI~%*4ga*_Fw7M;t9d6dKN}vcYXmh#M8W`=-*zbGE>ueAkRxI5+)}B~N zbk5UsS7-+F)L05n0s$D50sRyB?A~dN91p*5ExmY}mrxoCV^*5W6b&;C5ko zdM`1hOWSWAs{o7Fy4V1x5sI+0tZY5Nz>s&RjuLjwIkyvyvcxNU9D`&41XWv-_jicX z&NZgq&aTNk2W)AZ4|a~#t6NMlw`C4#tQIMZEwy-DhP0*H zwOX}H*W->O`(Y0i>^~&j?NKI;>J+dy@t1QWT z&wG02?9y*rrk$5=NiuDXn94vl+SEM?RwN(_mDpqmHq?-`(yeNoYkKv2>B{OSyQ8++ zXokUN%zSS4Z%9x|+7m*vRj_+HhYXi)r0lB$SU9|CX5DqLJzaH+1ke$CYEKgp=}kz)$wJL^ zH)(^4C?yc0x4pgObGLI7v8%TtkuqbL8MT!6x0L~=hHXlo%QDMy$N;WH47S!`n_7yY zRHp3U01L9i6x$0-t+Z%v0A%JQI+3sjf*hGrdftSQ06;)YfK3_zhNcmSGys}ul<_7> z=+xPwOqsPto~NdW+JFE60U`uJ2!Mf9{Ay~SnuQHCG#f zX+2DjDe7boQKLqWC;$Ke0000AQX&ut0RSc-n3^&H4K&k9>7oK@nx}<7DXE%iskW0u zdY+TiXaS&T0ROE2N_|)Lm4D~{2hYL9{~qWc-T#=_=lj1>A)oH}XbDPZ=XH)B zLUIo6H87`)49Hm{Dg`qHOEM}$DvXtAVw7Qml?hTfz*>kdss2xG#VH%Wjf)87XxEMD!}Z}(!&QW zEd~r2G&(dk7%?%61{lQG3qx!iG`JfYV9?Oe(9qKu7j0In73aaFV{+lOrH?VkZMa?8 z&3W{#*CB(T|Ga6e*zX*TS5ZbYLFi(zB*dCfiXiES2lSDDF&&Gr>^^?oU2C|FSFg@) z7o}hsmH&1w_bvuXoexpyG9gZ*J11$~tDt|VIyAVhMuhA&H(XsgFbpiG^`MStM;eB8a3ZD6#R|2zk=G zB~zX+9e4XV`JIOq{4t^5ix!8!p6}{RZ(2GxvS~PJNNF^^{|n=%xab`Nni`(b$1zES z>@mY^ZOa@QS1dI0a?@wAX``!78)~%b>f20{hDpP1uBHZu3$trQ-f25A(WgenF>>2W z4ZmBLLzB7G(be4Swqe7oW|vb=OfbW%hk~@k>z4z!ss5H%3%T^ajic1-Un=VPnCR&J zuB|bH8fkvkJ2AGJbz}H)csQ|lFZmz*>dJpAVsZZx_33n94|3h`>)G7E#bI5CZw%Rt z2|3e+qu{hR%eiB1I9@Bkd<(^N4p!EeLr%7JT&_#1;c&5Y-bsteboj3l@af;z-}4L} zBaH?$&~htxTGBd8v}Hydm|<3A)gCJ5t}59u#JVyy7z|5wVWe;wDA?U-nOQ>xy;kvC zR#M?*a2XSN$R?!RBUoD%S>O%`T?J@g>X(Jkuoh`#Ybg0lj;o5Dt%%k}7=8-LHB49j z&hk6XP}Z-g?{4nBSN1Cr={`MV{G{o z;+raBB>m!Z5{V18Sy@FxR1V3jZl)rJd!+H(cPeay76Mcl*8u3+63rt?TH7}iN`~TD zCeMJxVIhPig%&U*;52JZLL*X9TbpBoBcXHxUwDpKcJ5pi=5ol6#z=P-F3XBt!(+g7 z9z*FLi0~YagR!CITE2?l@{Ua!G-$&NJR7Z>jTm!m(X(cwaqxDSa$;RLk26P8lOrPy z#v3v);L+g2qa)12%)`jTJ62d|>|wgREsa*Z8WzR_20-GqS{4iz3?_$s%yb+sn90a3 z462q469xkYAy_b2FjEGGhK32`Fd7&-SukK|U|{bW?X%0o&me&wcCw8(TzTe`FPgDPR_40kl6jF{Vz|AdOKF$hf>26-RnKisnN4PI{&qF zUr(ir{u99hr})lE(;PsdsPhDlkGcl`qHPZI;g#@Q;ClXT(Xi0gs>zEnV^XxW^85Xs zpSQEZe0}Z*uDizSz`>aIOX9G;M6oPF(6qOgJLv-z@@F5tX5db8%)L@e)Oig|5 z>+Rt9_j|jCQSWq=Xg7&#+tNI)O<{&su&ax%D(~sd4ssK}mFjAq1Q7ucL<~eh5fKnX zFhLNJ1Va!J9&-!`g9ySf!vY|PA`a3pgNVXB-xiug5eX1P9R$M%3@{b~*H{7_o;fG`3icELgO* zu(n3aWyx?{E*2v~(&28L7Ym}=^Dc)aB4U_ z8jrBZ(TS6FTyJ&03(K3u^StN{0(J~CsSF_qGQtqiOs{=qby(5ue}vQXUs~Zl#vLDv z)cN1B{uqF!yg@j>XSXho0i%7+S($Q%IFoX=N3G@el^4o!m_?) z;Ama-KBH37PBGt{q{AjeH6heX#6eM4Xmm#EtXSm3`A~)sG%&*R=UCkN-Q?8qpF2$% z*T^_qX9wdH2liEjs5}i*NprVGTpdczJRG6lMiV7<%j>5?(XeliLej}dK zwC)3xPr4U*F9-aB5PYf9JyDgF^tZb~_!o}EFu(54>mMyMUP79T?()F%Zmdh!NqSD&h^3v+Mu2z>Lg{7o* zEE7WE9hT9eJj=MZMl4%eT&;^1BWr6xwp&~lmu0fia=R{w*S}79Q&Nwq@C;=ASUyM5`df?a`D_tR&fEdWS7b6v*kGow{BU!4 zTn@gPTuUYLrb^XfFSVUwU1Ii{xp`>A?=(H86Uf2M&&$=Ed^4NRj+^$bSJ=E3i}o%T z*4|oNEv^o9#w^DmKfQu!_yD`NK-k$t7WT3&@~jlNYSLt*(aqACZSQ-8@e7yl%uc zvla|8rVLZ)@LdkJBP_DYKQi#2RxY#Wa{HHeoiSqJ`X0r#;_@1wg<*9r$C0VIx#QUL zt|v1ltM52CxTlM}(%{E8)#Arylgf5sTo$zF)oWZ`oeo#du05gnXka`b{RncCw}K$G--wI{I(rcH0J& zT%P*9YiGhcFBh7@O8}K<5N>G z{0Z~zE5028MM4FG5r@IER$k@Huh4fXbEx9(nsc1ljMNaU11 z@q5kQvU2d<#*s1sBryO#!p9E>I{KHj@xf&XVMW!@&Xlp8 z3~M!DD8sEhX}m^unvd&E<1s!~x~yHkwme9sfT}Q}!qJhU=HPV-vw$W{E98rDh8LRI z-Px~#N>aQnl;5lLm>fWQJssSC&E>}UbrmuJl1%ti2;L&QdV?pqiLaH%|RTm?H>mRkYEL2DD*6K?PgP)-zPnY14G3Q> zp&y<2TAix>W~z4|RAG^z2i2^rD)4^z{LNLU($_U9J)`+YnAnr<|Hsu^RUHNh_l$(^ z9wS2cj6()czg_dSKa#5=c0DT9MThG=8Z>Cy3ci(U(X&VOezRuH?BJKJUn;dn%;_%% zjU}UXU*S4F%C)bsaZ{?l>J3$OS6J0$WRD?|utWcpfB@L`fx9 z59WG->jd6TNhO*8d~HvtWR7Qi&};K*dn0n6jPxJKKagJ61L8i>gVFb~V(_Ea)630X zNZhAC!Yw`5pTXIt>pN7_vT|qTs^A z5WuDcCVNvqa1Hn#?mcgNp8w)*w^>JCEyy0L(Mw z21$MS+w5f+!7Ovylxa7|-U9?7K!_el#@9>DLk1FN2+Z>#Oh=Jj>LTm~zt95L@@QH0 z+%`Z4kb^TeR>6}nZR6qvi!d9&@}9BB6N$u~2YGbMr>0Ai&1~xzN!}ZonV*uNm}BlE z#18@Uhtxk`r+3C4`um5>J);Jy*Roct)H1Mp#s@Q1 zv9pQKP7QXR#!a1!zbh*7SL>_i7%*&F8W=gR3hX%?4hA+bbR7oAS9s9iay05NXml~9 zV9;a0V8Mfg;T#TwL$rH%b8ogD(b~}P*uQZ4x%0_~f1&(8ufD&NRcrR9Yu;bP^;PFb zv8eb>#-pjsXvp-OSy`9DTvs*Oy+Duy0k>R*Z&7)GR0acR8?ZWtCJbWJO)$f?VyUTG ztqC4O5LhyXO(Z-{hp{TW)k&&sdW-}>Lp=^rzL>o&dPXM<~Td+Xw-0M@N!)kbZp?4WV?E5oFpZ*OTbYf zj8Kau6j>;xUnd9Z1E>Lld4Jyhmvi9xnlyRqCQphsecIx#=aKFnjz{lTMT+hFdxP3A zU7eW6sKdj%&sjUwj-!YJ*fTXG3h!y&DEJQVOOlNd7ap6`xBbdSYjL*98s$AT*s+& zuj^N~wI?Y$dc))}J~iz3cb?PN^s3jzR(TolW=ErSa{V6q?emXw#Jx@q=8mtsUYvS9 z_8N?*_GfJa!&d0TS)$yHq<0rCd-1vz%t9F)WhVr8GO$Vp$k{f0bR% zV>+Yl*HMXaACbwGYCfS!Dx}FMB|#g&-Upx$x8ZzlECAVYgu?nO#=cek6_xF+a=3jA zH2wg4P8G4&-aK1m$>S!qrFhrm6Kkl)Llze%hA&{67ej-KI_mJOR^E%1ZCqBQ=o^z8 zW0ox~i=(rKmX|J2;cd593xsg4p_R)_ELe@Xu5_+WrWO}3n-(sEk;1rW(@i=%8f;?A zg_c@eE)$Du76v;s;kC83wSz?4j=L?bEv*f!r8zrSEiq!`X{Ib%qlR%dVcIz`=-}xt zO`I^%hDMAwG#MK;7--qEN7{01q8w=QCy*c ziS7Om^!UR2T&j%P;p=D0?;~;5i1XKOomL!vFmkC8_A*IFl>0( zHZ~pum4ivhhw83I$6(}W}8YLCF2Xk)h~3hltSgmwC{>v87tW+Ivhi zj=|x=fOVCcfM`PpfjFQh7iUi>i@zhiVjV^uXL1pP0$dnM?2=X)@2| zgVgpYcrUc6d)CcAM4|9~s>Z*U?R~9)djLPm(;TV}>341PAGU$OcK z4U@3NTbu6~jK=6-Yd>t|IOk?-jcv=Lrl%#%F>88rC+i?yJ(djypnp>Q0T4KYT0R&ormidr0y2$ioyJ&k)eY6 z#oQ08+oka<=6MfNuy`xHJnPrd?5=J{e7lPWV0_>{qB<5yCJvoTrWQl&4ixcSUlYHI z&iOOrT?5oEgU#h#72d52zC8~^weFT5QNg1|s`EHBXxwf+quP%Ybsp6;tFEu#Yq_|| zl;Uc4r)bv~8q3Z%9UMlZMxxSTGUq9|6$y%xp-{!iu9_MhC0QFd)M)7Etj%k-P0X9r z$*IhCG;tjoIXhgPM<)@pM&k{o&1Y=aIjOmmR_AM@jE;>)qo~=lU23&8G^Y{Kqo~rI zj6beu{wGF{1Du&W9;YM4<%Uc-?bVvMjNJ{<(cohN;CLJz9UU9K87Z5qSvXtCle~6I zwb;#@JjSrai=I{4Tn#Q)KBmsb7;-RZhy;5d0|dP#oHS|$uBR&G8)q`)D9Ehbr;+G5 zJP$$ObwU_md=8Dk@wI~FxmuesbzDs>ShliTk zGUpnT0!H0}L?34?)0m zVbRfL{ZYyE>X&1awRkQt!zrvXWa`1qT-DsshWg2qrm4I#JQ#3ZtI5_PF1&8Y!vh1z z;Nb8)4y~+QD^=XCmFHc04n{GC7-7FN*jQd?i0|HJS(V;5yDeSK#^cI3jYqs}-E%Ii ztDg5A>1^JPll0c*+{2@&?p4v^HylTJno}YrI|*cavH~Vw@RJk^`wRt^TBy-~#G5?q zO2UE5RcfRq9?Ce8qF^Xdg7>^!BNB zlI(>1z5HTA4oQv7N<+*T@=j9CpPSE|W#KRD!?EXS6zpRp9u^mL1Xd5k9iG1^ACJ%k zz>tej4xl(CB)XF7N!90BU(!221{lKmjuo@^mD0b&KfpT=5uoxLe|d`++gJCGtl)4k zXnC*bcvrFH;4o}nV;gDkewz9Rv=##yV?H23vI`*mxLn#$XlNLk`m%t7p^^CD7zZhg z=#fCl2aqnofnTKQLV)1neq2h2A%l^bKg^)aoFK;rb~5=Jc!PI99-u2upfv-L5Exse z2!M~b{oAnY=I5J%W)WhEZJ*icC^0b|sXz_jFcYAhJvthVI<9t)>e`0uxo{s5i-023Dq4nuaqd6iNgot7fWFJYVKut3aMMHy52&^I_060VLDV}(J!^rmxJ|hkc zJPa_ygA6b{4g-V0!{#hnShTRXSX?X@D+_BE3ktS{Ax^!o9N(UFbe|p zs^uNh!?~(GjD{UtU(|e8y=s?<3^~Y0z{SFgYI9D*J@-*L11SePhbKE5TV< zt}DQL#MOAe*&7^Q0r;!Bz1j~jzQDogE2pXC9o}BlXllI=b5e00KH7K3uBUq{=_g|E z9JPK&uzKs~t%vystaTrVyQ`&l*Pp-iYwjEmTsn-C2e@?$=0$95b6&H@IY7S0XPZql z_OF8ZE+n>BRd74Fc=!&LIUOtPSC>I`sPyyW_x};ad~2G!tH@r0*xSr_4*s0n56n6} zJiX(n#i@)|mP)WS$nzU%h(T1Z8Iyg5R7-7XUVTNjIHAak$86O9k zv-6I|qoWe)GBPqS!wSkWG-PPRvRbckJxJwAsVcqxhkVbu3^ezWwY{A2YW6Qujkk@cQ5dq=6)vC(9HF|T6v#qM2R!`!}rA%>zm zIo_+m-z+q@SQ{IN?dvLZ?yTj_ah21D1!a7zZ+SW=L9U0&s{6-b_*Y)a!O?@(KdfXQ z@Q#fG=O1A43HGc>+DuBm9{TaFQEwFOsjA|*tsv!JrG2Z>Y>s=1ihg(>z_ChKy0IsS zJnO+pYI>M_=iwYei)ZRE;KN25I5v8m8Z=^D9GGx;Fyz_E(X&Se92j(b92^=rIy7iu znlR|~I$Jt3lZe^T!O@Z2!$*Tu=-I)ulMar?q5cCc#wTM9osAW6VdQ>`^la{Qbw?j)<;j`K&#Hy*RR$%}-Wq~g57VEvx_Pgb>gZ%oVO`!95l zNzjKv{PGXQ`YHXN0q%=CeBYW=|5vwvUpBG00Kxy)`#SnPem_wDMdwMgZ$E&oVEUwA zR|1SQ=4;k2zan$(rP~?XUj!2-P-(I9!@;YBJg3>cz_S1q6!@8Zl(HU!FZfrr!lqT>GuDh)%m&o>$h8PvYvbQ=k4(i?Hz~T zv896p)*MKE&-mD}a6e!$z16o2Sh|i-iXk6=-R0VQk6+O3P!>Ue870&PC`MepdVJJ8 z7=JBY&!OmLSZLi_9(<+IhrC~b`r%1dC>?tMA8)qq16QyM=dmq?+U`F-$8I)Fm)I<4hOJoXnV)@k7&F{aL|1HK)Rpw@$HMO41iPv04f0# zB3%G*#VmlRScDlWCDyu9>LJt5&+T5XOg1j&s3cuo5Fiocmtn5m;I;vRbNIAD8bbj=pKxbxT48yV=+23~n4=#D*Tw(U4t(|{_6}na5fXlIJHXes!OU<W z9Y?TtjSY+#FktQq4)!((z_yT%SU{U1JlL+R5_d0nv2@qPUR zL4QIXL)}L8W!0CEU&Q7M=kmlJ3VjL)BXdV1?0 zxNfvAlKRPogkZ`8wa}8_6!WAE>3VuSS#2k|oyx$2wB*a=cbCHHPNh^k4>ha90)+c< z=;!44ddKp>X!y(iUVcxD<*kT&*ueZho9cbCd{~p`WS@13_hk>z!{zwsed>5Lmw5e# zjhL2MRbDXGM09dGBDSiqG(Cg%kN1a=?-(48<@AkKha*ASxgUUigYg(JV8OA}c!%g7 zPn+Xs)%JZK-~6A&>t=rJ{%(E#^W1!Xe!NZ-6ZT5`D|?tStR5RrACuqE%zP)u+on2+ zZe$^ZlOQ^fy~0t@)E1Z)BKV9F)7hbHU`$}XwkHM#7*XrO@2>jF@Kf@4$eheFVU)^P zmuZD*Fv5=Egr=F5WQ<_NgY}lQyEv{vXfPnm4mJ#STJ0L`{T?oal|@S zOQ6XeMpQ4ypB`^79F#XA(zC=nu(1S>)*@Q??+Ve~Sb45d6qRnTEz#I!CJl~x#V zXwbtVzcPOeE+cdbAi%tj4$n=y=dLV(uoVGuOS4lL8>m4lQTT@~R`9eq7#J7p55KOf z)#;zcYh$~Onc0TG=N){70FqqNWSu5KjQ}}qH!JJN!Cy+6&T&=wcJXziM`+NTWe8{Q z@BGp-OB+6`Eng6$Cpe5I0gOig#gj_`p~FTlqeAAe|A1_0IS%mi4Tn-SSTq_88V%3L5%Lbf)zY6=djl9p16@*CB*|1jhD+TecP`-h(URJ5 z0|VdS-VF43)w&E<8t`_VpyU_p9~|Xu9<|kYkpDRj z2in>(il4ClVaQJRmS4LX$Bt^P8vYHQ1JF2JuhxC6J%2_R%c%EH>U~wwIbIVh7{*kd z1}!WD24RS;QR295FKFle>Z{8`Lp7fBHI^%J)IQktIr+VsbDsk=drcir1B?%sT%CUp z_675guyr31^u9#-t0VlC;h$A{{Yv;(H`#$E zW1ocnY4zrG09$KoJfjxY%{*-=XFss?tIzZRcY*c5$6RZqVq_X@=T7}~hW0jCdNvzh zI&CY2r_NBl9+1OmAHW1=C;{BU8UkYJ`aW3|ZHspdCUI0zV{##Bj zJB#my0fcIK7YCN>ePBd}8!f^t?7!%p>` zE3S8!tJWOnH5t$C@pHI+&TwH{)cEEkTk9rnC{CZBJojE$ylOV%taA)-1t7{@KN%ch zu-`rNtzOcVJj9u~C&pYo0ko+oO45X&N)l&L!L+`XqfyD==-hc4G;aM*Bq}Y5X$2r|39`6Nc+lNySlz zFl&B2kSfOAU$+78Ojxb}DC1B!p%4L*5a2ivB;m9S4ES)5s0SU{&Euh!405OAv?3j- zMbM0o28MuHp?3lj*V;~nDJ z1KTkrU1^R{l%EO`-JFUDVkt8WR`^I7Ju2;G5R0m-VcZ;gim!f819bJqq>w}fUPZD0*-X>uSL z8*As)^I=Rys7eA7vkKH_5hfB!kQE>YnhqgHlsjPcuBHR?m4tOoz*yL-VL$~P(UyDZ z8{-14AqxwMCKTCvAOU`=B>*}czs_fkZ%8~f_j+hyE?v$i;7PdiT*QiH@0_o{z0BO* zMvfb(3Uq#vDW9rJI6Z*wLvNUUO|dI??`{x{_VNcLNRb=kaAhBuN(ta1#@(~=eL8Gr zeYQ=o@~f}bY}QvfuKFy)lae9S!YhiZ@p&WztM)1b@N<41~%p;rHtq_-euT0Cl62cT1dQl66?Sqdcy-@FHIKN6bIM1^kpQOlBXC2;(FhS zzz3Zp&jLPxFc=yDfV_l~S_A#L^aI%(u_cR{UtLb&!C!T2Lc0};=Cxk&Jjal|I*)j% z{9^}jy+gQl9pU9xL~X+;T=+f_tR1tpUeL`dPxOieOe%taOi z#JbilLO%;2p|q*)Vs+ESfNC>1MgnI8+H6Krg|>1_02oST zn`@=qc8jDG#3Fg(Z-+`!5_%K}cd%kg&^xOyN?9270FHzMCQDtIbv!&$l2yGd?LIK$ zZn{@^k*Zpy0dGPteJ>zntn$j+uG4mx)3`L=;(O5BB8Xmm)y?1%hg@JYi0SR=M%`OlfWjTKaNXEgQ z+aQyC=_cgtAFMi#5^$3hm3A6dA4u%sUr(;QYw52lwl*}cdRxHW1rnGKUpEHO z4&669y}-j}tfM4h8G(Cz>j$MzwOw)a+UI+JR~$W56WiA=p!+;@%`)5L0$F^+mo(pu z^h^@pFeUDgd;{Qp1ZlWn(Ws17rJ}*;H&vmc9@+kwtHaag*Q?*o+>Ko*POdZIBhLwJOLA08&X;%#aspruAEPfi ztsERxUaQOR-i}Wdfcxmk`{oOweH5E<;F4U$n;Bl8R+rFqwVY=5y{ zKK1fl_1-eSNkIm&N_qWeyf>?M!X+U4y$(}*ft}z%_wH3=2Ay!m&>UNiOSn^PQa6V}!-4Nhy(dw?`8y9M)OZJSc6!rcpm#mY9Fwrn!S8pp@p!#P+IceA z`S3mF+(S7GwtkuWVMnSIlAacaD>bsM(>MnVg^iz$OH7K4Y*3 zHj_x|G(Pe+SIGL8Q27`f2YK_b$I=hh{I6QMSU#k}`k3@X0oVfv9EpFbr)Q_0q;N^n z;FmN_4B@w=UyCD)-X2~KOofwbkqU5V8t98@6J2})9ZBP!)6T8R!$$yKH=AcMGICjMMR zV}rdAkIsZj5qj|%%dIWXV}f4eT!!a3g_%@fb8Pdh3ucPZx3f z-2;_%8DO#)EK{iDY^$#d;GM%&p~!oyDlU8${OsbpgO1%79QmSY zS7OO*X=q)BD;pZE4^HV#CZLnw7s>~cR2Fqe!7Qa@o6IQycmrbHC**IV?Z0{YmDV4t zQTmKNJgI(F`+TR%fy9~N!E^P>+HMt z*N@BSeK%Jpndp``M#yh*+k0K7G_Lj_@XP`tRT9H1*G`nSCD9WWcu-0ihkO$Fkh*1^ zN+oD!@i7*1lK~C;aLR?!Ac2S@ujTCCAnobwUGA@spCN%T!whsc2CeCpGfLFXFE+!V z%_+v4cM2k>4&G0cYdb#Jj|uCaNwl*{eoM|&a`$^|+Z7E;(O`ot>A&9U9>V$2?5<`@ zI`+)fdy0m&BcTZ1glUizn{(_*(%;qw)Oo?9;&>e}j}ExPAU4K0`Ho#N))Iv2wZPt# zfOE2dLLFc}HLNSW6PfWz=`WmcIsP8N{Q`7=}`JH`WH9#S@(|PH^DR@7sOe1-0Kf-9neuMi zFBY`e^xJ&!1JnUf3Zx>T54ARLc z{8@KhD5VUOF*sSa3kpSsnCVV<##{m3E$ppD9nIt?&KM;FZLbM#z7~f@Nncwq)8oRIGu}%HGdIj75iSrD z@TB0GCp>~$C9N{ZoQRbj4vi9M*)yYP;(&r6ZhYqFCkbg^D%V=Cto$mEs(6|`mEtD7 zxXa&KD}HB@iHVBnzob8mJ>v(cdyg{n8}{>4W1-BzHBb`JO2S%!0%wi{HfgX}0?39eg$%6P1W z@gF}I&aUy}?e>kVSYh6}})wS3N!+FHx=>n2N%m@(Mje|$|1y3{tIo0y@8 z>bNT065C60nm>sJ*O~k>=I#P#?zwyVp(mk=aX%TAUOp0EaAizAr_N@$W>yt8w`~-+ z^?6Ngg|E-6MGgj;QJyt;6S58T;YjaU)74x}QTB#c%re2Yn0yR$Y|(}e7{;1hIxdC9 zWp1=gRwE2B!-lRh=MEGn8F;s>I84!jB0fz>QG_hjEEA3rtSAyz0hmJcAYVc)xd-0be)c1Qn9~0c< zyu(eKI$T&`*WJgywtc@pLBWHO*4X~R=UOuNS1CG9mysq)0$1ob%|Vw8k2bwiI5lYw z*H30WO$G=)A>hw`m=KF{Ws3p9_%?BVcwzu_rEy>;0wZ|o*oI~5_jd>nV7<7u3ob9E zVi&W)r`xZ{!+lzg|D!%Sg;n_EmutpdqZw*;^)_p^dnfap9<$24=U>oynF%(OjPQkl z9w|^D3G~2*Mk23(^f55J`E**-D!q8uA&d<= zjSp8I{&ktxqP!L0ubrifJH|<&l42Na0z|+dSndeL5*!8`(Xp`F`fC9ACM!dcs?g!B zu(>j&g_;{0E-MvsISngg6@!CA3nj?Huw`sE?!;+ZV`T^u=zRA^6^l+A^@mbhQi@KK zCFV)eaV`f%?TkoctkKrpY-R%(N%|7)1Iu7JfN~P#2WK4@uQ)V-4yFNY6v1~1hL<=y z13xh+ZRmiPZlFBd$jC=3#?uZ7Bo4ZvcC%=b+?Q%pN-?xZM)|S{CBP2jy{Juxo4z_d zlEppiy1MH14zC%HW_$a@c8j5OfTuGYApzPT z8000*ErLw8gDV774uX`8OPcX!_Xh94;2ig@bHj z+sR_YYJKN<#f!{$C!pjtR?fOIFH2E| z&K^l{YcTOyH5{5J#dNMKb=5R98n(rYVbpXSxEPqGtE)*80hdyOfbA!4MPmb`xvVm+ z&W{I1jh#kKxnyYdjd57GtGzs(7_oA5G+@BuX`pZgNVzMb4|=^{wxdrYh$XZ{>Y&%| zb*X7n$$23Tnv@hbGTWd$aFk&`qpcNJsbk-9EDCT-msK97bsC;%)zL6G(G?C%r7|f* zkT?YJu^f?^;?RygTnaH!}paVKo)XElmmR)&KlR(os1 zBG;=o&4n(OAR5wIHCUi!$lDu9k7vxiSY}0qWnd*?KY@l%h%l|t$xR0};IuXmzK?J{ z#)AQe7)%Mo!01WF630`-$wNC>f79uEj}Mp2x1i}*KQ(1}tJZMkrRc{a=&w5LcCJ}6 znLABN?CjLxV#$eQj8oNJE*YIGfzB*e2g6+cexH8$lb!=r(T=QXVKy7@8}$!>{N7{e z{=Xhi74h@o!T26Awx5C3=#NQjx*oaH|l)P z%-vp+eMhm9%DZ|?<36+IdK#_2O*CPK6?~+RgLxbQo!LzwM!g~qpF4_xN}nj6}h`y z_cEf;pPkxPsQWJY!MI^|$j%0?c}-(bC>ZR2V?5)wylU}JpCAVoO{gau#YdxLu-j?E z{UAve4MY&Si-09Dx{keEM?fbIzIPE*(4l*n(9TVH9Www7d-J`UnRr&d{GX=-MTVBI zx8FEJj7>e^rF}tGfQI^~f)9Na0bBu|R~q>Slvn_za++8a6T;bp@o(u~CYrI^eu;BY zCp6dR^5X}J)f`m}Z@{q~o+wI+fmosqhd=%WCIcLn8C%KGcl!5T&Wef*_>>)1P(M7f z*&c*+Z#n6Zpt!&CbX_4NF#RL`;}M0Zvik$qXk9~{iC=eIJ|HR;lHY4YRvF{)Nz-M& z2&r=i{&%6x`t9>crq4iLC`EQmfFxaiEi8U;oSd}{IoH_TPEoe zCOL3!{k$i5^O2b8CTOz0e`#{K&00Bw8heRLt5YHV&UZ%*#TiB4E7hMa*r7^7ULzMV zXe;)K#lNeh@lq=if40X5xGATpVA0iJW54QT|G+6_)_Lo^@xB)0Z@$t`SrTU9w!s*V z&2L}dE!cA=3O`!xt$qwwVG%(!Nl{S6U+F+5I0n%>*hi`ZTcKad z-}D>hgR9bDIbV8A%m=REE(2EXL&FS5$jaDVwCR@FmTzgRe}h&B(|JRDJSn^)SgNDe zuG!Jf92ch`TExQPQ$w9M?dhf5FC)3pi^KihO3q%{?XqnxYTh%*xA*VmtWYC3THECG z>Hr36nQWg<72g$OmEN*M+3C6ue=oW$QIVLNZ~4{=H|1cN6?^h-P3mDkye8Q6p=Mn_ z(u~uO)M_zHr!WYqX&pXRQQs`{gsJNXZ&+ST4WPn>3^8sokQo z*RiGU)!=Ed%ZGcz+CAu)GG>=LI?K?olL@#dvP)}R&|zVX8-VV$-Q~BBdw|j>Yx)XD zxGsgeYdQPDO7~O6Nd4`sZZ2kPYzgB~+GQop9rgfr9ii6@3fw&TbGq5OPgD=am_1A0 zzVMc|;}*H{YZ%ZQ{WVdIi6xq}&`ijQ>mS3s@o|-~i|i~+LcQFRh>qj9I|;U{7<(+A zo?ItQxg_o662xyKnW0;y0@EaW$V%6gPnz^bVU@KT6|sdX*53t*v29wZTn$rej%n%3t*OhmL(!|>__DS z&->15FhQV@lzm`i=rAO(f#hiQK_z0Z)uSl2g9>cHUvOHDR9Ts zLI?1*na$#jL~TT8pK8!l8xkFRrvakISfM{7fuYPAUpI{7P0yP<%Ascc%G;W1~m|^~NsA ztzDSL#`Swt6Rj&#TAhs*(VCY;n8tKf?0Xm#O}wJxy4IY`m~vC-$1b*BskNJl|2#Z> z${sMP@_lw0#vP*@B$!NRsIs-bW`RdKBJb@qUA}+g^3H$~9z)(V{xLDhbHB56IYTQe zwfL|7s(+qe`)Otr(k{yGF)piPc(8ud`vdy07_TxMSH2;pb5f$z{Z^E=LX9u;)DRZ& zt|oj<>{bX}h(?YGs(a~--alBW&nUF=I;K8mI+$%&(Lh#sGNa9_6{(`$osv!alj7!~ z-nitsb{P8xHsXPw*(DZC4Jfpgx#!9uA3;%zh#~juv1!~qtO@z^C7KXTv1`N8v!YOX zD=+!fp=tZ$dUPF=@!LSrYg?s=KX|G)WYPL%eXT!P8P`lLD07=s{Q*#->0%gk=g{6 z&|v}bpg;#9G^wAZLrv$s)E3{8w|m99@0V%xM>WNrmKSIoM0Z*>`nG&Z&)fdEscvjX zzYkx%-A6g+o-we*E#9ubt#5D=rkt)#Q2VXz;I6b3=u74S>lhfWEG8?9zV)|Z=nW|k z7D2DeH9*Dqh|Q7GNq|yS_Y*r~+Z7X~D>{cnm;P{YciQE__wSeE`1n(5aj`gxEu8&) ziF6TlvB1I=kBo|gFSox5zY&6?U`Khi9!@D(dN4tqbq;`KO->CnwUG2H>*K*+72~E@ zUbSN9Ed}4xi8_)W01icoj}8Vl1nKlU7JA@^KiDBN#%g32C+ojyTMW}i#C+XuX#L%? z3r(&1_pJG;#Ax-YsdIvA^Py0SC>pAzLrOmDvUTRYeW>hkRAwek$)?DyX-0@?ljQ*^ zyy3Pd+IrD)pq}>{#aGyRg8K|}981h@v<;I>tMFd#=@~j!edxL~y!y+N7;1phJump8a+Se39 zttN%SWtZ%_)TNX>_u81cal>qyWS2g}1;6$GXGLy05EqL0^$Gb;0)$ z?xm)Hilcw_xHq%~bL|G>C-43K&=2QwPsCkrIY#{R*E`zr7Qgw|X4i8hOg$0VnTK^< z;~zY#`q-{}c{Vf9MoQ#~s1=LXArN{Ay}amAU3jsz;t{UILi8jYGKosfo>sDjEnaNE z$^_fVdnx_;o9*-?YJv_g`rHAo$FF1J0}P>*cahPr6s&k&5-?n5ueDR!8lDZR8OiTZ zm70rY6zsE`Q&PNn$}=}03b{_bez$5E8sgW2B-ySOTk`Q~ zeeB!g5!6(@FIkWNv1PllGX3rq$&rKr)gtQw@lyO&v(ZmLNSCiKMW%%m!i(}yU|Gvw zd^E(x%*=x7d?}Uyz)Zm`FBz#W)^CKKn+EO>ucgdee=uA9zD3HQ{N|@ZQ!RstiPeEdP2_Zrn+4J@SF1XLGy|A0 zvz;|Mq&YQZSo^hQtY7GO^f+;sMR#{xIn^zp=Tph!C8SNeZC_#_x#UHy)h$y(;`5)g@UWRE$G%AqE!76E;op@m68w|Sq9LRu zdm`Aa7g0G4)`$D_CS7VbDB%Xgd@mao3i^&fNuEn*aY@>M5CQ7qfe{p_ms4~MP519i z-VxnlAJ*gmUv!++-w(H`qIw1v7H2V9`Jg-?BB){Yd=Zba6Vi<6+qR*WL8lLAFSTE@)mg>X<^BAvDuTi8}vGeH^ z%CLfHmAkR{dtyDR5v)tCoRe{FZUYPwH)6)L75Wvm1HG47gSSc+ez zHs5_)gZK_(psRT0&s=0uM&@r=Qcy+?@Pii1H8nG6QdVjkd>@Rj2?swC(3wVENvgJU+}_i10QZ1=_ggVF-TNhk4@W}h~9q@v1UKSA~_8NSxCE~TdY zH8$eduFKba%s>p=(-=N!kZjWZ??7+oXJL@Zfn?VsK)V^*BF1IzS=v>$WLcpo?O;7> z+YlD`2+|^_Er&y~cksU_kmpaid4du6$wPdQxwq*Cb-vV84cw6Y_(}cVov~S@0-7f} zDr=B{fOxTL(#wmjJTr@ukb!s)DMO)&wxf!ajOU~MYEkIHV%1G0?Cblahdi{>-yo z5n#|72KGby=9PbVNqmvUN8`XeW*`>Aq+_#u@YkhKOJWR0TlCk1EAOYWKl@=gz67)c zJ^Iz7-=C?tqxDz;WG_}ujk!k-~13}pb7i@IR$dn(nsEaazx$QX(4f+!}}70yI9pJgn61E@R7oV z4A|E^TKeYCClGLO)AZr*)tf?$Hq>vfW~fCSRGI%0<4ysf%Da$R(OutLmAh&i$$8KK z-($qglPcH5*{zp>ifg!sw2!gB%UmEfaS#SG(P!MikCH{W@9qQ0^KZz0ln_3h>BP`! z|H1^kJEz%&2Z%8%NGYO_po;bsKT5@h3_eZHh8>)tioC5TYi|)!qCob<02J(sWVnx} zF}HFLkjt1;-_j2M_Ke-<=!VJ(qi^F!pqq}1c=R?Osf!?0eJ%1~RE&Bd67fcI=Yhg8 z?VuBU0Hxv)knjvpJkV{j`^z6xIF|EsqQz_QhessnGyJ*8m7hh2r(!kaI89O$ulGfH zGvQ^OiLgE=mT@gA3>7Ia4a^nhGojJv1}n*6(LcdE;GrfI-XK@Uu}~8rjD7pIS!) zjQ00)-ZUkDikz|+*0r;x-im+E%^}}HM1r!{A&s1UuA?jimK9vg&mw6=^vHdL5Uh6d z!RTSHKPEH(H~(pDLiRr!bjZaO*%V|e{@WA;K>L5ULQSaA0m$V)pE&+Mi{KY@p~f&e z$p13}#)fq$ArA#<>j)1u!J>!#w<_Y-^r4|2|JSO6^bq)E{PlkmPUveST!o$-OT&fw zl|GX*#U%R|ui5$%T|s(U$X zJ_XE6jxdg3KjJqI=rdn#LPGZz4H>YH0qzI2bD+Cwro+Cv8KirPyelTig%4)gAe_URY_Nl%)W2xKe>#dF>zQx zn^l>%X=AZ^L*flZ{x&bqpy`S|`GSN+Y?&gi#A0Iq%~bvyrtY{))8H+9e1g~B(`00? zZuc1`cj`DJwz#b;*$%`_1573Gum`6uOnC)VPif`iY%5=Mr7^#qdNwKl)%12MdohPW z_L+n*F3zt&%}}vcrOtyuw*R>|a1h5oF4mXWIEOHJNH-CQg(>IgE}4#c@%z`0-@o#h z>nvMN30@`&ty+=Q)joAs@n>kqZ*&!0^OfkQF`cp_i3&!}eY275oz=Q8!>wy-ssR-? zpBrfX*e!D&Qb8v%%WWdhOhz#yMs-e|D$e`Q;q5FN`YZ>cwZNR38Wp(Hz(0@XjMe%` zljF(<0(~LvmFAFp74-)P-QMu|RXfK>1CquhmM32Y6-mt11APw8`4D|m+N6l7MD=s` zd$7`n(%hx?rJ#qA^QU}!793_04$ROYUWd;an3$5>Yi`raO!=3RiGiEF zoNhAJ)wk|#gIjkGg$rwvI0)iC1OvlyswEkcH}R6*GWatS=)%1s!s%9t&kWKZW~G}^ zFg^$4;Ng%hh@t?p6C)Uy5^>Fw4fHX)(NJJs#Nfx%48$cJI&Ve&g? zk?D`n2Vm(|K>u|>_u^FydLwsO7@f(PNDM=cRie}vdE3C<05-kxzbuMwPSoj==mk-q zq6q+z;9hKOY?k};gs<3zyyrsv)D%j*1l^1OsMAHW$0j{<7~r#Ke4di%`Ou-21Ir_K zq{r;jV>46YSpFzt1G1hL!s3Fj5t3Jg(69-EMdMRO<5MGjYV+S5ASaZgO)U!ByO}Cx zs~(OjhwmyCo=6By@s3Qc#Ly;cLF5xgCtANcTiF-5+G;d4a$a1>wK}%2FE4(g!6%?P zG`yYHf*xjlDj4BqxEk?la^W%SbQlq{Vqab4Ow-ABT%LQpXLYq_HU4 zjO00_f5E~eS_HLGNz?x^z--YV|2~~E-1h6&C6~$gxvqhGGl!qq9i0$o=3nK%n%l#EwJyxmBehF^B<4bJ^LGXJ%sjJHk`}_RD##-CWy#?X5Z=ozBsR>( zP}QF~MqfbO!Eh|j)!E*9{(huWpRD5ooLsCO3T{%&{}tKMsecC51lv?3)_HA534TA5 zXfnYgC;y%z&N?==ljRmrtDA5%|8jYC!SIOH5FQUo_#3dYdl#^{@JI8O-q7!u-2`X9e+^sA~UT zzw`T$@y+X2^mD=i0RbvXeKEhMN-f(rF&_AgC+A@$HMAy?wpAw6zHTcFlURj>+vvc zFirB{D?<0Ds}mB6rZ8$xr`0U~TnVPVm`tWM3}Q!W0x81xe@q|daqY$ZL*EvA9o6Xk zU>=dkc5c@@5O#Ez#Pkm#HOevVp1(-hlg<_@$XBAW`#7PrpI|D&Wg*uUKvEE0vR6|a zXJX{_V4^b2-d1U6T_-Dl2$B?j0Lg{>N!lE>qfTEgY}dUOGBF7AK}GS6uXbccrgKs^ zEz-hI2rEe~M0?eJ+>xY;orsbTz|gREhp@KatxQK7OOu_Q3)NSyoAxr<@G_G=5CYQ< zCReSDOyd!x&^BqPbF_c^mv+>e(UV7yGkJ_tT3fuUBQ1;x_MkS2#r8;Rz76t#4qa`y z$VO4}K|*X#2g6VGr=xA~ft4t0f92C}u5L*Z%fQL+%7by_c0x$B4>@-o?vZS3R+Kz5BFFOaSRwk1p6&V<-5W7mk0?zhPwAo_1TQL$v zsl31NmuPf~vDwg+zVYaD?#MAK$UB~Ai_YVrOwn61#rA_&0KBA%nSMUQ^OD#7RH)xN z8UrLZ|LKjT6Hzr!ZJd5JR%eh5c22B?GTfDwkx!|$wyMFw$ZokSQ4sYx= z#*&Xzd9Ce}aUeet?~by6M*Ny)_T3vu0x$5O(ckcg|2Y{Mo-8RPh1w$-zPSdJXhDq+ zknl>15iOd7F>)x9DC|waM>v!<*x00>16)?a=x9P@j*gOy!StH(+jS0B?mr7|Q_SE2 zV2u#Tn<-;>JhyggS(vtQPBYe~Ce}wdm<$V}g)cd_><+9^x{&u{08sWG4kX{${$T&! z>1c{|`9hdV&76jtIliNx@KY0h%tQ0209b_*ij^oi{M22fnX`~rimy~E`{AN2c)laG z2Hl2D?xynUE!+JZLx@K1gd(sy0$4|BWm#8NN~w#Lu1gJe#71^EB)_@-;NWvaqXsL# z_J}xA=V3zpJZ%#&Hw87P4H+ zyTy443G}Ub=6a~Se}+CCE%G)SnCi&W$T2+YKi5Bl-S7!5FKE^S;Y)m?8!`T`v<^7R zeF-Mf0qQu{$D4oM_n(c#3{>a8QywfunYaxu`0h(Tjkp!vdACbt8uA@0FuxC)^k=^l z2a#R8wg?o=MMD8foe&0`+&l+L)?QuX&!qa(w>#tqii<&Y1D#OrrKs9K`E!qwG4}Pp zcxp$j6o7y5`rDSivnQ4&Ki58EF?h8Z?tZlMs156ADf`JU-BN7*cicJkZfl^Nx-M3FHFhS|Hy#uUwx6qzFIIy}*+3i^ckf z=*GC|kzT-gl;^EKF+jb4ZsNpq03E?W?O27Qzu!J;mp7M(%fDe|_9$It0WHjAJ+#nn z6Begl%kL!&Il-(@(9s)ku;ja@Donl<9T(hbY0mkN64By{SCM~sv*z?ASW_YO7Gfs* ziRD$_&rZ>J^y#D;g>7lr5319(WXCoxvd~mjoUn-@b||G7bq*DRS#3ltP1MJ|(*A~- zq!)iz=Uc6!U9j&yUwuRMK{`)cIX=b7o~4#6S8@0D!05^%ak&0LeG>0(B&yV>H;m3O zV=uP^7M}Z0$}N7qM$}qKev08!IyCDW_T||G$eC~Wx~AokPp@~Y(E0Q}9IW}!X||H^ zIKnOJ-3o4TBrefY3rx1;e$9ksDn<8(t^|uOwkfBu(){c1_?jx}_%Rl8ZH-}t#9^={ zhR6zrj3vd-^{emSzC^DE&|P^2km;w2h^&k_;78WZgTT}X!Y*9zsv8gajBf@NBR`d^ z29yW5t=qrl6D|nN{}t{|ptp~CZJf=dA2$_dF6eFSdwFu7ZdH)`G1jB*A#NusdOB5& zS3XtGlmLhM);55`lMzF(TDFt$o5K`243IS3!KQC$D@FTEZ+t{}aZY9oCo#TbHe1E5 zF=t4BZ3_-f77N252z)RxT9)kL2Keth6<)<0pm7rr$o{umAH)Y3SHi~?rp0j~z@{}a zNR*Yekfk4uk{T?c%vpvTpplNEiRODt`NFA0X`dhdbU$$%EP3Cz3m(3Dl6L$Wpw7KT z5BlN!4R~k1pEDP4IbX5KAh_>wJAd}&x2smFhSApZmuZvtlmn~<#M573X$(4_d!J6N z6=v>qzgs=ytZ^#Sfp&m0xqS@n<3ev5pB)`PJ0{0l1T%*wJqtZY9hPhCbGvDmer5l- z&%-(R$o_Gs2HC5K6EoMcir`lJ?IO9M92?N2&-bIY(Gp{#t1jN=)sFGY!4jz#&tkzi zAU;2E`wID4PX4+7;+w#m%$tr)v($GAKKr+b@h`V_l3)CFAjaurFDT|jt$o0`Z6Pze z@RDq1&*nqT_f;` z;UKDM?qG}^=nLgwq1Ub>iWH~HuKu9*Y$LNW3YX<}oHB2L!tDYP)>VpCM!E_bm4RX1 zNnYZwF{@2lwMqhzZ5{oTG%4k$E9mjzqSCG<~8hW*vs zc>W!b5zU)+do#JjmFXEfRCv8iYk&ShxUaY|%*hsU7`aRJVg4#(IH0ieM)SH^T99JC zOdXVQ@JU}!+=vOEhoT+tucTzuYcz7-%_fBDs9Ek4xmF zsqjAA72G3#qkW{N^FjP+#E_}i3iMa1;{dmi@kpCjaB;cZik|hT#wa}=j{X^=))|bV zR$OI#FJ5nzuP*swN1$oCwC0?aAr9&`w+HV{9zF*#lr|xqAuS;UD4{6TR%B#=j%C>l zbP-9@g%QHr?@zw#x&qS=bB}ts`^hH%B3F5|#+F>}PoXr6lGwyeN5SjyH1-PFJDw-KrD8CpQRqVF0^apVgn0Y64J2Xj{22@$tP zZfGc1X~Q`DE2Ap6UpxBmb0p{19>sl9LHTGyFK=blItEyS;uRhlm?+6-f}i$@6K=t{ z Jvdh~fuHt+QDo|F|I-Jqn4zut-vsg!b4V+H)v(!Xo!*`7Ob{p4c4G?~fxfnJrK z5DDu3Ro z`J=9p_S!$!VA{)y_LaF<-0||G1lsWDf`s1I%2f>+3!u8~Xrf90hE3ShM|Dfeai$85 zSVFhslK$cYR7*y!tBfj?{xfz5zAYuq9e^)aKm6G>%1M1L=p59IuAb@b`Lz1inn#QO z@oc*}Un1q*5j<;hYZoCyV)|}xzjL18dTcZRK3~bAWRcL9Xjw6Ct=cp?sV%5uNZj;q zmbT}%rnQnq{VTq=Z(~DZVjwKYub%Z?mpytY8QMopeoK7CURKJY=Hu7JOOk&j7bGTB zTYkZ0Dfwb@4?z=upZu08*YDX&o|KNSN5W40a)u<4mmzg3xW?$xEk6Zx58Nl=-MkX8HojF~a# z@qy~@>t}&6J!%b(1nF+SFZ}+#ebyCc6h^u_gTXag+y8t>ZJlCDMAU;O4HAMMjxq#9 z_iaqsvFB#w7}B@ud8)kJ$*_O%?D3Oa$6&zI^}cJ1R4L4EkEGvg%{EWejx7d+dcCM% za^`0T!o%T7g%$#W%m7U&+}6Hb=xFZli)Y>L!(KSIQ5pGc-}1IZa%#p+Pp^`r{JT%$ zdW2|KS`e$kt{puYPaAzqt=oSY9pr)$cHRUNXzueal;qc0u5Ar(0V- znY$WGobQ3?udx>?fs|Mw?fauEB2a9{fOib-QX?LJ2E#8(C7DblXgVKcu|rpkM=xk> z>O&;;yt=)Yx)9CB6`0!?Z~5IUh~^t2$&A^-fW#_p)T8*_zGF9^r=7bY9`PvJEs)Hb zi`H+w{Un5oi{oNt-t67k-2MZ{fp4or%EeRb7ln{))ULy*7JZSq*EX@uUaqoM@$Sr^ z;`o=KLWT>Gu}00QZuxpeDls0}$R9+|i|Qw@J064j&pw^hiY} zSI~@rST6*^9LR(2kk zj3)5pu11KnWUB0s2?=X&zXKquu`#@8i8k4LxGM=JT<_Q9ye06>&b&6Lsy%z%Qq*W_PX{{J2eJlcA<5MKfWr!q~?y z3Naiaf(o~ZcHm9nur!wo(iR^Kd0Xz2gNWBYFI?SyNlY-7%q9}(qF<}jyN3Rxn?{#C z_im@D{lI*7VbkPZ6swt<_p8GEmzt^4a&h8m=htLuD*wOK2axG3QzXiX@z0m`Q1(iP z5NBhFGg9#@Nqx_rofWCBI&Nm&d+2B{i{t&uaHI39z(>h!)qJid*M?knyjGJtay)oI zmUCT$e&wMN&*SC5{DmQVH8;25s;4Q|x10S+l9wYr!MPap7zfPOWSL62CCZv z#c<4`ljZdA>$1XXR5eqS&dyq^MFLs*rDY`ok>^&$1*0E!t!$^%86E>}%UR0G%JI`R zX7^U}Iffve5V_Dv%Omfe^~sH`is&~>1xgc|3Im?e0RA4O46#v~UXx3voz}HOfM_g& zeE}fU;4X?ph(qFqMAn%<5ilg^b148nz4{BIR*#)p9h)K3wyueil_iD1s5h*YgiDr& z2UZO~*C^50vThn^#%M%f^t`DyQBrCs*ZO+ZlKeJ&HA!4U2?&Nm7J;A(7=Z9|oj6VH z{Pppj`|)$%*eHz>qow8XK92{-Ki7RjQ}(LSDdU0B(WO$;Im42xnV0(@-j?p~i=rK) zjA4bIyO|tt-71f)xn)#|tLNP*XicUp+TSCZo z%DYEK$?EsWjEh9|4)gE`!Pbi=T|nFJv>K3EKCl!0+DY=b_r6{0C)wl(lpm#3cBs1t z7b)lCqd%>fsw6;MA@pCBX#OV53fT6%vCvWtwW)fFGerReG3#$(jxS+sys1j;*ca+G zF72CYx|ZYDVY|$)*q*hvyrnMr_%8kv8a67HfYo~$FR>-gr4hDsAK&Yb5~#%i3{2El zM})>c8kG3hwNrZ^WR2<-Ra=ska4#f1D~rCA?g>jexEu&lmOj3aSH!{BAjv37lfAs*b$&WkhO#bwy-6AMYpMOGmRl7?5; z-*uv2p@o<9JwmbOSf7hP^IGn=b4wxbU2R%p;{uC4{wLNok8Bp+60Zp9(IQRUi0aSv z?D`J(e`j@0I948w%`;tPH9u~btX-xZ1=F{6q8g(sD*PH=CU1%?q#Yx98NJ%(dlyYn zG9zZVA9eIydNj3)G%PqsL1k{xb0i{sYD2%3hmE-DZf{CL!`an!b)s?h&PZ`|TPu3X z9J1;;oex>FZTA5y7mLNCpYA*>KC{!hO$&z$eV7?}P={#!wkTDUqHfNRy4>ARIHL%^RI zs}qvyxqqH5DW0B2yj%F~5X)`S^p*>iP4L7ia^CrD_Aol+%V_=N%=F&|1*MFyt?tCe@^L4Vi1C zdPY6a%E9~dN6*EgO~1nTd}#}-7tbUB;FaSL_;id6bo5&BYYY(d;fXB)0)4$QAeb5of z$8;bAU9VDZLS`|b+i-Lsg*9eW1Ye#-DfgFE*q2s=fSf5GNv}zRW_)}kz`PB_H#syU z?a!;r)(!e${=@PF6Urp!si z?V7I$vhdXy$o(}-$!2SHQ){(#igGSE)1?Mh9lM`?cNBuqil2UD=$%bjoldSegJG=P zk&sB_n55dI3mnOT{zw!$iYZuui@3P1*s{1c231`RvzIB;(H&ucHUq)v6R{+DD<|5) zsn6{JWf_&*xevjhS?H_hVZ3X@c(l=HnLmdb;g6;Cn6Fc=*j{50PsN2j@>X$PGNQgR zW5kiY4x_Vv2DE1286fW*SYT_p= zo<4Ap`1&#b7=X;E7q7jQk;}jpM}D#MttiqtcxB1D0`(qDDY zl0lU@1?#87Bm@&QC>sO1BJb}T=||1|fzY&o(t-yg!s0fO%cCfLX~)$|zl%4gQa9gY zcelmXiPl1&NK=+yunaz}et4y!p-CtCSF1;wFQz(>eh&+84PH-pT#7vww_KRrJ(o4- zWa1QMrsZZ#1NJ@kS@b!mj)ArLWnP4l3S;E&EfGI`o&TL|J??UW-n-QHC0?#SkP40V z2aym0%^GLhK@xNQ+EwCnA~I@0;D3O@fVO*PMJ6yXos!_x`j1h>vxVW)$bCIwbY;$r z*@#i1-a1RZF-=gsttlxgid4YKymNOlR^_B6WOcj8z0gWTBPq4qeYW%*3o|d!_y`}h z2!N7{j*?zV>gVOXdN?&NEJpngy)3-q8pMckwT^=R?Oc#vM2Zop_UM*)=F_rB)qi-T z!O#A~d+Pe2fE;_GZB10V$`GJzVl&}`z#KJ}T%lm;=-cK`GTo?hrg(6Y1xav$Sr$QJ zIUiw2Y*C1+h)A}eVPG%}yXk}E=rC$%yp-U)w!`H4H<>Z&Yw|XhWwXDP-1ckBu8$eRDheJp^DHT;J+Pu5u}>XLy(c=)WI&^X(l-HZc0c#I{@!Z#?t?lx zw4s4Y7Gl&tsm(e(cmTTXA88CMMLLoQPk(iC^iF;U^`WBn2n8RqxsW{2ZyNT$U7*3R zpOQ@A>)ks=5TY&2IPJB28NS#gN8ql~-{l`NlE*R1g^{QIL|K*atR-=5se1GzUs&{s z8XfVJ65sE=4@xCsQ)G**LXoO@hXDjupaY)_o1j^bjWwqx?=QFw*hyy?Ie-NKO#t1I zU+JU9pUw?`2Q8d>u%8ep1KsqF|7h1nM-oXD0*SV+MAa`yx7!o@30-Y_UD!0g?1W3A zbq;b}gdF*Ww0O!ax>Z@DwaS@sU0*dE4`Sq|%{Bt61PR8%+BnYAO;wlG0Jdagk zHzQ$-4!Sf6|c|ezIda%NY0UGR$@z&;By;;l5^nI~VWa zB)ky97HMZxLDkpw65|~ak(4`LaEEk5P0hd{01SZwfW`Cxywa zwC6+gz}gUGvG)HpfWR34$CRxK4kPS*VE&sk7*J|mYVqHC{_{3GmWTX;NhgBIT>F2k zMAi=vf@%EU9hK_x@szP63s1G8XxYXrzTd3&Ly>_^A^>DSr0a0$|JNM#lj0;DO?KJW z|J|wAl8Z&p|FjcXKeEODZIv;CO)Q@P0X`5_7S5jC&QvGU)X_0FPfA8f)=c})T2n_G z@{<+0LiC5b3k~{o2q`b_T*59cGs^caW z4u8`k=zY!xDPoeXZ+1C(IF)UbsCAsObGrDrEbvYQ%~Qg()}$FJ=2q7~)Aqh1LKVS6 zNjtV=Ga`vLwG9H%Cw#uKt1JA2jRpQ{CHId&oT_GtG6BN;XM)yY3Ylt5?GKQG=?%o0}ln_~Bo z9fcEgw4VP&-H!1j>cRySuA(3{WLhhYD;vW2_{=bNysx_&c?B0-Q7?qcHTO5~azsBh zPGukcyaEuIoqCpkI?co~7U2^4twn0C=O`rL=$OpznigcrZyuFTgzyz-m02}gO-a9psMD22ak zt#yE6anR=pGc9$2Ty;D&6p^*))w!|-)})oxkjY7IccV32xShFp0}?y zk9CXXu24bSWG}Bdh%gv7C%P;xEnV3wK3~?!uA)kzjbq*z_|NYK8@E+o$6Sw3lqxDJLLa#R zP+2@h%;z$*R4|_phVUgMA94Q?dL#1~tlotwqeo(VhTE=nhW?`=aJXwPuo_Hl{Bwa= zf#7d)e*nvkAVg(-3A<^Gb5>Gw)iq*tVLCyPk=x3WrwT8I7PhuJU==}D=AAvY=aS3Q|*Nh{{qR2YvwM+o_!WE8agZMdh@t%_%ez51hTJGb=t3Y_2qj zGQmUAwjlY{A$jo0MiF6f-y$Tw@95}wH%DyP&pfF)KR~OL|E$a@A+;0T>`63O@^CO^ z#@KacTH&x}?wrudeBsRXr@%$i1Vak0s#YWeAJ2?Hhw9S(o?7t}{3#I+;09P|M1_Ow!lRZ~6M& zpmQw}Ny%rxBG_gKsz#X7tcG>KJ2v}PY%QHBsiWEXb+m=br%QdxRt>jXz1Uj+?b>@Q zWl!XYEmQPtL*;m@XSZA{dXR2Fl%h1zc-2$COaa6BGP&@oJpm-xzi1Vb^~zP1dBYDQ zm7V0(i|*G!Qbn&gwQWtbwF|S%%`MY`rT`&MAjexpKowHzur{b$s$o3!vziYHcZ)0P z8?QE4hg(AyEfM$xDyXn10s<^DY5*UkNwF=-xe?fjY0NVmJwWjRBd`bjBaGtB{)UQ@ z$J%klAW2Kh{X@x_rY0?3U@a7TP|gL)tklpF!Yr2iV+4tD#o(JgAFX_9G&!VQqpVz0|1-=|}owu4y%? zW5pPrloV;wy>*oEzIng1RuqPeBA46&U#g^S=$WPznJ%5u&#c>6trvFIUK+;d)SORk z5EbP%Ib^|BuW8n@UTdg^AL!+Vt<^C9u;j$TK!&!%c>i7ogdt#c=K@CkGzQup@ zNVmdx1sH{V0njYn!_k0T8-Ok&wPHv>K!7bLr_Aq$3?0_p{da0?8Yu0ka2L8-*T`|s;`E-?)?V4SDfY{jT1#Q)r&Ni z$^d2D+F{|H9Az3FrKHf@Q6L5uDkok<@Chpic*c9MGp; zPVS|T-8rt9X=s-l1sawPHA2lym62vo1b_t^y!ec z;ACaFTbEi3!^#F>FoN%8?u_fD6?)P==OU7kU0?=Ts_11U&qVZwkeZLp_4oHdzR_eQ zzgyXe??m3nD89b#-xX)^MqXO#!*2Xy+hL7=1;w`0H$CSGnMDOCX-a>4XlmJG+ahC0 zahmpR9ENDvUW!~6ntMT#%%_A!FDxgpya^e2MAOUJ#*+HKl>;*dx%DD)vOIt8-1!+i z^m$`$;RK_PRuducIPrGKwX~!HJ481_$jJkZFiHACD@E7@03CK8Tf1N5kT;}qL5yo$ zUYTBdPse{9e?_HerK^^Vr}S}N34z0CPT}Te?Ix0*rBuk9RxyzP1qf;WPVkw*mZbr@ zBdW)yd4B`TX%ltDhFMmNh16Oxdkjlk%o=Lw@JLfi4DA=G!IQO)2<-2Bt>l=P#29!0 z;J~YKrO$L|r}d0E2Bb-P>gZ9gh5*K<(G(k1jxN09xW$+|(9UZ+_yR)Z5si|fV7^@)zG(lcZz;cRGQ9HSk zi@22)>GNfR9H!`aw-Epo_)ml7q*ib{R5)#|OU0uv$ywr(yfk1`QR)2bAMF1OQpoPd zoq9F%ZANhy2uxUT*9%N2+5O3)5*4=W0m7rV76cZCY*+Js!I6=Vs}N8{B~w_|1rnS# zZ=SDW=RuS5c#~d9DmIPYVjU%;5kB6X6y`3#XWQ4dmr_nuQOTjHBtQ1ClbAjjrdIss zO`fB^zB-u>u``)G8xRYKMF;uz5uy#j`ADfrRtn&=F4ypj8`y#*gsu^&bKnspK1LHM zaw0D&c}6HlIqF-ySCL>g;=f)@i#30fx?OjxHe8k2qlJYyWL}t5%d!iV6XYAux=`1c z4K1edhnuBxRAA=mP{bt~ME6@afFVhc_=c!O9Uf~zs*;tlt~Gwy3API2mAUz9PNu(c ziCukt5ST_>>`5Mv$W}uy$ zlh@832f1_0&Tn=v1C8(*>rrl7V=EnPEw-AnGO*8- zn&OJF0DJy=D*VMg2z)Tr{ynHikpP(VyIlzalaaS{MHFUJE@n&nn z>UP?7pskD=@^*E}M&7>j+Ew6fG`E^At@~Bw-2>Z?QHhHH7yn>(`cQ4uRFv5*t*6Rh z6H)?s#)9C05sCEti|Tj&dqBcvLk4#Gb!aHj$OIE1t#LQqV;SiISIJs4zF3Y#V}*=N ztBHZruWx!3%aIexZsNDJz()*U*(9X?f~A-J)S0QW8`z=#Wtx1)4fKf7ysd)v$Wv#d zJrKo~w(#(5-Uh9Fe~f#<@$OgP(?N;kSm)uAABJ1s#LLB=KAyqK+;zgXr-r=E7i}L> zSK6uR?Y*W`2-%t?(}$AL_nE$#=*Z1IP!isTKAZd|uW0uOsOb?BXPYaWOScLL$tD~; z4)gtxsG6+KYGww}F<1XOU-{4v{4@teul$6Cc>B%Y&}+g2#a`ZN^-Ggy`{5++Z27gq zVS76N;0KvUua*QX{R*n?JP894{SPlm+x*bKZ0V}Agv4sbS;(&+w2>3(2Tb#yoLj-SKoabFxw zAbjJ?!c}{*`IzYF>iE}i! zW*He6rnMT8VXEZ(EBF7XH>X9xm&i{w;p`AJArB!BDN6qJ(!O7=-8$vNE{0UwsAEvx zd`3C;WD1<-E(`#Y!YYqG9D(!~b==Rg#n>olo^n}J0~b8Z$(b}Sqc@iyknm!7uTrPK z!B4g9+P4dzO5yo<^sXv!#Gb;b@mO;R9&Z2M9INMV4}hs_{(>Y->h`6@R>r4uOBMikJ}}1(gg`A%rLOr82Q|E9~h@+HS$lQ_M?%c>Z*4^9XnrRoy7!Wi7H zmBv$xD>*o;2FCdbr_#pdWLu1|?V_#xwZOa0TC&mH-AF$|w(XT!i6`V&tij(;W|h-Y z`A`up`HF0q8#1>v<ga%h#U#RIPMT)j`wwr?6zX@zHE*To+2;~z1#sO(u zA#?^>(lS`zR4o%;4I~PZX=a$$+^HVp;V^>cLpEBj;K)o_QIUc%Sgx2SBMihA!xdcb zGs}q7SkD-M5AH>yN?OxG61_#a0{^CmF`JCbk%GcZ#IUJ>H?gi-O<3crQ^tXtoIqxC zpc}YKqLPTXX9^O!|3Vz#A+gsEW3r=&5at39&$jiKSgy-0cY3|+gXCD#1`^ZhV%@vQ z_W7hAWLY+TzSS;)lvV%-SFrPUhvxp$9(fcUls}9*g=v-vRBG6o1>U>CjE>6E(`JS= zlI>WA%E4$cO)OR@-3<*Dgq$l1*sxkw28H_Til;S-rvn14iz|wSfV41_)}; z9WwrE!W`mL8A4+vMr8=+5^lchKu&-eGQeejlEo_QmKhj!;#kQg9>wikP!u)4S9ZVO z_;ntmUV;2WKuADH%M3LvtgI|7tgP89C4al%Uy0vq$@{d&{a>SE`LFKPB=r2cJf672 zQTzBF3JWrZSPhl=vCsX7HDAr)$hms1VVisDG_BzofDtG(El>d60KgXyX&z!f9cF8c z;l1SEBdm6JJ*rRjF%O>*zY44C9iFv!Wh=Nb23cbThANJR4yqbt`1BldzHN^n^k`^~ z+6IM#0f%rkl$Lt!jaEtTlPNv*m5Tk1a5AuFeT@U|COywJe52ARhd!dcHqm9t z^qf>G5QF^VC>%e&hi7blDZ%fLvlsO1Zfjq<=KU4MmHsRIQ%`gt!;GW9Bp+wZUr&wS z`W~q78B4OpSMV^>CKf@qtzFBNQ&NMBg)S<->bRvg1YpR+W>uybQI?h#g_cl&kd^^F zMvblzuo*lyZ=w@&b3tU3nXBep+*>Z2r!6Z2ndEE2!`uJ$FY`9)oB!gi>tdI;}4|%JHSPF_sw^aXOFbt1xSr*?l zbD0cCF?M$@7Ovg8+XIZOBg3diEs0QFMf}2^AcQF?h%rnl^ZZ@2EGy3`;$UZw38b!( zrlN+9V5UfBn+fH>7>@zQ;^C&`rsgJ*4Q9HoZUL|a5E+yaz?zAuht2%G{&;(3^Ab1Z zNtO1jSf)k9f2ZQ9nmXl}_j9cIoF!%&YCi)bW>wl2 zl4?wp`21F4%vvqUl|uoF7%~PV(Y$6X!I+T_2%3q|WN=smjs}NS(MiJ5Woc+rcr=Wv zZ!|t(fvSwmR_pIAqjknQOp}qi`V)0*)M`0Jh8b2?Rgl9B9r+X7H_FCMjM8Y^Ei!+< zl=SF-rhGej)|<)X&F#JbngQ}kFmN9fZ0mzD@RV33|En^=4?3)?B{>>UdnCncze2Xk zRjfa(%7-SFl{pw4+V5_rLj%L_qg)nTQm!f^PujmvMM3=ue&{dJQp#2$*iq-2Tvo$u77jOBR_lzZLmjWMG#f^!t?`)Gf}SK|n5GoPFqabB(IW;1Y9Q&;T!7!iVg?c%%48`j#u%97WCuBA z31$kxq-;_F$Fbnr%C2%dDxIjsD=Zi+24)5%VoXx3!dy7cxofWpMC_-1cafzvT2o45 znHH-n)!6Z%{MNmGmzy#5W|%KlXyAH6etr+LFSD)oP3Os|>j%B>y%p**Ll^b~j(+&y zBrK?@k^n?F6s#kd1A_<#9R)hBuBMsArZhH{pv7Xgt+#a>^_=8$i!DXS!Gi`I3>r^m zEUhb|vb15occ{aN$muLa&1G42R;i_fA^UXd!Bw zL%O^p3!qXE!f1eQE;jKUGU!Pv9%#``Edc~rp_lQL$^;^Ek=VR(85uB91aSldCt$mZ zGKr7_kQ6-OkbweJ!pIVwffz)v>{6e?faJ8e8U+D68NdV>2T^!kS#@aO%Ukeb-!Zt+ z>S2eRYPmdFCqE3VF>qbV((PGA)s=%6<#X!c9({PStD3u2nI0BSj4nmL`LBZ-oBr#9*tYpUj| zxIIzrJmzMnMsr4u92{0Lix&f9fyHrKt=F;2niY{{EfDjT;_!x1c&-X^m3BLw=H_Qn z!NI}7t9I?&TuvtwiNw*PgM&!i$+@|`?|YgyY};1t+nbx4owztSI6JQKcU>bpsf2S^ zY1(RQTGd)KXk}WBR#vOA%AHz&XLYiF7lyoe89weYtXv7%`&~Y;s*)ffkU%Q#z#hOk zfTTm~6+2KT16Kvb#4yY_ERo2vv8=!}19D(12+9+5T^m`(iT>x)t@4YhEHDcJV1?7~ z{u0W5wL)1ISU^;OfP*Nj2%@>*hHZzhip_t!6s= zU8?Zudq*d~Iy0l9A%-O^F_MfbvnJ}KRJfZ3YybLY@1WC;5 zO1)sEq!Z5*Su+mxJUS<@n_E6_H`~C&16X=>cPQ~2*I#Cb%&{J1$uRyBEex#-LApyr zN-U)q9RA8nK>7z1hKKPl=os)Hus9ZmDy~?nVT>BlF5l%^5JPZ zdcDz!v^@J)x~+~R`aW^(uZ!>KcC*`+^KBY=EcC-`EB14mojabPwx3X9S}5~j?P7Yd zM-ai3z{)tR8T0Bjju~3utuU@NW{1GU=onW#)O6Ef=3}Eqj4}5cZLL#hvGE!X zc{afxc)-Djf?dk^txBIxBU#rGL=R8ZKCaJf`@W3IdK@|)fb2mDg%b(??5B(0`F)$e zMds1NZ>0c^Ff<1j3?K0D7k&<3z%q2F>FPTUC+gOycU**u&JTZ zV9hV>*YGQi?{#oc)pT&`cumWPDL9yoixt&ZZhs6eS7p{8fb2M6w+S$T!LI^Gjq7x3 zxQ=EDP^@mipiQgFE!iGN5r#)-?N>b2itEoBHLm`yOLE_yb6ySAG(c;6R@fufsWp~zxLfSMrc=~TVI&YyHjh?#Lr%`zpUN#&9A(sJh zY=%U|iWV6dp@A7}h8`CdS!~&@8rDpUv9m{3bI9P?R)pw8l8RZ1Kuq}zUgDS)0*Nh8~9pCz4%8&qHS8+~T;eJElvn^~DMGCk;o4%D`Y?64LYokX)f} z977NiL&R7N3=9mf4DQH|6@u(CtYa1}Ud?kDJd2H0onfbtusqe3ab$Tb2g8i<}k^s(l@lXei)@~)t zJRfOmEu|@Tgmjc8B2XrcjYcOldwgWc#pADAxZZc(cg=ZcA>tzn4(2<3Q{^eGdE&it zcN(APJy5e=AdyANwhElj>v%4h0IDYfN*linBtG6|COARZ;v*VO$bde(1=>mC+ zTHUKWn;ckLl2Vq@(qu{jHk~O5J@V0At@^8-Oz=^&nh+9NfSTDb^F!O$UmqNJ(ZEkU zuXH|BoOdgu&GOVl6-lLX|SAQM(;TV#Y=TsrMh)~$Yf_5}74^euL9=ijs zx`Gm0yk@I@BarCQ6Ij-Itmb-{8a7awwul8u6$=>z}Kg4d*`ye?%Eis z@kSA{#f6n@SjA|yLkl}?Xvp0(Ez0fMx$@!1ja8#C>N2VXtuBzaBcyx!<|@QX1Q5!J z*c1nV)k&`~iaQ^)kSTC+;yfh5&#y&nJ8BKjguDlkq?mCu0|9_i@F)N(GCH3Q0mne- z9Yd7HEL}zp!JV)ihg)51vejz1uLZi`cnuEjRbXHjQk4j_p^6Z|uq$te5$gc)-eg1U z3FFOZ!yv<;7`=Lpb=3#2Fxj-Y5Fy#_r=Kgz^v>Ej~)`11M;6uCtCx`OK_ASA)y))X_1kr^XrSxz3_2IrYC5OtB(D*cx+-rRsjGN z;oZbOW&3H+rJmU`WcY#-i;25tStZ}8aK2SlUh_55vL{>0TEeoduT5dhb|q*~mL(`g zy>HICanQBtoB*L)Hx$z%lIJLQB^3{@-;inxU=NiiU#pAvYJRlkmU z!{Aj~M~#xuNZWWFw5yf`5dgaY=`TrectO3x(?-}`YhYkcc$c32b=~Tc=`J+|T9!XD z;0=?W?Bw8rNZE}ez|F)2!OL%gK#)peSqWH5sY#HHw7`qKtnzsPTm;B27ro_IHFv9F z<0H;Fj%d_-9T;{wC(P!wddIAJ8jc<)(ZlELy$(ER?|?h$2TN~JIjEy_0drHZJOc~{ zkA-<&V>&K_lcOFEwbpmyX-eOCd~ShIKQ?jsp%#8)F#BJaPScTu=ue9Gab>0p9RFOSB+^ zycTQ&<c)5)TJ-aL?}(Hsf}bqq;jK@$cOdd2!0CcP z{j(5-*I5w}5fKp(I4sP}%*@SSaP?aid&via5#fD7iWVsoZ%W>pz7C*51VimsWJFO) zrlH1XkF7xO7FlV3)%NHJao#Qh`?vec(~)b!PpGyDn_y2T18~4XiE1S2R0*({S~@V` z?OHLTQ?(n7Mn}~jS;Z$D2O*)gbymvYtSbY7gyOr0HSFoG1E<#aQCk_9XOBl=#lEWM zJ4aM_qbSJ8!>o)fSd3U$u)3^TSdC!hv&JyG_aTTFy%z#a2!p8?e=x)&1~#)dKha)jSWVlMPbhuHY~Ge2QjGBZp3W%hW3sQ@qwjb zU?3s_QH7R5C5A<)VTF+)VPRo>;BY5fkUF|FtXOGjY8Gi&trGzNL=eE>xUMWYkjgUR z;30rPgdq%#0Stmt!=q87D76}mNoqA3D&ruX4hRw&78RADlx3Cz7A299k&DV5OD!Ig znw_F1BwQ%Oi$j6P#A8fYa11bp7XZXEDI}DWF=ewACCWsMFu}pWcq12qvUkYPgwG{n^u3@oHDFv1Wp zgfPPc3?U3SFgP$WuoA#PLaeeQ2@*09D+vKCATlhgEG>XbgaimAsY1j<38%Q1J%IT9Z#OD^vF!cL((htjt6tSCp+iKw*b@6H zPiJjTt~6J#4C72>IKY}_=&l*Of0+3olV_~(tHNW0#~3Tg8tb!Z=~h*fCQ8V@1HJbA ze7W!7`?l9Dgs7ndh?5Qs3^18X&2<13I!Sm5iVc(j09XU+AoBoyk|XK5^F>NN`8$}X z_uUDKOMS0w=O{E?0fJw8TtJeV3(z|0><*8!+PrJjo%FL>vp{)>LeoL2diHqTYd}tb zsjXNFz+towrSW>M@SaeNoTU1DlDF*kla#Ov(I=BI!D-7(NQnVh}T!blU^RvSxzBMB-qMe>xuRz0^F2bQaVR}jsrCE>o zG%#gg#3NVHgW`7_Q=16kcz?yIe0&XQWu6GRo2PpWVOeEvHlBlROrH^72bZVgs_PvU zbysYZu*1yc(O1mFMn@U<)vC2cgDxwDb6P9AfpdZwF1J*q@5)4I?Z{*N{u=di@F2%c z#PHj>?zy4I@XL$F;?$q$$zfv^jQ~86JH-6;_T{3UC#CW3-3^m`w>DBh5bhxt*9ygr zW&p$>(R_i5=HRjqyMWyyn1HB}Q0R3#&(4}>M63m$z1{$Z7z|t_GNt}O&=*4D4G_44 zv&o_FRpD)nv5R`yPo;CJ%me+H%1@uDv@=*;qYcClOb9j|mQIV>;zr@aVPIQcE2f6e zB8FwWf@#7qJB+w(lZTsD=Y+>9%D`{CNk!c7zKt%Qp-&sFYsbSv+py=W*)x#$KcC~q zOpG$HC}?PCXlQ6CXlP;?f`(zCp@4>lh8jsE0JO!WqF*oN;5gx>JQayFrmNHCq34y( zSL{BeIHy79x2Wn)9=cEd1s=6erCY6D~cXkecNbo?WK;IILu1vLhN=Qn0 zX98ySgJC*@O)_#)_-c+4{J54VuIG!`hagH*&sWeH3|GXNs?18o#6c{k+fZatR+E+! zY7)LcnlMc>lNFt)i0#DsEmbI9pv~O); z94Y-z%av}LGK<#iOIOI35egdyDcvbcu?GB2Ni*KK#HmPv=#W#)3MHr?B4f!(^9ew= zfGiVu{kGE3mnzcLW22o18||IBb?T;=R!m^UPzNu^n=Z1;+BV&IA3E_1fxz&IaA{cv zS(%Jw(NM)KidKjx9S#HZsF~FdLCzy8WQ@sgbbqsO6@U_WjZ2fqsXAM+0%uzX(u^-oV=rH{>DeSMi%=&cvrHE;=G zg!?io1Fx8$PidN4^l8Vto_HoxN8RoOB~+Re7|b!0gn0CTdvwUI<2DJMBRYnXH{(^mwhRSx&)wIyxV7_bjpOVagZm3u&p!2rtO|d zX`m76N|rko%_Ew2qqcY@NGWTkmbCDu?8zmtGp@F&eUQbX^{fib*h^Y4haAgCz1*ry zRim9(tMS}YJ0^tZ?E&wnld&)FMi1L@218t=&x3MwBoe}~GUPq6J-xaTNIs-!Q zb*Jmh<8(M~G`j^1O{5|O(rgm662O$8oVnZY%}eX@HJK%{z+^`Io2d|1C~%5@1om40B;aeyZ? zGYn&Z3~&Os^8XNka7zVW9VKW%fMle(pRYcaFWcUde>`PHxrj1;xrvz3@>v%Q902qo zt%V|zqA-aSFk)C}|4Tyu4V71D%1$R~lT!_2LjNcDH3q_r%Bs87kgNS;B{hS3wJByn znM1{eG%!)|mE^2a9;ItiwNn7aVk7oe64ajh%&b^3SY~L9rF_x;7~q!?VmQ@W)=f=W zXx37>G-%+}QrU@ejaMgpn6$3Lb%etSVP#^y1b6H%LRB?p$CM$ypVz>GKHOG%F2Ra*Kt)bn!Cqs zq~=vu;IY(@P3m9>hcYD%AoaEva{-_R0uq}s#$p7?q1jOG+!5gFugTSUI0~w#oTyY1 ztrB}Bu_@#WV2GuFsc19fc;%+A0=WP%mX0Kkzx-d&|B9mCEFJL8AXd=`$e6bb$uSHv z%crEp)y>t>VP(z3NMYT@bP5-QYP1albd+^<2!ic*3az0G_KS`+Q!n{Be{9nPK z9)IHwbw8K5alVU$k|A%dz@JE`Sx|Zn^NTuhG3?oqmw`|>TA##+@)=6L(+o1Dcd{}x zX`y6>QwD~qqFDKUrNwM0Vc=05H;hF!VprLiL;)XEXfc(F#da@0N}dNLHQ%SZwv*$J zcakn==-fz}7y@*R%1_hm?+|>2;F|ZO*0dv?|D$DnsT~lPh*gna^}q1DSM=4uT0LU( z(Yc9{U_k?Z3)Bb$=HNv7ZZNEW#R;OyULlmfbK12V#Wvd2z{*k62g~jpUf+z4hO6Fq zf$cPC8%88KUpCN*;}-$=I{L!unnFtGL`MRk79fRuKD<2AO%)1t83oJX)ar+5E%5ph zRX*f5{JDPK<6kSWSvEdTlEy4z#w`b^aY)kSJ-ez-j*A$$4pZ`cgF}k1LDax-;{YYR z^N38c=n@zbsiy~{>EuJ0h!!PDSB|4Yf*yZtG>ez4QejU~1YwBG!Z9mMG?2+@VPeIB z!zE^6L)yQc!43deQWTIlSxKbImI;dk77V2^BO)*h5Frq$-p`;1_3Y<^LxdFzD8WJW3<(*nixvfG#S#$P2^UqC4kPD zXm4B#2*j+e)u^;$sM%9AF<3?ngLS1=fsq(CR;e4T4Pkp8-hqq3x&l2pvdj$2DQL45 z$sC+4fpD4;jrxLBIw0vS2yiA*KN-;F3L*)I)jn5`_;B@$K48ExdTu!gXb}Vn3`DTT z4y?D?_%gY@uQ0tn8pUruoSNN75_1(EhZVwY>B3ik&FhVKO6)qCzuNEq{uhN2JjM=P zW?mKa^G53v8Ocej{qDYguHGf4QyC*NmO#Ws62U<5IJPMv5;0(-g(9w(;qs66466;A zjJUk1bgEb&J3M|sK802L7#b!*7{DaR5?N({B8qANfQk_*sDhe+B#Xwyp$G{SVuXfa zHdVragrX3UfXKpXfnbp-2q0m|G7#KSmBADT0#P0WJ&;ORssd=LO{p{lxRXAA{8Z$$VUljLV+k2h9m-jPMM2B z4G|+mu#}ZWGyo+4&?{3g7%X$)$3%{nDmia&m9Jl^3^`DH#3V?3BC(7+?b0hOViPdP zoGh5Qzz{o7=^P(xh^yI*TVnU^k6RR|z3GeexC_0P>Op~P>GRKxH z+7sH!tT9N0q$5(5GSeawOA-(gP#}dRP%t_UN2@NYi4#{}Q1Q7REA8EMbaSXVbc#6a z1A|ybPI64}6bXLbjivNIfsv7wWmsW`MhbV3RV0%xqkDon(Z~D_>^AF&`$%N^=?}(( zFg&%BaTA$goVN zvuGG6vz+v5CWJr1%96~`MAHmaGDR~r5=2o|5lK-{QdHA36ERgmO1z??wkMaq&7*QR zseK)5wRk$<>dvkj>%@~SSR;)13wgv6(fbJJp3;H_+e~9i_&OeFJ`p|Gd5*9V5iC$Z z(?b&zNK&-~PA`IhVcq-xPM$yC^6m;O?mKiV#YCI()U;SwDj)MOIU@;BNc>< zT*(ZURxXsSj4)(a8m}DbCGIl4Z-(2eKOG!zu6P^7U)_vUu=48b1>5eY<&)qtgHh5= zD?@gH-I8jsTqVL4VqRHInf&u3uJgaA(%)d8l`mgED@{@HSPT>gxCsFf`M_Y1XUWnC z4M4(>aDz~Bm&Ayvl47Au400y~xYgn&m8AwVkQ%B8`}5D|fc(MeFi1#i@x)3LhXvw_ zz2Y7Iuy)Xisu_{hGqm&`v3jfrf94%tdL4y!d2Y0Z10KW>f0$rBL5quuV6-@6hAvn# z(trVnQ2!4?z6Mq>e+DY(l{(fUSAggJsKf+pqcxH-`{sTvZ6VBkE*NX zT}CN|nN|#Krlpc-bGyK9lKY!i;j!C0+g~N_EU(Xr@GI!yM}8hI<(uzU)o+;8V!@a&G8ti*eOOxiThL(uQYuWK zFi4?PxqIeVQ08QwnTRwX!a;<9e3H8~HQj~*QQ%n5TvLe+sgH`xgP;-wHo$2qV~DY8 ze4?s9se?F1*btRcz4`V&OY~&yd#Q^0nD=|9zchUi9;HuyJxay~F<6V>tdn(v_14v; zFv!^<>__0Dg*q` zA{cag3H;rw#=k8PR1MO@EMWO;)H5GH8K#y#Z-w>q9CSaQxIN4I=xAtI9=aJx>_5=p zY+;DX8b6YTHXqJ7qSa+8{`k|!=oiwJ^Fi=5U~xtJ#$;iN;51S!{tH?r23+exmn&Yq zrKHOj9BzfU#IVK<+Nq(I>^S2--EgjofO%hxURG4g)RIL{*9kZ%`hK1cxJHtE%~0iP zz{>nZa{I730}xPj5AMD!ig46*`F5qfSR+iPAHbHUZ_nX;XN^|CI7tnGjH@FIOpKCV zhE*+ITRHD~^=BFsi7Q!RksvozH7KLc1k>z@vNlAZgn-~(&5Nhwh|NapzV&-FF^aM& zFA)CgB>K-7D*-`)g@~QTA%i7c>hs4*+WEVqH0B-d%zF0n>%@VpOWp<`U=VB{xbov` zP_jDaVYrV8axQ>;KBVC&7&IZ+T4J5Mcy+7;nx^uT3>CzgH%ntqIW(MaLs%Hag^o3< zS%htk9AErTr^Im415%L!i*sv6fgfqoT$xihi%* zv`>Nf{Xl8m2?|J>r|bHI&njdk1qs7MhV_LUe~!XktsiicBVZt7d~y=QM2noEn>&s=oeKg37F`frCdntE`T9s;yTuqOOJ&VBu7_ zhV^N=varQ8bE3QP`S5zWD^*~{bk$*z#?j}L>mI#V&se(n_I)olD;6vmnJI=uLJ+|M zK@dX$2?Gof01^}nAQX_yO%S6Ds)PW+0K)?-0|GEG(1Zgj!mxx4Fo7&2q%gw>LktK@ z0YV^4OG4s|7%*Z?7&5GxWX1^=AR&NQA|Zwmh(v`*BnX6vC59LV8CC^>WT2p7fuIV8 z1cWArnnD;tgdu>dMA%qB6ASG%R7ztD;f>K#Z0uodR z3PlMaVHOC0mKH>iNos_o3Kgmqq@t;aA}EOnh?F6eh7loPMrM*yTBRrofKo&zWT*&| zfs{sR0zx8ER$34O78U_yT10^*P?$t13Mq;LDuAX`2na?Q03wP4h+$zyS||zzl!>T> zs;Y*dCMY;?$!7K!bOK08fl(8L;0I>_ zZb);L!l#MS@`ml=W>0AS?tZBu)UhiA6^UU?VOTOz`hx{rJ){eD1LFvWRp>B~z{@KP zQw(>i4}K88gk@Dn7}d&%Y;+=-lNc` z!;B~%nDz;Ge4@V?65}s-I&dco8H?`a%||vOo|SVK$%8ZF{9Dswin6|8ptPxn7e>`t z$g(ND+wGq}nFdH^2E4NnLnU7o^4Gc1&gclm2kY%U|6in!Qi@Wo2vVqdhOx2c=^Yd3Cwn4f*eqaH60RCc^o1rMZjHk;&0{4D(CDaIipkKo~=^oQtC7;Yrw{ z88Aakd1{b`SS0`yU*!-tV34?3WrZbxA%*lJ5S#)_11ko@ayvP;6^=H)rzFNft<%4{ zxHPjDN{#L@`Ii9uiEPO$439Gs)q!7DMg4>M%?A*}5VH1n7o5B;24b5G?&A**fq+Cj zT!uLm2$+4WO<1w4`>#kz!bC!PVt7X zGKy?2)Vc%!VJ7}&c-s{_`lgtG`(jtnU<5i7-V7ej6r^t^{y@~ zEHLWk0(t|x4LV`vY|3RfH8(PEW{aA>!?ERXcZ&$q)BUjV4ia~LD;UPRt9*A?J{83G zYHI2yQVHDeUj0YIw?P7v7(6)kcaCuTDZHmZ$}_Ecm87<&E6YC2htwWnchjouzAIYR zR;w$3`G+fSfOV`GFlU;zp@Rljkx|-Yr^S1hZJx)hX3kxf1 zWoR-7qP`JScPJi!DM00Y>!B31kP_0;8x(~lU=lRbLl!KJEE5TzrJ;G&)%+^K^o)*7 z8ceHkkbC)iD!*MRFKPYc^yBw4UQXnXykK6}%<;_5_(0>t(MQQxQ!2=qtPEC4Q6@?P zSCK86g097L8U-| zfeUO30Amvjh0mJ6A(1Rl;I-W=VjIDttEU_$W?eU>^SLktALXD6tI8UknZxM6Du*ln@7y{Sug=k!4 zM8T9&0vDZ(L@ay5YkVy^r{27iiHoO0b85=Ly{*&e zX9pT|bPulv@EtWeFyxi){0a0a^*9cS=~yzcSzl+Y_7>}Xx_D-NE4nE9Bd&MZXs6AE zd%a6chcb1g9WvbNjpK3^SR%(6~uP5f4oJJ+3SGKQ7`&0&d>#bh!JR+dW? zpxOiVG<)5?PRQ+|(i37@{z&}SyMdPj^SW?eX+4N~_*xuHMAYg-)q~G0(#JCO9&=5C zuS*3>6B$_*h8SX@!?e~dDm7W#8G~jP452r+F`^<`$ijt#GYJXLzJ_f8P!}uCqH`Y} z26|2x85Tt81|y{BQqmBC3L!a^e|S3u-0!~y5A%$ueDANH$_K0TTQ3D!gsgJaO)nuo zk|fn=kZ6d%?20rHz{>#ABr>Wj-ipkMF&~J+w;uviR)%I63{s4geiegVhO`}}5n+WE z63{Tn!ztX{v@}^;5Vp~yoF=#`Q%I`Ok=1^B6*@~Q<|9I+67pzDl}I4K5)h=a!UV7b zNc54GdT1SB2+`~pV-40Hbl9dWaZw$oW^w5`W6lySyU-Yk;CI<$4MWsqccmsMX;S@eC=LXMXN>l?p% ze&iqEqDSYK?m_d~7cBFBY};*O+WsSTb6T8mkHXabMNN?u6nnRcFf4 zHmQm;GJ8!;7-6F$QHYonSs58dj4;$`Ef`^{G+~jWGYl}p3^Bo! z6yYGK7_%Ts62Km8a7s~xA(xyE0hfqg5g}zm@Jm#qTI6u1NCm((rr z1Yc!59gx7-s;K8`!Xq$p)n6#24lckh}#gFn`2la9m=6X_Hgs;mf zCRtSs!iH7|GYOfdD<%k)`H?VJ)R8j?2P5t@(GW5h233HRN(;bTSl~hg$WQXD^k1Gm zw4cnU+(s#iVhmFh@v%&wPA|Iy-GR|8R#9TFHNjzFcVH=K2o;tT2nZ06rIq-AW%NM5 zszrES0L6neG8z^t{4kU5We&bd$!q4yZCM7xLk0|2c- zFGB{SainBrTB{P-gHgEDjpdkMbjmVfTUG;sl8!4AKy6x8p@`EOWxZ{*xfWD#TwDTJ z4KZQB2lTDV#W*r9Dmjf6TB{?2ak$BCO$>(&tTC66GKU5s5QIPmD#i>8f(~It6;V*t0aO$-RbW7B%99x^ zCMfv^D_D?Y8)i6LEEpJIVTKrBVTJ@Dh8P5b7+@G+LJ*P|VTV{IABn0sZDwN@k#QPn z6H6*svI|vN1v@M<~*?j8>)^ z)UazXaMGL%P{uK0#uh9q7%^h37>9LeYK&$qj^X|RfrGqgZe5laETYAT^tao6vSpRc ze1WCSb{38dQHCXk62l{zfN3NkB-H>z41|d)GRm#dnTmS{{KL($^c1e}0^6+?o-at)jqPMy4Ez;XvXM#RC4 zah9A_s;f%VQL5WY@gBf(8-nD20Mi2)Kl1v=_@(^UE1YM2b$7ekT3TMNhYWWtG_>S$ zG&oUwz)H(2;s$}9QQ7T(u+tvkGrmqq1mHVJIn*9nAbjvdu&|?7cxkMTGLL}apnqm6 zM=hG+WXv~|sQ!RqN!+YdV;I92STR_zv10mr4G%HsG>(AS)qw66r>V;pE(3LRLEtVf zEV97D#FEUoE-M3z7>+1H#y(oK0T35(ck+M+%B0AJBAh5nJOKd#EU^&7iU44QvaEt> z2@ud6gC?NB4)ME*)0t(U+ zf{2QssQ>+b@B9AG=X1~9x%Yd%H_z_9=RD8z4KOI+PzUxIj;-GB72`e9A3* z3)*VNj7EIzY|h*bPo|-4a`0ZEt5%AN@%AA}XQlTCrL>PysSWCl{NyvXb!#2jzvyhf zNMREB5OIgue4NGE00Wj}z?v!Lc0g4Zr)%t(=@1+S7PSp&d5LwA*6DLL9i^tPE`>eZ zL6*Yhp-Y1sl9s_QZtKhav{{FrWLJ7p;uL2rUDzbeVL8z?(g(eOg}q{^03m!((tZ1` zMO-7B6;%OoBIhdNXV)M0(LF@-qI0URncH61q2#EtldnMq*snCS1a?#kpFmuT6YRBVurSHyP@4} z>cMGQ>5KU+%qSQb7*Rn^4#VLpgvFrJ?h$TNb?pfF^oYn1hRs=*)Xmoi#b^g50St|B z`=ChCzET7{)?<$7=@mD32n!=QNW_h{8%!xK4vN)R8=me+cS+OH7g5tmFAbx11On6Q z!8lKrF_3;0&sZ$ZpUISe0c{daJya5Y?_rAG-sbG^izNb|+Bo01epnh_GOU$tR(E~p z4QZTT;g0d3Y&KPSu79`mkwW0ZQgOf1(Qp;oEn2FS*pTM8)<=N6jG#|FKlUBWlE^;4 z-_1>7%ZutBwo6a@8ncQs;pkI8lu+dmttwc&YN~Fy-dyQe>UoLWSCD(O`q)MEiS_~G zkInm1_t6B| zP(L~Ti+x!W2*E~pLr&eDM3SpeCd0cI^3!Fzwg#w(#oTVFQ`m6<%?1LVN)+EubxKIsh9$ zj`N0eyh=s=^)2;N+Qa92iQRwOaIf!ym~J4U>Q{<#kGGGW?Vp16)mMqjd1Uz6Uio}_OQ2?)}hmXOlI!5<% z@=y66-@1X`a@7Wk@lKD%J?Cr@tM8%t#s|z4#~mowHNd``bJBj>XovS5|ZO9XA<^40R zD}P&BOWK*=48WigkM?9sMY@c>jgOo=Mo-MB@}>)i3F3RST>iMtIw%sO@Y3Y(;*2S#hA&%!erJsPG&r382alvger zhkTQqHj*#fW1wvvhFoW;n%ei1R#e2XV+IY)?vBq$FSH-IL`sM65dl}8l>-KsrKOH> zKUP15^h+Pg%k*tnSw~8mc|Mg%a7v*)H?q}ENy^HA%|23E?W-Ad4nH}=ta4_EJ-&*} z68i1}digj^CfP%AsL#u&hvI^Y;4W<2P z%C6wi65o?P<&S@i@d^#}+#HoW5oy_)`ssJo!G4j7D4dinR_@=loMM^SsbTLvq$K+<|C0SM6v#MqeZ`5pfBsmC1J8K=DL20LT1*jwV@$oi`VGl!kCc^j7rwo^DPytX$iSkdtr^} zHP^JF7fHg5!hN}Z8G{qjLD-u-=Jf$BVq%dsB|=b9TC^*g?c-x;x?)A$+DN3qJ3v}z zcRZRE06i8VOy>^k;$Y_BXr!O?-Fn&~mXfTp9mNIZESwq#j#Yv!NYye6sRaa~)lQTK z`V=hqa1okvYuWv$BP%*Du*$bu=5Km>+zZC;Xr)O4teS=WG(dI}HBLIZN)8axK z27NFtVfH9H+ncXvn5%Lyl=BT}`DfoyRL0Z^>gHiWVA$h^CYbQSSH=^kKOTQSur?;D zFDsX;jb#QH^C^D0>kYcN2`#-Y6qyiL{<_~pGjY%Wx3M4%j#l&YH!zVVJB;ytw(5m` z#ruIh<8J7V^8C%`7q0QYU)ZetIKJ8axn3CaA~kEMpde{wrT5M!5592Qx8=iZY=qsN z?h+0@>KdQq>&wM&y(#FDXFTrvF~5<86{(lASoWmPMb^#ncIHIdUHbX`DOL&)IT3!t zpM|wLwUMpoJ;Qe!C43M0Y}DW^ncjCep}S^HJ+^uHi81F3zO_V{!ikFpXTQv7&;fO+ zqq$Rg@Q?>Pq!z?ZhF7m4F3v{FhdLZL0;|w7p@tIs=Ytz?qa%E+=j3E6xC(NT#5gj6 zR3fj$ByrV}FgQyo^@y1%E38{Mfgra^RA>lWn^h?r9@UGoFzQKz)XE3-Qhl63S#2KuyBKAh+0TjrBF{z4+5u4Pi}d; zP5sXzv;(sny|pkF;~VH5lqa`QyU=gs)H2uOJMtGl&YMZ^3fU}cdj)AS9(gaX z4b_hCW)%F--`w7NKVR=cAMcG@Q@sx_{^nr!uQPLA!ON-y^eXeXMo6J!s#p@H{?l?6 zbDC$fAq;2R52gf{COig~5kkE!hF}OZw&QD6mu*q4!ureiNPKrU88<|dOKEr?jt7Yj z50aOtN!OVb;?W^-HH)~-@7g>$-ux#ctISUj9P8gZU-;~DS0S~KO>E-oa&~Wp_Q(9# zj#gB6PstvuT8fki@;CX zHWUS0L@pc(>lfcIJ8zZ;9Fz-uXYIPZdvpi>ao{iQS>yb^&5Glb6MYD@?GBYworC#O z`QrP9j9~of{55AJ*CB^^pmqA%T#$_tACK7bt_jCq#_%eW4QPY4018nz-{85dl*>9b zWb=n;c}M-R@LJ#(`_o34VnS82_}0!*WCG>RQTZnB%h1@1^5Fbi9&S_ptX*;l-+#(4 z`G2t486{J^%a`?jf0DG;Fg!yJliT|D;{NYqzbj;|H&4QA2A5|9e3Yy=j~yXi6+ZmY z_Yi}5D`haPy+ah8rW5!~RJTRa+L~kWs{zGh@qBh$8`kknamF`dFgq`w_4&(03UN7i zuP4Q&9}7lcEcK?J-X3|4D=QkfA5Dy&?ixY&TVYNnf6&v0 zzasS!Q(GzLr$EMo=kGkUX~H4;>V&tTc@o_+1_~fSJSED=Vy6Cvvv*9!7a5!X`xP)w zdA~6<13R^Yd}sJlWLWg()d}jGlY3WPyLv^9fn^74?oKiV-R#{w?CTbhoR&16%~zU< z%uzT;YhD9aj@&1qKR+~nr-TZirB2SGgwP>^b~xNsoAm6)S_FU0nkBn6Gxm_*!C9tFt}?oW@Fvwq4LxSJd?g z%?w2m28z!sX~69xhk$Wg5?@#K2$>FZW?uDdfWTJTnr|^Z{I|LU>d?e1~= zqk5C8bkX;&@Kw;qf~T+KZaEU_W9~vsZ7DA%4rs-I}Mxj_g#F&wjSh$Jg8K+{1UQc0J&iqUa*# zyKAVH<814XA0Cg3LpTCH{%I3r!{3(wwhpJ&<&O#G83NzD|7|%))`Eo|-22U>73{$` z?DIf>KPJIqaFzNYRG< zh#ZZap?M-3%o))Qg?m;MBxhyC2xz5^GxJxpnHETUy3f&r(+K5oU>LY1N*@B>PR*+@ zQ&XXpB^Vy$CMPE+Ngoy@XC)aPdB7;?Hdc4v77y=q!Px1>&u{xMG7;fWsI)Ph9bt5M zo25+xFDwz3ETFZUq)i+?Xk%h1H)GCd=Ky%b!&LnIZ*R3(&p~v$n?DPa=3D*LZHc&f z2h9bSoN#q#jwy1GDBp^qK8Uu8MKs*^VIsnsELKfTINOm&b_9rPo!od8ru8Ko#b=&Y zSl8`^1y+!4CkU*nWKpSyNmGzy?!-YzAGf%gL?tr;j;PrIyUxyfp5d*OTnF=8q;~H> znO-QyeBIb1Il{iM1A7`D5*a#`cTS>Z8(ug$Hn)3>M#;{5hd%x~UL#yQQ&YMGv-wAp zF`x6l808>Nq|Jx&cY{ipTVnI$nsj8LUcL!Vg@mL)OhQ?%Nq%e0<;2J&s=GN+-29fx=?QEe2y!e&X>3y5Spj zR(WYyo-=2Ai&JFTbT7}lfKPRK7@rZLGvVolxse$qN9g;ZjQ;3x5qv~} z%fErYLi(OoF2U;@2A*FhS$^Anl`x!wmve1(Y{^8rJosfFnamjc=HYLZhv}{+PcR{h z`}S||-@cWc8U_`&^DRo4iH7*qHS+-|X+?AA!Vb?-$#Uf`1Aw2cr*AU74!h<5@d5J-{}&|EQEQ5VabQq0L%@cMw9$*svZ zrLb=Bs!qgPiem$;mI{V>>G5`T23@gKcr}@9^op$(!}4I|AY zRVvs$g-7te;5`rTrZ{Ka(sM`T+50kewwQm1Wd0)OyZ#eh`H;QhWvMq}g)xB-7ck~w z8NF0CYnu_G4m!9tlacUId`5IZ9M7(>UGXlDq4?{VqV_x)$2V?DIMgvuuvf1xKgCJs z;}SXbfbs~_!bUh#*aiX5m*fwUKXTBnfD!TimAZuGasM6deLe>o3@y9yEaG_i2s@oVZUQT z$$MrQW6kxnwSS(oS4q2=5^dzfML8g}r4&N6l|ppa#MLZR`ozt$igob!C$pr0W(GuS zOQPfOcSaC7$g=CjGz(V5yzAkb@vueR!N6OC7*?atK9yfXCPL+A^J0v8B*OZ$fCi+S zzkfzn^TiL?vB%dCKgSmCBL`gbhvU}oeLgWSG`$T=R}=}!od~QmwdVBmUwIaGlOino zWl(ueB{zw?*XV2BMdDZ;KI$kE3qr!;j_aITHP5!ZRl;e& zj&R2|lB&%&@vW1MP!igBwOkdBrtc2x*czG?Q_FJw)h9|1B;+?0njeu%I;=E%YkxX_ zt#EZ^HKFMsRNOp2J;2gYniaF`UZ^o3M^b_e614u`Z;uTVA7e6M@XY z^Aa=rp&i8Z^70;gWrllT)4CMIpkBE6DP6978YNgbENWJ19jjBQiWj5R%^T@eYAD|} zu9f-xiTQm#IB_&Rm9uT|SK>%gw)NHE>=9F_&!@lcA&xw$RfG9kB}B1WLoHmlD&dlk z&lH@x+KWIABiceUk#sI`OC?&-smY}v-BN!JCsc&YXXROcrNFZ2M}^57f=}h@3kzlD zmz+NfzJ8UL-oHEa(juU4jP$|Q7dHMczDuL8jXK_eb&5+)HXQs;HvK^zS=@7hPkN@_ z;m#Y_-bQ?LGuo~=D6*_Qvhu)dXgnB(shWfRr#c1p|lZ~GA}q3hqs6f;*{7uZ`c zgTFx^w>ZsU?N}PZX2%Wka&f&0!ip7JHteEl{=$)1-7$>0%l(puh8jP=z|Od%_+l(s zA+tX15C8tI%BGhfy1sL-KuV~zo15DbW<<-A&3{d?1vmKfo6^FnybUp|n`+>Fw^+j) znYj0nqDmuthmRZ>jO;A-WN$NB=4Or{qitkH8CmNsF`0>p#4-*Vxk~K(yObVlIai1P zi~IIkRxgc2nuxtPieHsK`6%Q(@H>`=O{HpvP-EhIclJ@W2AXj3$+8+CAu5c>F9c98 zKyUG0BQA1CK1dbJ%$H9a)x+<0!)xU9PVjl>&fOpD`p~$3LuxM!slC`|Lb7mbF-Vxt z2jJ|Xcn+f+(z>)INnIg})KC}Z#x0irqT=Of+cAt}85EYTb&KL2t7vURD zpj7ewJqOdk2&Le=@UNdQ0(uhTwqvXMZk|wS{18wvgX? zYdt=X;Hhie^>T1X6d9M&l@#CyB!l=H1@-Xq@aZxUG;f-1dPQ4?iZYoC2J8)2o%__8 z91i*|u0^R_9F4{f{Paz~u=$3hF0UxQ%7EKRuou{W7P;7NI(Bz)Ynn)SYF)M{ox)qt z5k$Ys`#hpCdsa;I$K`?I_GSt@|3Tv~&$uk-z5HC}41eXEWcHLV`d-q=F<~-Pfzs69sVve9mKIz$X;HgLd_+cAtOWhP{<#xwE=?FD7Dt zxId`w@@j?Mr!j^yJErgUq{5?PE1MH10S{j4pI555M82+e362xK za-Wxbcoj?#`N2_nB2w39rE)dPb`q8wHs{>NEU|6v^0b@wR_65$$NHj`=S+BeVMTHi zVF}vIViAVeQt%xyw}9Ttfy#B~SkOClo{fn5WX?BDUAFIwIQsP+5_cJ4*K9)X8z64eqS<@2&oFi+5%d}SAhtaapup!WB zElD=N7>qHS=+f^gw<6`!du`NXw|rLhB{>0n4ttabqPdRF8euPL)My5i&R5U5^!HUb zbaD?nVJgtXcJc6U;U`K#rx(Y_6XI{7n(dcbj>brkd6rAiA!e!My#MK80M|9HFflQa zaf^Aup%qa-+Wk6gYjg)MsRJ49sFE@Mr%fS*cujEJlCz)%YK*+2^|6k*=4|lVANU|MY6( z<~ZYO5z6$nxgi@nAXoa6kv(WI4=jqr>RJBZdJ%>}pJ z9w+73ZNzy<+{Em7t+pyt_<7CB^z(a7PGJ}SEc|h;>tf&KHI2FK(DOz#)lHtE_tr+e z6>uzsO=^Ke-@}QINv^3XFlEG_Y4n*HL7c*l%#37(L@{F!ob>EanIn9Xm()cc7;f!H z2qz(9g6a_tLAk@Dz-mx5ij0|=R-;7NB3+Z)1(U6rEd<4&C2bi8$EJKUi3u!yr&IFT z09-3!VP@tim{*0mD?3q=wZgMC3*;{%XC$ zg448*;L)aEQ~YvS8wCN=GABN}r}i0b=4G+hoc#IoF5R84GTXI>qIE-$u56HcjiP!P z6Zeg3C58)#=tboE5cp@2j&2==c*M#XfMvLJ zG#d-~CO!1uPft{fY>^5kH7jCF0)>d!>ZfMqkhbN1A)iK@D!am)3F zLakj_ygr+8+sCh$p0-i`R+WN!KVhIw3)HkuGX_-}J2{q%8_SK*2k@%Y498JG(g8SH z5{(kGA(1#!#2_iL<+WuDvK`-l4qGg!y*567l9nZl%BYjceR|S`rRxZIaX$4hJK=1o zMDuo-{yssGPAm@(XcPs5Rla|{Ih_(f{PqgMS@BqguK5$2C7v$VU3|s@ zc(V5PN_*?jf#EL0uB&!~#Og|*2MXRvIJyc2wniu^$u3$yipGPR3TYrtkKEm>L>cY9Gwqb<1}4h3SKS>LDkV2;tSFVJK-q%) zZJ&I(1 z7!^c|z7xQNg8{|)lM8xB)NR{VcujrYkxpNxs0|GSNsAa~b_Xqe4sQOQWeNsSVM? z@>K-Qnm5k!^^X!*RE$1Odhp_{tV`qsnfM#Ztnmae@>gHrdW-$_y|Vd?>fptqU0M{# z2wP(5!=H)ohAg^RsjeV22=ZQeRd-@QY_5uJD+)?_;1s?k4HN55O8&VS8K}UxhD^?? zJ3+}=nU*d;zBOlkMI3Hd>`sm0v{6ejQ7Xg13;6QW4AE7`kg-&F3+edCFP3)Hu0Ax%DL zwY2zH1EFsZNX9yGCu%(v8@0TkSisfPOVoD{_PB zPgJZgpBq;_ikkJ~>m*hEk{NYZMo2pabCkXE%JM*F(mNyO>1obAnq(!}aXl0Lc@CTN zus!ETcwEd z^dJXFffZOw%QS=Kx!7rsZIKn>$?%0CA*4agO#@Op2z7@~e`B_baS-ix9eE~L+$%;D zh8hfeYJp9kBo==wY@z}M0)l=m#t(De5t4)Y^S-_n6y=uJzp&-jv~lZT#~!%elMfqH z8)qs~7Q=YG-vb$QDrP>$k}pZRz#4+#xK=}?IULm!9q>u<#36>rel`)l!KM{&jeJpl zWCeb$bcYghYf7w8_mesQLOvfY6wB=hb>yZ6vyd~sN%u#IWy8cfCRjHuwjK&d_Yky* zM)fs7G;=@#>f;ITiyJIb=N@9zcv?MkU%+e8Nn_ zrf0(I_7r5LtNHJbQhEd?cqGNH8<~CawPPYe8RUNwlgY+rTcR+DPK<&goqE%wPZgrQ2IK4U?8SSXr(fGsf-YIGVFXTA6>W;zjqB5qT?VOG>yU%{VuqBya*9n)qy3 zuj&cm&@dO5;Z?tPrt%^{IL z^GK}jCCX)vz1&x-xw-(a+{v$RetebC(^>#w@Z`=jWGJnLGI?-u_$p4u#$vEg%ce^I_G_ublWN73GObE}^PK@|NUg!wFrV*kD-;qno!Wfv$ zovu22Mi!wPk&eBZ=JmAW^y6U17WBA~tFFQxCwl(pmx-0-Y;F~eS5~zt) z@{o$l5m!+crOFUy&HYR|L={3xq#hr4n;7S*X|_9Xr(-<-ZdNEL!}BCmZM|#VysazC ziqFrWV)fUNwASP%)qR1HAcI`jIXZf@BZj59&%GAjyjk%kG9CAjG*X|{K)E5`*07VT>?V~O(jLP4d!T<8Efcgz_K(i*KDj%djIOjF-O=(9{JRTGAkg|8t4u;?#g zp$?Axms_*E<~$GRm1i<@z9RWPave{X|BktOQ_;A?ad&=^_##xG?8R$Fh6WDFJI=*E zUw>-xuH{ng5lDYW6^tK#>8+M=P0Pi^di85$RPkJt4(KS9JU4(1=w{=>zo%p3TutGV zQ)s3RYGV&p+7RFM+v-dM8WT#gS)2hLPiMv@Vh`1Q*yRyq1!cDff>`R@1}p1ShTlA1 z&B|=rcD?`9GkBZeyLlg4!2e1wXzt7l0ylh9k&b4p{Iss7?7e70JJ}wg!EV6D9TtwY zwtC0{AHQGOB8xy(Rz}AT5052yVp==PgO{L)j)a8V5;U%rj}S*g4(wj&q-cN|us*UC zYcUsNq#|^u0gOOO%Okd$NVIf@hqut;;_2G}23Ov&5e67UfjeS5oP3Z4Pw~U`>1QUY z0yNrzKr(7pN)<4S533)Wd*tfK%5{Kb0otJ{r@EmGY~Hr5P!-%@G$EYS_C-=XcN(y# zblvw6J?KS@H=oa~M{ZR-2WY=cejp_yTUIO$k7+nsJ_k&g4IqcB-s;(!+c6ghZ2P8G z=qd=@YM6h=@XD1UnF1m?PNP?ndK!kq#gP-7t3Y8eAbzwf71yoS4TAw@NJfE8Dvsf> z*2&yh$EG{k)XUsVnR-%*%H0F!-V_IcnO_Ip_7# z`=7dTQ|Ke|OC-M|THmaJMW#;1T%(>&Cy|hvHV$xro>9wO;U--RT4?b)J9YG zg%N@?!5i}O%vz#`XQ)Lq zglN_@b#lW>QYlqt0ba56b-WhRBn)}v2vi%RS~6>O^Tjt^n%Q9~VNpnG7Sxzjs5Yamv!Xq*NesB!tmH4wA7qsx}b$aKmyG9cQ(Z>BBUe?-$vD_^TdC_ue{oUuD z_E{5PuadJqf!{ocBBDo+$La7aRqh=T*`vEyN8~+&>8kc+*(;w>`S=I1dO?f!^yyN4 zs=vz!xYb!`)d#~&$OT?q4EhY^>A2EcI`M=n3@c^^?&wQ5OUN(_=>23Skc;EdNo8Xv ziN$K-N$&y#))<#;YZOT=CXNJUjlt;PnW53ysaet4*3P6TYY&yMXnvP8{%l6A3Jl&7 zMb-x+z+3z$rE&3KQSmjobv$)7=zpmfX#9)>>YQGh$)AlR;DKVCbx|lcQWrdni%}yh zEG#S=6^jYW2K60y0VuyXj2XX*VXGUye2J|p+Lb~$NoKs4X8I14h{LMr4+>zsP#_?d zc;zEfZ%O-l;w$HxVqwTrHr8GNHm5t;l>v(Er|%T%gXNO%yssbqBBi7dbz3E>bq3Zt zLj!?x<5Bl20X2B)tpHFV!5}(!O{;3`106vNEQ#YTPDq)9(1FgdHrFm;^{XZnQz42&)CH#99W{ zX%oc`^f@D;rby_suaH}&wbBjlNH9O1m57%)tx`p3Sqz1{Aq?9c7wbARN5C|jp)$@J z_~4Hab?Q;cYn272Xaa(;9{d2Pe`8XGa`-Rg#Am1ceS11?!-OwG4sPFtzrptM{st3P;;9YB0l-cy^QC+u06z;G<-& zBRrBJNd-x!qt0Fxr?*(^;|IcP4$lJQr5`a{$=ESV^Ov`jk6JS(y`c}dP98F&49bQLw+v)~MYL*%UZABOhKdAy|Y0J+=s;|y(c7r*1$wHm@ zya+v@HCyy*q;ISUx$_|n<>$MPbns{awEM)5-8W694n+6ei`_r0FDF>&N@uVs2<)YwHMM&S2UF_(W06(m z+`(>N=~1+?tpUk=CG}*i8L3)B{l^fQ8<@woS!e;Dv9n>>XXV%Nb9aj_k3v6PmGImD`(l4ODDR|M7J48okAt zZUZ>WdC73hBRng7F(^jX5f5#ss|#=mO%18kS^qg zn5%ZsPR#|;_vGgH@p*@p78|GIK+rFA{OXtiSal=8qM_o|#H zs!iyIwPRWU0KjM@wq%heib6%NwN~CjP?CA*`RR6yxge*`N3tdyi<#1r6qMrV`9XDcU7cA<*MChZfw|I>(UCkO|F}_A zcO2C~?~<5ELa5>RsL=Qd|9De}OT+(J4WuAd*H)nf95%BN4r}~d{l6I%ca+9|(yFvv z6&k-`{6?VvSz-iIS9gTU{o_DaUtOJgetz-)>ngWCn>9x0Jdv`mX?a#Ee8N zj`JzWUDeq3>|I@JW@O#8tj8^}(u3cwFIOB}d#12pXm-727CyEa75xGVy(Os#$vh8A ziCx@Rk3;CcJ+W*K&u zedatY`rd&aLsg!0ZZ}t66gp3SzL@{{R9(rdZ;(pG-Hpc^ZV;B`NM?d6T-rldqegV}4QB*Pe*IBhmDE3%a)2kQBdN8&w7vP|x5gxetNti^CHLz8a(--)daCm&i*d@CYs! zpF!~BiX#8l!NQ{O{g9yTQ09!0(Sz&`w*)i62TKQWesQUQqaVf{?Z6Y05g4sj~ zUzX!?aM-Th(Q^NLf0tLAh2yH&yEZRGGkpEmA$+4kY~TI5e$CU*1}tji0eE!6<$@KQ zImg3IP?|z{aZh8LE!IW`?=N)K=YIk-;^S|W2PGHPgWP8(eQjM~s7`j->%EymRJXTb za*?>FQ(zTxB*t1pnTjwEoE}lxG8O`e@(u7uWIfTqd9B-iak%d@<+Dr?C*v-6kHGC@ zD7>j{wP86xAJ0xaL^OLeiC@>%7neuk+0wkxBA;Ww7_$&==Ep0twwpKFc}=_?_Hsmi z0snGZn!|^G$z_}{`goW9eL|l4n$BZwF{S6&M#rj{n1{nPza))0OfMmjL_`Drji9C+ zQif=NPZ`wnl1!Jt8!A*^A^Roxx+X7=t)6_?ZJ2d+V(KaSlle2m==17rhUSjD_H?iG zd@?RXoFLB4!-O}==WqY4O>TwKUA;w~`$(flR3pKW^`MNjtpF9?^yrw+XfS#KY$&om zZ2o!i@B95>s-^V~!9!>E*7h(Ececa!FJF~Y4oSQ&CZDnfkh;(B7I}Snck}Dg2=BbmiCfaE|J{*`J_|DPElexd`x;vl%`8GIT4{qgToJ_xS#zeYId zf6ZtIX$RH*t(7`Mif2Cl>jUtgCI53rJ3aXyzqEtYI6}OR#y^t_dJH{1RO->rjFL3L zZx^5sBnPOB{NwiDdgT9eLfE46&rac2(DUKf{J-n}?khEp4(*7uM#;l5m6+1Hh0?mA zvY|@1`4#j+rJEai1wFlxRay?N2jiphQY0aCa3F>Gf%aS zH849@R#>U%XpXc*uc%qqND(fK}<7=1D z2Hom|wjO9f2=T9hv}q9ds3e3Bu8xJuVeldu{fyQwi;567Br-;(t}~?h*?k9)LQ5`} z+GQ*|<))HTbnoyt@sPg>9Zz%|tux9E86`0ZI*v%^_RX;!xC{Ck8}pH)u9;-IwOMcQ zkLT533f+&t-;&EqDhOMD1V#lmfB`Bd$5bE=KIgbmdGge)7qKmyIfb*cR=U4SOi07C zMRp2HN@hvx1U|GqpSrORrXq^`mNG)EY3xRs9D$h0YRL+FyEvAZpCz&`XUmUey|dTu z@w3hHkpeq2n~1k(=HEZLv!i*YXMgYjmA&5#6wNt|jCcd=&`%n7$ zZ~l4U--D4;yBvX{ zNJR7&bc#&5xdG@NsGJs`@^PpP8nnDE0sJ=sCxaOWJqj>+ookimrjaC0u8F+!azG(} zJSR)BXxVMvnFS!M^6oa?oLJ?btlXj*KR@Xy9qZq+??;rBn1uo6=K(s09H*MZC6F+{ zQ8u=0p4sdlsG||ds-y?VR7%r>xbUll=K%_JLiG4wCIH|&kzy5a7(mzzR0(*; z5(OY52m=Vc2_pk|!3o1C0P`YYCDLRvvIJqwB?~5{?R7(5vMyvAz(yQ6Oq!X+O$dN+ zW>BlN6e&~7AF|*g0*A4HYybd)L~Mk1MX7KqI{@E{Q9>)U2av}fBu^~xO{F%#pz`7B z0gZ+VAs|vkW1(bTAc?SmC#a^n_Bgn>{J!qta&V+}ZFR->+k!O+007A2!IR-$TeEJM zdD{?iTeXBj+IgYekQu=un;%|f2$%;i0yETACP!7P1b}eDAr|*AAe;a%-H*l}Ax#vT zrb<8^pnF`aiyvO%8kHX8)ygHAUjoAE46u>Bh7=I)5&!}&KtjVqt>#9jg00GDHXofX zHV-zat}Qp#En#t{pc0~>GFPoCE?;(&#-H1Y3N>mKY65_PAy9hQ*?ft#wln>CRn_u+ zbEQ1tJ!4b+QIv30aRI1uPjJvhsg9!s1H*@RjG?;dMaJ{TT96=yhe@?(S)3d0ep9~z z6tU>gcH}(WMZ}g4zcZ3iPWvEb?z*f^ZTt0kDEN(oOvoz|a&7=+4Nt07he(NB<##4N zZTEE342_CB;krZ@o&z%gjx3!F}~VNCk8gG?~EW?5)*L2`2TmJ$w`x*FwZDRE=Ny z{BZJoN!|FO^WFX1*!QygOMh<7zGeAg-1@6Q%%y3g`8sbr^vE$*_0SJJ6nSNwSDus3 zvHJq2E|_*0NWth8a0~9d@g3p9PQ8jv5T2KeOshT%`3Rjon}A+EVRLMH+s)kmJ)&$#K`)c}Gi$POw>5sZKdp$-I;&Y{9wM1mq`zYy9|FYb*`6**9oI7^tePsIFZL<3aQ!h%Y#%hUK!=#ji zwsNDhvd$oBN*?z2^yCK5OwUfuK!=a}=BBr>6mzu|-OfYl-gVPDL@L z5!hVtC_5`F&3E{vBb3KkNc648YgTKO2dXVSTOHrfKfXgwx-f?J) zjy>!-e3*yc8Ua&Mfx3?_ch2D$%w;lp)*Gwtk--Zk?KM00XzS1) zA0!ce4*&GzJ)X2k{e5TfZT9*^r5M2e+d!8X_{Z*&$)voOgbxoJ=czDD@%yqK&(}Q_ z!LLj~6RE7N4J(J2ua@Uyz$7}j=*;eqT|Wnp0mWRm!+M{6q*P{Fz4V=!n_zU3>N40J zQ6z(;3ZElPF(fQPtl{R(yxd83#2jF@30s;$#d>tpn!vm8uF z+Q&;)a&1IHkUe)?srM;W>hI~(xFv0&mtnn<+%6m1K%}#K0ki7@UW&KXanW5F0w#1oJ3&-*5dF_t@ z+g_~i$YAjs!P4Lqm*{534x8;KeLeP!?N6+IJ!}*_)7DD9zU!@dQ?DH?GgB{~t({<> zZ`90gm!*(=#Mb(j!E}%_JfP{W&@N`e>n*p1Jv7FwcxUJ34-fAzc zn1B~k!84en#Miv7PU{E)KPVxe2MD8Lamr?wkpM%ljz4eggms<{n#rcr zrYxjnafE{9S$*~secl<$LGKXyPrxwg`fBf!C{yR5#0Khvyx|)b(w~~fO*SHXjllC& zl2xm+ibazG3B>AJF<>2{LJ;oLr%_>>052c8!22^`yokdj=|I0sOnq5Mo#pppX3OJB zd!$?(FfT|QQ5AzZ^n!^=l1lTXQ&!q(HA*iTIB~FwwN%NARlO7P3RaYypRg$c0&R`9 z@J#*x{}`Jxn@Sw)LJF13Tw?B*6+RJ)A_=n;LL<4yG`7k;xujf{LRWLiCDLYYxnx2u zq`5Y7zf<(z_y2p1^LRK9yPlo%e!ZU0=j-{(q-F^3e4AvNygtsH{ulS}1t+9)o^JH> zCds|aA<-hjK*$A=vb-E;y$H&<CFOmAFZX~%FW=2%)JRG z2P7!*l~-}$ERB65tkcf>`n?C*i_$n_GQtw(kXJrBBIEUmRfGrL*>?LrX?dp64`@OU zW(Qp;%Wy6tGaJN6W3D6zH(ZE(LOtrXm11#DtB9uCV=M~w)+x9pQa@DA{h6qlf{=vF z;b#v{+Z_GR_oynp>yI0;E9l8J1hK0;i}2$Kp&p^R?vdG7OwhWjEp_j3(gW)>zbSpF z=2;H+MZh6sv1OSahsU~ilPoZ^5L)Gj6|N{M7u3yu>QKzuiGA^oD1(0LXzeJNB(Zz$ zBh@)H<&Er@+|J+CPQe4$C8J%Pwaj9Q_hP;Fk>X=CiafWmKEy@#HpVygC#f?~Xt>Ol zs?1mwOggUj^7K8pE<)_kX-E|>vHJu z-*&*m@IsBmIEDxWs(JSoSC4Dl6=4W)$GF_9NMMw`NL;(@f}b})0E_D1Y+f=ah*2q2 z2#q-rjzAzY;^s#G;yIf@@T)%%`s^*M!G;tTZ3457aGWqeWwL|t6eO$-MDG8!(HL`{ z?fW136A?4u!kgt4XnyDI66%(ZQ0bmVd8z7D=CXka3vLz1T?`G!EQTLuQZu&fAm-#@ zt!ycP$>L6+36nlUNT_9xu%Uc313^VVAQJS1+#&G@I? zBPzsvS-huUq0vFSODp;uX|o}PeSw=dE0LBNZ6mPBs5bjgNI-s1;7v&RMlF`^u17a6 zb*;}*C%|9RiTUvcnuZ_TXi@ROBTf7B$1Iak4SVc*$reikaTGxcw9`>rwNtgLQqA|p zRm<}0YF=Mm`?TK#cm8|77xMd|1^ zCu^p1;^CEv&borjL=htfIY{VAXrAuJqsNsy*^q|*d2w72M`TmrrjUT@Fiu|OGx@$E zG)s0re*H&GBxDa>gi79A~6 zt#S#}MItihCAZ2`r+h-`Z~evHH4?>9s`|8|3tv-%0=dHTeg)@@fA4@+(FrSh^v^PQ zE?#F%%pfhYT!$@VV;GOB=@($cIBR@JUk#mTC|YV+${Mo$h*LMQuSIC+hQ8~pw`#XT z2P{SN=h9ubDmQ+yaD5&&X)+|`@}cE6dFs#m((U)Cu8WUK|DJG~%ddlckK)wOze+;$ z6G+o%u__=O2diPOCfz8|9*>-}E!e-P;<`1w{aAt=!d)cfx%qZ2;^awv?5`+sW{;y$MQd8`PuYLYB9uU_@<8vdpI z=~agI|H4tLt5f@EmQ$s+_R*W)q;-~O{&oa#i>TsRZOH|}D!1NBu3P(?ZB@$V+2%zp z)>l+sZd*3eu3)6eHz|Ta*G~H=c=wq*pK55G<(aFLk1&}6%=o8r2j6-@6ecs8LQNgU zb9evM@?y>YSV3?dfBzhG&T0_oIaq#f;IuW^%xRB68UQtcfB_Ts1Q@_Swt?{{c)ix1`%;U+^cq*yT~1NIAO*PiV6nzj>#2wMd$yPyJchwK z?a_+K21@~sP#_e0oJPe#=!u6Uh0RFboP}SP5tTo_RK7>~WZcaYJ!l$oY7HyzdWi0S zcXuNqk(43%wRC(_a|4zZ+Cx2-`1^k5(_euN$UQzoZGGyS6aNMI%hWv-I&|=yU?vHE zDl;8tDS&7!`?L{b`f1~z)t}q7IZY=q7AFJlQWV(57k}x0zWL;To1ql!IRA%&z1obp z*?qJ7>zV(`r*EX4q&5k?++7it-zT@H;`uq77w0|7(@nND(N>#oFzlpctZVaW@292t zNK@(6_d(mGi~J-aKGs+^VfuddmdA&-CB30^_pG#+jh)Bt$8Mo#q72aO+xn+?E++m6 z_8;{1htEuv9A0hPI{e8kjYZC!D7x=VDbfNhR6I0&v4M@!ipg@WKe747`_mDRWJD2n zcXG#BT3X#mWvk**d+O1<2S9=00mz>r>SqOPr5v|LU}0HHsO z7Uu>C!z~1=%)x`Pm*)98dZJ3G(P;@>lpmngvA@^J#G>!fN#Q9okPrO6+>Ak=-~TA=yEK=noc-zg?+~}Tm@`&3hdxS+W-MI1wGDe=RR2-iv2$wlbkIx5EivBl zV|Mm~YRE>!J@;&x_Nl|Q~M#)myA~cYU0dL|hB|z7Z->sGeU#HasZnRh zmZF{okZadjtU2lQ@39z74S4^^+y-EDXl2CqUMWx~D;O@$jgB}hai&H;zg6<4#IuRf zVP?sqYUBsd@m^B+H8om@IJxy?=|sCud3G0D?B~9;I8xm0C&=>NQiGOOyEpPto16Sz z1K3ou#F=)hHO;;fHCiB|dU}yymlN|qt{{hJA*FK``sDE=jAuexZ;?S{RPFR=TXE3j zlWWk;tJkhwulQoqv|!XWVEReed>?_({Ny4!?s1jhLe$1t+*C|y@ZWRYQSo1vjLb$> zaSr}hB9g&YVT!hB2s8qxG}A`R`j(zXt(+KdT3LvJ=go%pFsJ{>a9iDiS~X`r={u`S zL~}AuxV}B258=5B?Fm2siXJJ#bnbKC7P09>o0jYx_8STxGFAz|LEpdy@27L?cq59l(V$$`_(MY~tok zaP99AK=en4P}v>a*+uMuVQkEJ(Y)VcxQW%q=e95=3eq*#7iKX_3^&CyOgzqVL$W_5 zghry;n4BFdS)SAkdnOED$7a{(`&Ue3%)@o?H1daq*xK3KU?2j0X&`}_9rkY9-b;OI zLSaHe$sH{|Mm)A>Aa#@!^feN-pt2Me;`-g5tq5g-0I1f)MJzVxbI>=B$gwRCg(V@D zTMAbuWOjK_lIyz($76K3a0hf04X&fu6)(T?RYE*BnrG|6(WfWelJl8`4Ah>G8(EK& zFc$)9_=Quvr&_HFQM}$%aCY|JeUom5bn(1Vj+qabdkpMpE%*7`tD*}f62p>Vm=PAJ zNZvmZ)@HfB?k0K>M8W7=H^)JuEQvPf?IXJ_ZbPcqyFU>qm@hrY00alXuJ+I#&8Oaf{E z=<;hYeyKHd=Alk2G=P=_)<=lzn%F_sQY1z@_7%q7?yQu!BlSg+!flps`*sbq#MTve zC|&bov@iRIVRRy`fjtc*-MID%PZ6^%sKB@HlYYUqcR;;$bGN&UhV?jv;j!Ugx>Gwv zg}mD=8hZ;yCa)meA?92n)*uTBqaMu8WhK(c3uxSC8;u)^Kw071dHg&W*S>*(wUzUt zU~Ra;1{mx-Hv(z|$G@WYN-x9O&N8{gP^2@63|Hhtzz=e-wH>^isz`1R#iFPL_V&-5 z#k@Bo;L(k^!NI{3dSTKJwVVmF`^gq#HWu*kw8%PyoVa)uMW|KEf_l@dOHAFU^3z*v zXURZbe#%epp%Oa;v4}u?+Ac9%B&;HanSR>#U&b}_2NLmn15#KN1L8D3Ygn@wEfN~G^r;;ZH~)KqSo%HS;)=?|Kow=^Tf#cb~#3zTO!(;FCc zqh!ieg>+wEqGxQ-k%ZF)Pugq8Vl3<%+7~s&k`mz@hcPo3KZgdg_M)0$^79s0B zAqNA&{;FElK+U+-FcNKz75`^d|7&NyWeu5{&Rs{M9eD(lSb1+RHGw_*%c`%EVw9>F zzmDO}u7+R(;2$U_-iE%=6iIYjxh)nBju- zYWJU?-82T;N}DUygd>nf5Lt+abB+DtOnkiM*p)+QELg!aAXM*|^4K<3d!6=)dFk4)jwCk%P5ep+u|79wGDoS%jhICR@_-o7gkX(HGQKXeFJFoW>MdTgakJr zFkAU{sbE7ap7kjtI*9;dnpGWEmlga-8k;d}HRoV!YjPD}$rrsdbYEAnee_cniQwK5 zt?KI3oIW-T0hPZ}L>j&hJ|-iF#LCM01P}T9_E9wZdP@}jfytU8pwA9+28*bgWTmqR z0lJ#>P(rq9FvU$AW;x``GUEpK(F%1HHXg?O?o5qJYH?`D~LU8 z!Y6=rrg{j~KOuj?t0Pj5&+I>ooKp}~`M z0?=d-kW7yIYU7(+>zgKrdnJ)_DS*+MlK_?V+D9Jf1Gf%iETGO6$tiA7VrxEm7_OBs z&_}}Fmc^38c@tV%?b&aW{{x_xs9Rq zq^_=EG9TOi@FOvJx$^<98VYFgD=AQkcx^z<8GYh(jsg+N*VJT@`q<;JJk8>^tURjv zIDrt5f-peT5wa=JaC}g;zHc#%Dy|X=`? zRp}-cXOI7pji_MiMdN^Cxwdq`hvZ7k>VS?bldgD96#@w_%$07Iyx z3=z^x()-@>JJ+FI1mKTV*iiKNlg6;7jSt`Is$0e3;>oGz4EAPny{C>+Gste7^s-%2 zvX8bs6hS@8ULDr~&rYX!`&PjK zkgYX>8bJ;DOHmAyf=n!D^L&;Y-i8{%_)8amfy%#5i%K#?rYh2yR4^j-V2Ck)H$UjJ z5qpHV#%)tPhf?W1@St1vj`x(}Wp}*SNU!I1{I7;+#a;Wl8&^*n}`|nUJ944aNDT`QX33Fc&fs8=meXBWtFbP&q6f3cZYL=bY~7bmIxtLpMq_F(EcF&AX+I?~N*`)wr1z*PBM$v{%i!1WE6 zrQ)j>Gqk#HydV9WQV?)Khs`_7yej(8LZYw>9WDuUS4Q8vW3jp zYJFep5s+SXcC+5V0yHFGC|C;!^&09xiF?bM;hLd@inb!44H`nAXh0w$l!vYFHB(y>0mv1Sqh`3*u~ z@Inlba9kW`c0=Piiy+JECl0?Rwj>b%21aUt=H~bz0vP^ zy=^zW9tJV~WArmM+>NLzW(^pN#nlX|^uM^?e^lH|`ccG-!w<>~k ze<5WGOcs6_)%k<`sc-2asTP7H4BHtul@e{zo=1rUjXu@+wcG4;Hh~H0a3L~ zaoxQbYjtxi@NHPcPCDcmb>G3izsxsvcOjnw!pCzj?;X5*ku11LR!F-qe*6RFb6m}} z1s}rY8*&n*SV12k;ipoQr5p#Rc<6H31=L&j6f-Xgwvd^w!TY2Wx6MlzbWJtinLz~$ z;abg8Kb4-;K~(xSdmXz7{+?eXhXVN5ApYeOXcgC_B?XU`v-o|4Ndz#+R@QU#gL)Y= zvbMo!8C%h*cHL67&RbOhq;XjH*PDLX{X%R}0Z-V@rR{!h!kJUxFw=hM z_Was`PvO?!ys(hyo&zIcD)TbkzfNQ@dWU<%!XRUR40V==YIknrv|=b*Hz>x(Nh-fG zL<$=kz1}WZ>T8Xr%68UH3CYIPoJ);v(unpOKAJB)Wl?xf| z6ZnyAq+<}k3UrzNUKsm~(^skX{W-BMd%{%d#}5NAhgqBp^bOFeF$A!<<}=gVu%&$$ zKp&Gd+KDD`{+#E4{co8<;_cB%;6SdT5^{e-zv6PdhKAnt`b%!k+Mg_wWihbJZ4fz1 zVJVu7Th2LiIZgXy$i5$7P0jwi?PEd#-#%PgiYN zVYo6Z{47N@`mWEXMEpG;C-UOqjfdLu{Ulu^gF ztKjK5f6;P$r9iNYkya&V(`sY?`QQQa&G5lt9iKLh+6^?l=8jO7*-x&0h+(?^fi&eb zen;8NuIkeBa>3fKdTjw0w0_VYU*?cbrFrlvL9#v9ywSH%I0 zY|a%$6?!@;;O5M>JF=wfyWAvIjZ&^imSBZAU=7mPu>V_@Ti`fsOpv**=NNlD;yiLOOevlR3QVco|twmnRu0_lCRBA%0yiAc(ncK z*YjV>Vww;hONdoE&Le{f&&hF1)Bj zQSuVr42iQ&=WSWuoY=vnSY^rrRLf%#X%UDjisiq3S4B&2C3gu_SKrrCVf;51iEi}q zGIQ}Vc+mTR9HvZMHK~w@SLMv0`1TF~I_bkIdx0mu%|Z`#R|>0YCiFuAGp~;~54KQ& zix~+?7vXx3-N%QE>QB76>etyqRq|=5a6WFMTC!sN#3{6Ee(d$rC{0%aAcTHGPK$xi zExy@?ocwSC(lKKaL_PWSh4;&W3>Ua`$Jlg2l~L8YZ|;-JRf@o9@dFGxHz8R${({%$ zDJG5^Uj3`upAXR+kJ9`6Ph-qTTjKCR%aK{%p7;m1%@_T#=jae~Op07EN9hmCsgL$t zt%SQ{ukJ>zot0HMsf;u-a9918*+(T$MdhK=TZyCh#Ny~XN17Ajlzm*yiS15eVpPT_ z&espKlawOa&&nn3o6)KLQK^-@#7E91BS%f2_&G06S~ZpiS3K`N9io*5WY2qf=uJoU zMCytiD4z;}d-Z627L}5dgE}Re?I#*_#Ni~yqP;DjfkqCD1j#pR0pLH(>8+nh;h`EM ztncV&1+&Wb%kQnsvarfY`BN!Z&6}}lD9dM@0HL2bT+WeNE^U9#S(xV=sAK>_{7}G{ z^WP2w-E2vf&IW}nu+TlyOrWTgZh{Dw{zq5y+u$Ub(+N$W7ZFdQ)?HJU9y zGw1|+Gw+Q|=~fmoMrc+ll-T7b>-OPnL$Cp&7~)opT8if5{;2VJ%V1G?6)4U# z=)heIFP1t@fe0`Mxiku)dg*zc7^1S2_iMJ5V4LAXE2(D%r<{{&9T)7(uRT1Fc^ti&9 z(dA5a*~Ym3!Cm4p8|Bl;xCKl|Nc3Kr+W36WMI^Y{$W@%wIj9%qnj)VSPu(x7y65~a z&(y(>5{4z`gmRs2>OB7r`ap=DlO^rpa;<&gii`3Mw=~o+&@U2~K&1**7R~A>`|(*4 z6d3^6rydruHOSfdhB>C3LE8JMf6yT5C=bw*V0rJ=ouFP*Bup{d<|1IC)JG**t=(;8 zx`Uh7Bo6^OI~a(fo=_m++2T$`Gfk4vnp@4c{AR2Lo%d!_1fv>WSbRGRY19(-_qeWx zQtWOS8=>BtF)chc7bc-+bY|2%jGpT3bcVD+A8zPOLV%H7DPCq(1~3P5|L}94r*Z8q za;mED=Dc=P8&357*QPGz-CEn3()z2G`bj@rH}p`|zNd%$`MqbVsqc!KHcX^Xjq*l= z%G8t*wHGP>8H^l6{C9-O8Q#wwT#D2hc+pkGy;w)_{8g5XP@;A(8sTao3a7+qWEy3X z=Hp|k5(!8!;sL{lnrpfkld|;m<}M$HbnY5fS~vHgwzZBNqx{?#9C_Oc0$SoT#^;IQ zuMLo}{{@`EBEu-se3FPy62o9*D3M4Ua07@DZ($Mqxri9noxhkxW9QtzR2mOcrr6G+ zF`0Zs!wtp1e`XsPxW!F@9-Ig@KtcY0l=CSkswIqS!GZ@kCr|*pHX4J6r{XMuRDZ-P z7?nQo8eWRvfU5UOZ#seelSibs_R}i7VH+gZNXt)A`$Heym`akbMhNV!0l#H>SAdg5Ju zxj}@rd!vfC?1zb(pNbQ)@imWpnLYv_(2>29P`%SBz zr`Dw#a#Z3mCbl(Is6g`B0X||G1~2YA#GY}v@pL@pe49+(*^QrFFAKV2kgEp##01by zpsAD1r@P1mg~S}C^zgoiYsnkBDretyWpE&wPAU}9(^AF6F<5l-0GMFr{VYC4^$%d0 zJPAxLxvNC~l=hx)EXz>sl))-&y|=QB@gFx{*k>PAlvrM*hO7^<%Zz)Pi$U3*G}!8^ zrR3~$=qv9P*u9y6))5l*?8QBWsurhwW)_?JV-UIT^TdpX)FRGz4>^NL{{?=(Hc-1a z4%SieX>jv|gL(j(FqQDy#6L9yE-il}#QUkdL>pY-#JLj39nY!}7Z-osN`{sUf(2BV(^DeaU`b+z!`2)EmAp?V2A;$3cnrlBe-&4*s!K?`8 z%i*`tQG|A@1>bf`ay|;Eed!vosiP~^2dGKJ3C4^1ZZxXZdK!;#r_6id2Qc~i5AFnOYQyki$WX~Z32S}0dKcpLWG#SX%$G(*kZSV4 z%u-3LR;g0Vg`3ms3-hzzRLN3>{##EAHLUfKA{&0D?{u^{Yv`%gBZl4iuJ>@X9;_u zpg>uRg1EHWEt55?dPaPG4%m$>L88YjauC)!Cb&~!6v7KU^~abug$l#Qujy<`grK#k z<{5?aMhQukCth*?dYqVT9N5qh`vLZOun&+pzos(dZ`2q#?oU92>iE!@Z3nLJj5a}KGtnGpwId?83rCS1y@n66tj-|1Dbsnmv|3vr+nrQ5}8mr z6D$Keqfa0JGDnxA3+@_|!-hjujYOj~uijKox{MvyE}}}?Axv$bJQ`;V2@|!#azP(7 zM8Xtm&H5*tGR`5B{eH_mY##oQD%{nn;4k(`to6S=r(lcmI4e1`LNMueh!Dx4g)`MZ z;o_92tC2^o=1;Y-lhNW!#)?XgD0sgxGl78pPNzdWI6M=Y66B0l!ZwqGl20>oXK?F(; zyEXsyKFqe}Iw8=Ky74oO%YvH3t)R_0eEu#3!vd{Cv4#jZo*QC%7f;q$8y1k4ic)La13gXX8cxiA2@G5(- zRZui)BBOZ2-eOIJutDvE)RqSX-;%1;^VFd&8+BAMu*)PasXN+EcJ0q z*4N9dma+CJ+y#`XLS4~KLY+f;?+Ja$$j2r}>Vo?a?`9VxA4-LVnR++8g1R%Sc3ibD`^e6wDTtBu$|?T3GEDgG*l+um%^WbgPoPPt1iR*z!I5DZBe~%9s7Q^$mM|BM zTOAZUJ%`Z7Fe^&>q}O1}VuWucX)#iHWPUdKViZ5ON{GCB^`OcUXv9f{lPQ#< z{+d2@!$2=#zF#*_RP0Y4i}sjn_ypqmN2BYH-KpDe^RzWuLam_hweEo#%ri)ja80*I zS`gCWL?1FK6`rw`(+a&!qU#0FRbjJ2q+(9a6j>fmI`^VNo_(5M3jdRe{{0?p`R04XP6@GvCrV zlb9J+`M|*2HbQnfbNF^Pgz#$00Pz6^j$fuG#e|s%y)HF#k9z zKl^~+snsX79}t)k)}?zQnnd@*KGYf^%ofN zeiLGpIz+q``~>;K{TFT-2)(@lp)Cz88lvEF%${o>W)0CGxO5mhM4vDJY$VWru(|!L z?iB>8%#UbH)sSjPX$5ZGih@y{ow!F!_=l9CA{LM==ovKkk#s8*t)crDPivF8U`#7g zyO7G5OP}hNh{B>F^>yqRLrJR9rRw2DyjqE`FUp5wLg~&Okj23t3vl4d zSNkyrx%qHExqMja1@hzf-*Q|xU?Xn{gm+vNAFSp}U-+97a_-hHJ~jjkw|h5l`Ef=T zh~Wtx0e*v>z4Tjw^#S$*7=f{|i)QLk@i5Y^k^^RSsQjs^lF|a{57j=Ae|MF51yReZ z*M?bH@239bZVlDHS~A5$d&Oe!v2`anj16OoqFD$a>0`#V*l%Uo(-2*t*IiRz9Ol4| zc9}2~yn+?GGIe!ouNOm(k>xI4aZprOZbVoD(|Y8YD^TeFyfET1Hh9w7!6*KqBq=?u z&~LlqAqwO}Fo*dE1?&Ue^Sz&|OE*#PJNs0&9(+nR4VxC9HcSi-m(YZ(My%)PVFswT z1jX8#KAl{3hAaBK02iET3(@lgJ;Yha9kmWT&cN5GqvQgLKd)8g+zjpWUT^^5R?{0;QERlr@YEnOyCok9N?C+c>_R z1lt(1^;;GaY%xIl%#_{w6qA-V#nw1H;u1n!jWTwtuWIJ8@oPkXerv*hQd(esZ`xR> z5yDMYi#u4Iv;Xn1-J(h1;p!B@4UtRsify{TtcFgiBuGpE{bI7~_H{gWFYk0fz{ zvg6d|;6T*3j6~TcsqpG69=F2n(>p$TZ{~f@Z0U46PQk51&u;8_O2vUJQ`&E#N(0gR z+qfnlicY~*r2A>iq(qgxRqlAwcf8R4XeGs*ofu#9P7dwSvt&Q>Ns#`4uy&~ zX@at{H5}8+XLS1PMC6>?s}8rvwNnRIL-mtUt+IMX3Vt)Y=ir}`w%?Y$BL)Rs=XF+> zQ-}9eh+eVQN6j_9F*!C$nVA&FTDSz@4y&Q>UOy%=y7aw1nR;cq?#}Zm|Jq!tmPh)7 zCf2}aqU)o3!>%!&gS@bYK`^K;I|3@{xs7a1Im3#((dyzJc4+@P&XTOy{?JH9{88B0 zP~PbBgD)jjhTU2w=bjJUId<2plZgw|rE* z5+KQgPS~5lt{Qjc&oyV)l+}b6D$J;e2k30RKGxEOxa7P2L}BW$BTxw(O3DvMp$auw^W;^TB9Tb6ctzAG2e)T;Hi)metXj&797_;8)C@MW@kf9 zdS?xgR0w_|x(!03#wActmM{tus)`9QhEdJA>!@QPo2(-0DZXeQt+|3e&kZ-)3N48d1J zSrN)9D1(y2^?(ud`2TPdCX;H>w1aZDDqJ-ZD~tfjP7*^jyxEIJ)UK!~=fc@lcWO~N zr>WHlm}M0kX!deu`M69^_d*J}eAbu(1M{I6_82cj9R)@jzy1M~wG#|N{9gB9cW2X$Rq zn>}j;>*r@Kyx<5V)ymeJ%>xV|>A&CSz7?BsS;_ zOl;UFMw-N3HA+d~dalE$mEX~Z^B+}-p;1lL`X=%2w^I%jS!wj6qB*H0xC;Kznfw2} z7Z*q?D~z!5jHH3qu=P1nPar|(peNl$coacjT86_a5DGV^N*(-hd64*;-#gfUI@b_tZAH|FuHF(! zGf$V6_}coiW3TeFyt=q8dwiiEVwfr)N{5nFlgOU!KYyAkTi**ndZd3y(GEGARyj{( zvZ&cGpjFS`H>LfOUAKuk0_&|W3sD^Ft3+rf5l`xj4imCPFUg{MR7C1Rz9_5WaA#ms zpDiB)tFpMFYmUTl;?3_gI&m-puwbtcYA0Fdt-NcOMmM8PHSWFZ{~@O(b7m%DoN(=yQ(iZ{INe6w?R`oyzUEhN$zy^~d;f6L zT`9mk3wZ6H&|FyU7;tl3)!0MiX5Hwa8#JX<@Zys5FVGevU2i9Vyh6ubfws#Krup&X z=eNF|8slH&V%96TjKdNrP6{#S&?VRE5Eaj&zPgp++f}Nri|NHUJb_X zsU2AjzKO3z7m7N_^Uq!U9hTy5{ZS@4$4v%({8S=2F6d=UwH+maQp#G2(P;kbkvL)c z>ifS_&;Ps#kV?M&t=GU~G$>13c^Yk=^37jF@IMt$;c+_Ab=LAP4+Z$Hp`}SbXZko0?A5s@QN9b1$@`5CS-|`Q#de%i3B0k7N35lq~WOpQL4f!L@T^1QAKt zt&ZjXRTtY5p)Q$77Hs2a{5Br@-NJQg0*&48xZC&7dL8yK6lH~kT9FxRUwj{!&Mg~+ zRFX3>EzWWtz8O2HCz+SkM~@c=qlWIq~jBKvu_ssI6 z^{Vy>ZEfr8N3W@D6g`s+*ZABY>q8ZJxbF`9uYx2SnOQOcr`yjr?!KK_E>Dq?tNr&g zVl&)roDdXT=H%?gO-qqWC*P(udL&b+v3RP$Gq(9-8+tH zLFy`xahObo{IFRdUJ@y4?qX){u_XjEA{CVs4mFJ+IhB@~~c+t2JfZ+*+O%H>`? zx*=vN?dUP@6>d|cL-o!RF_n$Mysrjt zU%mCtI$i{{Vvj#1&YHUXvhiM$E!(Y}&c|^=jlR)&qxW9P0o?3UL_9A7MW&%{NV&9@ zzve%<8UeVWKnC~(hRstiF1O_}5OQEWV&@k%J^!51{pnkY&bHnuz$pJ!bmw+mgZ=;4 z^S`uPhQFute~DlZp2@-Yy0l`EiG_UaAZomvF_R)@!(USlQuru++x_=I*m(wv*6ypW zek7hdcUk`|n~47r6{1c73{g@@IEW9yw?PR~{0F@g>dt}?c(NM!i3r6KD8W(IYakr3 zkDEop6-GBW@$#_;UX>Re6F1KokpMkPKla8u&Cz#Meo6e-3tz|dIN=0QSqZUtP0_m# zU8>4ZM-)9?<+2SWrmp{6Rvwz%DX%FgT)7RC!zFlZ+2)dd4SRc)|dP6_`6R~}B#e4pm ztmE$}qmPmE1(n~XcxW26E^*|GPgBt!?`mOSPcszR-Sdc3xWvjMasQze|pylS}_7DrKB+(u}%D zOmcho=0bfPXuZMhC@*^EFBA(9UN=&RU$reE1c()35iaSVTG5oMa$q?2N}SD}eVfdf zpRLN|)e}a3w5Z*csde#%#gFfsP;V{Q&>xdJ)a7kyCp5;Lqr4zS}@<)d;O%fOeV-=sqFC9e9 zlP)Oy4eU-%?M}uJ9$P79+mz0HeV2H?Gh4MP_e7Q}zn-2M4Spkg;?4DosL7~D9xuP7 z&wTuL8P+sa%6$30gUbS09k1BZUep`&=w*a*6e3+%yAUg8wr)|B`uf+40e%Bypbdu5 zk9|E^19#>Q(O8JqoHqQ2Lfwjy_2iDE-D=So;W4XFk;jxM@u5TaGRw3B={tm-6+≫U zLW)z&g~!p)H&WtR9HJ*P>j3$@n=}{!c$6GpX$rycS+eGZM1DGRVq3Ed^MjCIcb-WB zT<{6SK*-gtRRezSE(j`1&vEhOH}U?5$5SLfH@X?@qdDwmuZ-xF@j>gc6XgwPV&^;RE9dKG(O@L98<4vcw^NF<+$geq zGxwISy&o1&PAQo&w1GRmXfTG2Jr_!a7yMRA+#<8N7}jnfiwy3ixbUBzcJEJ!0dN@x zJNwFsCB|1J8t{9J!N3J*+)DuoQP5+d#&F$+zo|C@aKp}xPLH!9Y*8QGe|$)O7exW3 zc6YBPctr=j>AvoWeW|Y+hqwFQdM%@9G>>1=Pp?Fy^7D+T^Nae1vZ^y?MZ$)Ft|2&C zRv|+KX#0YEcgb1(Y*0M^H?2(`Zg}ktKVB6*|B=^3s{bx2G!^nXP}m&UB(?kK8%jsia2JAcGt@{(S~!T_d3qPv8VNBANCv+M}1_IQQn!IE}ySK5+WYH40jqX4j>l1+EfMyE!Z`x#1bk0M~xbzYx*(ds_)}^c_)90K>%xG13ifs+u z$i47t|JI(p>Yf&S!`=m$n;~znrxchfB_duWfUoXXDBS-{z^zAjto3#01zFR*a(;%m zZ#_e_u@l>3=}SI4sGm+-CmAi{ZZ_b1-O7!ZXk9v(j;p_g+#_SkKg^ss;^CP)oTCxQNB&B&R>>l zk{b3P55&P0H~CXZ5`54dJ_GPA7xW$Z3^L5_KwU0aXmW`OO6? zu7>wBY&jO*YGUNlU|B0e7fuqu2}F4>&R4WJk$sOD*UV6AzB`hkSX91Awin;$f&XpC z8^6}rdm!65^K9q5$AwDDB?FDB*n@vgO_Mf&x8Oa?J!SmLtqpQq@FjOteGhXLdF(yl z9il~4k}ZP1#;^*xwFWS0kP;NZzvbZR11Bt9bj8FVAVo4{wxjIvr+>E))Tvl*ENl1l zM>(-Mi9f*)CpZ4WhfVlpz!R-0z&Fca?GogD%k1jX<$T-F^{IfEEt zT8d{!BBb%$Sb!JuKN+Rh_|~{3d1m{uex|C09Gf9-*2TZV9uz9{6PavPxUL|YW(0Ya zi?o>T`Hl=LP6{;DR`Qh4i+0~6Qbx;*egmZ-EnUkiJFh3`y%gK?t&ZAKu9<|hHm5VZ za~~gSeLdFYijZv|C^AN0PZ-c*dA}GWWL?d=m<4jFJ0PQVrTiW~^Wud{Ah*M_!&gz~ zjU~`~rR&MTg6A(UJM5f6Py3h-dp+^SvM7=?p_0}2*S?UhUn{HVkdE^`^zn84UWvUA zA3i_w-+$f@&Rytw?bWrVe{9y6RGSYzwZjy^a3zMZOwrn+0uV3#qH` zHSacIk*=4=t?dzZn4oRH6e$ce6%k7ib?C-v-ItrX)|Yu|8@%OIv?dul{i-xQ<@;PJj)*=28drtJmbMw(9yyItoPfR6pD{O-q+Kl<^uSeF24*l*F~&ba$0 z{oA_8ic>WQ$##O-BzrzMs$c z{rfzAfBiW3+}pXYbMAA`oco;Xx}MLgIJ?@`FpIbyeYo?JcA^Vj3rs1(Fjhl3>x1)>aJu_l+{7FImMB(t%3ZL0G?H|n~gam~P@t59MN^Jo;*hm5f zxpGeIR-$%ovcL8_BP1ODqAG%0zC`DX(!y(O`kiNX4+P-wbkNz#fTJf(Yl}O_tyIkL z$8T$m*V1Aip6wiEW28x@U(Ys{UJQ59#($oSHJurCnbUlq|3;jpwExK^uGijN$0%ei z(E=kZsp_p_e>i4T>)8kJj(g}qZ06VQdDjIKR-M*i+^O8!*S}=N#-iqJy+xZvJ|FPB z-EaUCCN{WqcHjD04pk1~+M}Q}`$fgM-Pk{1TWM&s3T?G!d^d3GMMfLf?oHV?Q@cUc zQ_7E?%U`&R6aUta!leyb#B*C`T0bJ`72(=(O+q)-7`b}IPU$vIIXIRwv?M}aBHt{s z{OX|DAn%`BIdZ>RU+WGc?N3t)g(^)22TXJ>DSA9-@7v}$RFimLDjcln>&G8-jWJ^) z>vr;p0}yso;svAl`l6dqK$5bqZ%beg#j}&LX}~+f$Z~GowM-V(*0?|Pl4{F6d;oSW z>H)aLOs}`M03a_udd%aNDB>7eWl38nsgI8K{s6h5=d10*Uh=DcHxx@tADh*$da6@J z$L`JtS#1}lz8J05mRM6$dP20YS|3h%c-&=!b}ST(HhAzMmXMIA+XnQ35SYePakmG+OJ;1T%KThV7=`_Ek%!u6jV ztShB9u00em!l9m;Z)pkm5Hl@DtoJT&9!<_e5GX+KYXVjHZ+Vv11gfQ_f{p9M;ciFY z0izZoOoTwimHofeiHdMx!f@rTZMl|t<%Hb-UIEyD+`xa_Qr~~i|KGP2fExUNU;a;? z|5eC;7x=$#_xwjeE_*Ge2NVx92H-}GZvIzIivHf%`;34NWamPasFA8n^F7J`RaYu7d{@;cCpF07||9wsX!4%zJGjL7LHUH6- zSLRM2hq$u1am&z5i^tF;-p3%Ko_NeBzT&cd)*Rj21bg$d!SegZs(4gYkKnBdF?Ya& zXPx98cr+~prb^aSvPs|)Weqaj=JIB`WW1gYq8bmE*DKM`e>d6T(FQOlAzx2_pVHrH zkoMHv$jY(hql0e+!)T2fr>xVhghQ;WcA=h;PB_R|v0Q@K0Ueo#1&(2+~;s1zOiIy?6Fw7fG9&;q42I>G9THlP$wt zqQ^_c%+DAf?^?G_nahDt6k+k%XTMi{s4^NWaycZi9qfMk@}DoD@!Ord3&uZF{?wQl zj~#t*_U)O0efwbHWO|J0$Io9dS$yFA4C|ZgIqrewW%9=!ZoE+Cc>CMA#Kd2n zk0u<#kIFu>cX?(Fa#<5q9QL4W0-!#lYV+mP7xFa67tJV6&i2*zY<2mUQn?r=lS z?EMI3v8H=j!xJWn@Jtg1`QE19J4t{0v$Ch{0$?FX6i3z@h-x&r?MCR%xr;%YR>=WTlH!hE$ z$^FO9LtmKmOC7t<2ml2OEsT0Y94>JlyVR3=;v6vDJe|h(*O}clTB@jn-*KG<5NBa< zt26Gb6!W;mgx|rcv#0K7DGu|1sE3C)gp4B37loZ^=o#|dD=$4{_^n%L%3Cj6h*3tD@`aN@US7P>Q2ek1kN+q!XU8WhTDcBe>)RyG9R&qt9NCt&{R%Jf9S8k{*6 z?XBr6EbJ2qZYfQWN&&g6h5=7Tb^Ogs&Z6-dEv1S?>VoR*NO7i8Xrk@*oXop_!JgX5u{F zYioQB9x07ftoRX4ni@(#mf}60xXyc*t6>maU-vyZ3O$EA7;f@pf?L(x>8Z5dA(JrB zgcDMx+j9e8zT1d`!6+e9WChp*dfW+=wlg-)>+NN!zaUn zy>$B0#zDDG&%sfV!aVzRGe_FE+9uZDR(S%Jw}%A60huq?<7R20Tp;dKftN)bD$#cj z_#V*!y$Lp`q?A|HerA@J_XM9~W3O=D2OSbWR>yG{damz`0T;;p6huD6#L*vgMHUu$ zQZ?u<_Sn&DA|k1gk86Rs(?P@?|jI>?D`0b#Y0o z2^2Ufp#IUpy2Ept6|4?qSKZs&9jC!L>b}8|e_!?UpTpQI>R>9T`&;oUIXB*&C%e5^0 z*guD&CYJz6?M*rb^b;z_7-qBI0oK9)F?A#})7JK;j`#GjfRznSBdqa&rlerFGIv8& zAp&UrKBT^PZp|Z7*iRIO37|d9g4Jk);S}N}{l-*%M*FRnm`EZM+fy;la#v!q(%K@I zCdXO~Kh(Fxd#xr|7wkW5*6-JU;HVZ!X0J16RX0Gr#7Uik#+!ydlBn04 zenx{(dSXWCB1D#vNnd;j01n860zeVyZy$2s71cgt363dfNE#Z<(JC0s)$#t_=YEuW zydW~-8Wy5dTUA_@*8G_+no^_bwJC8$DcYnPrzJrh{#YZ1tf>Sr(5maIeeSBW#Q1on z>GgN{+Gua`{PNQD7yw9bQ^J6CsK!z4R}B0|So?*mkBRvz!8|xM&=e zb-tVwVn|5HHKkh~N-F->)|RHc&t>Il0P%N;oJgHdqyBSc2pxk1_ZeI0C@Pa+Lns-( z2BS92i0Zc93vCV}4sYr#<`g-pV3%Ngr*4bC((^4f`zAG5G_Ctp{^k|=85UU z&hWEH1CR66xqeVUqzJ1soouf!kJNo0Cfd2;1()f}#OvCtrME#CO`dbXu8@G=`^9gr zRoeIGnqJ;;d&Kj#g#TUNx%3@)ibrHqvvbhA_4!Hu_>x@JnB>FxvMM}lkw^5)P`Jsw z>AQC?KYBxYQgE`|H}^9>PGG}XexQ?x)GA)_>KkAVEQY<+LCi1Dewv*OHVx(di{Hni(i0A0sOwT}V(mZP>e_ONLei`bfO z?C!($)1T`-x+Lk&&CZ?A)ZISOHJBI7a!gGgKYrR{@>K4^xj=A}1L?q^cv8lZU6!ep zO68@W>8>Z&|1mKrQDz+5EjwU-{7~{A za@={w7G8QgLYiu}nOC(#%%GVjSRHONaEA7Fs+{Q%qA24M4I4Y`dOfwuo>R(O-%T32 zDqgufttZG3{KFBDmtYlZ-rYkbWN<`BaPjD_8UJd2&B!_F`bhX?GVo9RSTg!DC758% zdGw{CVNdAcK1@f);EP%*vRb(wOw>AOjo2AyORXqehn7MCqOP4xOT;9Nlwgh|&-T$( zGVOnxe)1&QIN85#8mDL@#WNx@?KdSNI>k2{@&3w7bvv&P(xK^``$e}7LE9wH4#Wke zn0(`}%>EOl>Z`m45anAHzpk>@ZJ!+036;7Slun5pogyFi^vn?48OO5 z7rv6A7CLB=?P4tan%#8ms0|{syiiawLV5R@`Sk6=K(X80562Tlz+s>9!a-V;IK5wZ zdjUK7)CfWscSxQPTq&_b?pII`x!SQKq81vZIOLQc)EYzzRS%`oPG1mDjzrCGyMfY= z!V;B2`#~|BE1+PP70_t51%FT@!ylIIGtoPzYtFX=8QB~&2oi27j!-S!$yZ8X&$d(& z@&zZ}8G6nPty-v826J%SKNLTa9fzyW6Ryt_au|d;3`O8!4ugX{G*)h&PC?M4>PiIy z2{H`GP}arq8| zdPO8~kyA*X8nvjLVvVcMFDyKGe){Pka8`i;qr>2f)Zjh_V@HMhU1eSLouuKhp$+T?hN5Bap>8^;D7Or@s=; zsXdfcZobZf7B!zpQ~^752t7mAnhi7I?b&aW;c7BS^*9ws_btxNgP&A=JwJqZy?_n8f|k9)Ppg(GWt0*T%6&*A~>0Ro(%11eZ_)!&Ezox!yQWduRtg;vOS?~?D6)`zf+ zF+c{3g8tVc|F@)n3ENwBYIsiV$sJ%(@RcfXdE8@Ro{9D%FYgT*; z(sSB5pTJ50?=22%o+|-bLS3}8g@OUBAivOpo|EC83?6Vs- z^PB-6Pxb)C@V~0qQbWnj1&aN<75=_~wl>e{wnWeA`hS+aR@qA))V-D`-)#D=qmr93 zJ2GEmJF4SbD?1xS1l&yiEsw0>@%NJf_JKP6J55yGvUUa@1}ip%6&sdEiU(R?FTp$q zfKq^b6MOCc--PUKd*I*5tLXpJ)>OjY6TbOv)+BG z7WJB2>?`{5#)niK=?VC>ZUG$npDNKm-UwoChsmCk?><$vpqj>56s?8&ZdZpvgu~DI zIWHC29>S1OLAte*1P6sP`@nvc_I+`A=U`HOjUFqNe+4;2EQ+TZ|G`9jURl1WLy_-W z!M$)QpbgETRbvipgF-s8^{n!iOqEIrT;oQS*&Ysmr zswkGnDv591?yme@zHC{p7CiIuc3Pv%!?%d~VEx80L<`#h*z@<1Lrd=}70G zpf$J#^!;JMh=d45sH#wk00BrW?%M z`N-3+E%DQjHFz&l{5V5mB#*1fJ?^TByfzn`4;N1z9! z_wS4txmrZ(zkmMM-3a%1Xd3Y-q9HqyB4jAwzpMfWWs zHEwRYCG;*%FF2BwdRr%VyHN4sRkKY#@9!u|(`fpeQ1QFjD<$u*aWAWUjCgqe_pQHz zGX6+3-E$|RcFIeg$M5N2#EaurtaElMup^H)6tG*H>G{&N8TnS@BSXW_WQ=8kme=eE_7L(Lg?pAw=-_IO!f*y^zD~#b~g4~NzR)08hkgLomSt^ z{xRX(4B2L670vtjiK?4yy;vRA8?_Q)3v}krUolalwoZ+xO_AgD1Zk zuYa^v<#bl8bmd>jB1Kk4*7n)$b``UXM}-fM)7|LCKXn&WgOYNsEYksO&rI1kvzUgu z7I;nk)D{e`JkGpAM^?-$WvVJsZl8_pJIbYufgG#vzL|=w@|+}mBF|G1%gfEFi7Vt8 zWVL5AEE0P*SdJ30Z?1zYFW6N|{uRc$=jsxl>5XMY{+NM!P4^nPW%8p-7QwQaEl&3> z4_}fk;=20L8$C@pcmm7GpR>C&^<>-)6aVC*wb7>clgnK3W8aTj`GlX3OOCVj%Svlh zus83Ig+*!j)(ZJmoI-zo0GoeP(oGhlgm;s{-{s#ZRddHV-`34Jb6oQZ=~4NuTSknq z`Yny1l`pUYI9w0{;R}4;1s09+WKXvfXi_A+CtWe&>-LK~Z<68>M8rV8^F2Lrhjmd~ z+|Xr!P{Ipf+04IJ7-FY?6;OmGC%>rv*?DO~t`%^l!}TRd0kp*VO(A9gXNy^8=Yu4* z?W>?+kjuesM`hD17o+&i2>zVupE^F)ye9xojiLp2R2sEmc3elFnw$(92qUB9a$oP~ z2tIR6bf}aJyrz=cMF5gEM3-qtF5j5 zS|LmeReV z!vp%Xtclp88l+IBkYb9ygB1XTBcyu`DGp)>@__pKSeiPT{{H^neqvNHeL!^pT!XD! zn$&qN4j#E6IDUn(~~MMKw$t&v=9@H7zY|pPyjcGf@09q1-KRn1T54dYz@#W zMR}$m_w4iN1~!`&5rG2KMr;5Y?HCAYbC}B`|JGEZ^GLgqCrgVXL?g*9SM84~a@QwL zEU7T3HfnC%>Y_SpdC#Vv8J>;Y2i(A;uha~!Srh2Y(!C}19? zqM{}bOyV*w1HV9Mabk0MuJB;)1*&*Bd3>D?hmor17B_J0`tfmUtfbi>LL1H<5&}$p zyxuAbf~1k&HFysX0u7{GC=c5=BufpEbFf_X z@$rV%l!;KsebYiJ&!~F`2#ImD_$3lrpMzt@7HbO@3rPvJQ!dIj=_eldR8>`r&=R<`VZnAAS6s+GhRTUP*DE#1%CkL*dk%}vPLU6eHS9ljLE~@K zi*Xx(?y9aXFKEUPs~0C`Zis5th|=wY34K|>`%oW_1Ry8z)&#)A77pBJ-Qwcn^jNCK zUC&8+9!6WKe(ZC{f+uj0Ndf+VXrE9mJVr&{+EL=rAawMuLq}v-)gPWyAKd%-pfUyiufnV?jhP5eqqX%(` z&Q`VgH?P;WBr5}EBvQuu^Kl*fs&tI@xt6n)xA^(_1y-VuS@Wm0DA+g~@=r&pt8;~f z)gkuP)gd}!zxxS#0#J^K*#M*+Z7|un9Q~VrvsP$+HpQc-#YiQm*0j-Ikw~H7t2|OX zT96nZ=o8fb*t_K3Aya>Ig+Wu?BmI2>B~SIj9oaVVLlQb*#t9 zvP8N~hsO6VRnraAr8&c%t0bcEcw_-Q79NSm4Hhx;)Cj-ISrPaw0?h}G7qUcn^+kU4 zeYq}7NV?7h3n7f9^)tyW0xCkli^@nTsh(y!wdZ~vz`wJ6 zudC2HS@gn z6%St4s`8`Tx!)J4wJS7O76s=*%;tgjH4hdN!uE5wv@h6*SD-I0KJ)c~P@OqBf=zfq z#~fjtvMgoOmk4E-vXQ=crB+oMI8VctP89>gTZqMV5gd#x2ZeNN*T^bjrk2vk$Vm9A zwBX4vYTk|=iXH=b2w$FAor1?d4}R&v;d!OhQ>Wy`?^H3agx3cjC#PO-Ll9})Sy1B9wVJAU`+}sc&^B8D@h3*ScAhYfnnw}2BQYpqS5S*$p~w}){oI3 zo7XLGLF5u-3gDMm_Qa3cbXN~o;$KDwzl|6w3l)U;(B!@pj{Ex(Rs=`yQ0X&8c5&!{qNb-;hz)| za_uj&%c`Vk}awL2r|@y zrKHtAS_F*PMWh-)&iKSiNpEV;%>At44a`!PO5|*d-VMXq7NNc@9)J!#l6hKGQ`2kR z%X>1SR7C}dBoh(Y^(mlGWMq6NYok1y-gtWK$BGMehU znUSYMH&4@Uux?+((iIn$S^=KS z)RxzJD}wuIk;@pZ(GSbB$%iZDdyY2@=0Y(Tayd1!JR3o%udfemX?2(fhyYXMH4$Wz z(dWS1pyB~9AF+v8iFu3-6S$f-&BD;%myCTsmD z9(B?}U{qZb)rE_SmEBdLX1}_hc(tuJmZQ<#;xqav7mr9BTZKz^QjB*i^k|2-nC_!)7czFH& z_Jd-qAYdD(c*I>YyTe(DiXKdKXht}6c=&j$AqcF{Z>Rxth9}e3WX)BSdszGPC;Uiq zb1h}enLz38A56+8&>9E*h9qA){kYu8_d`Z;`zK+;ULfCwk%ueGKQsN{dSPvvOT_`beHl>V`|lQa zjvYH8b~2!YZ@1xB`hMA>1HU*!4p$Ik zD##W!E2fJXJ>1iK{jPoJqx*no?=#uOKj~)A6{5d+4(&{A2uBLtv0zG-E0X?1)i3DN z_BUtvx>Bq3AtO#0!~4mq3GRn`ZmNg@gkLy=PE3!qe5GMTX2zz1KGg_d;+>kL5+msP zC6nymwgvMw#iT>Y6a$OR7jpdfem?Grr$1f%{d#6MSK!^Q$9**V$VDyjJDZ=+z(Oa| zG;_`cqgK75`&+(n26YwRkIzL98d&XKc(ojY>TI=ZQRRRP8dHs zwlRF)H{;JinV_B={Z-eTxdiz?4~lSG&1a7wEE_mC)0W)GLfi(F-GrNSm;MZ|F+A2y z*LXayClWIC2+n{)rX#>JCh#i+cTS!s~1f z-UnyuHji{V#pi+%O%a#BIq~$Fiu=d$L{FP8v$k?m<5eZ-+z49w6!<*?FmR!16{qcL^;oFCT*4}?M14i%M3YQ`* zgdBIoGfERKuM`Gtcc?}YDkvvMWv`B$A3YA`8*8+Wk+vFG*|8F9SpciXXBKZJA#?Tk zrgn-aI+%t`U*0=&@Ds(y>;rxZ{VQuQ(5r^OUPdwAdvt+u?g31PwjsBJ4nT+Qk8F z^QI;K~GjV^di%2!o#z^RPOlhD$+{mruNAleytY-=7Rhr+GD-AuPN|l z@WMWWhpv$v8|~4M?jHfz?GKyA(}&(W37-)mqhZq|)LP%RP(4(zN54Mo#m@300# z(BHOruPOmtUO6#L!wP206Hqc!LS_Ol(pKNxjCKLRPfC6^LH){0B}?O@?D3NOTaPYN ztHp+7w3QFX#|}GWJv5gwCOk=S6O1bmnn&Z+t|ti^Nv|CJ;j$av(2#zvKt?cZG$2En z=dfgxR<`F19sBC8CF)X&Ems5PD*n<~j;`#bE%%G%8DQq8wAycX)}xEh0CalTo}E`P zksi&uVSS!i54nd+FB*<4u+)z3gtx8+Is6GixK*`GRyiqK>?Evx=@~Pxyk>KW#2@si zHNsl*LB4By`Q?6+g2&kFh^DXOCUbLhvwIh4DFFiKdm*>^~pt#rp`Wu=gfvrr)Gab11dyCI_tm)*mR9rco3 zi*|2xQ@$kb(fx!ITZaMx+RcpnPjBag%A%`R19oI5{t$c9kbE_L+pPYdFi3>jb^*Dc z-sGy4tAD6HH(sa6bY#=+pyr^dJXF49$kJ0SCf}`8zVotbd$z@i^Clwd>QJG?4+2#( z57CLPnW2LWuWEcm!dVYBNgjohcY7SQs!>4Xw7vV~0@i=~912tWg&faMe=}|E_bhLL zncXtPT&y3%Td9{1F2u^j-Rhr36`}Q z{gGmTac?gP05(2usA@{C;L$%PHgjqUn^}zsp}lQ6kDLD~7K#SOGXMr8`T|`=zF8=q zC{IYrHtbUc^lHw|nXb+@HM!`ZG;;ncIgi(4@lggHO{ zu5Eg+L`xI9ZqkiZ2Xiz4L)v!6x_;P%uJ0#XIzS?UZJN^_nDG;d;CP1*;kx7x+Afow zSm4y_J{6LQOT4LrOR4glY9ryaP1-A<<*ox^PNxo?E&s%j28EwH=^sch(HUCj`gOIT zfq*a+Y}n5J>4X@FFuj=^sG%0q9Mgh2eJMRBxBq^_hq}SMqSIwTx3}K>fna_HCM-Xn zT1RW9*DStk`Gc-psJ_=R2L4{a#Uu;Z3ZQi~JCSw`KPSkcU+3MUdM%4|H}0RW?h z>u+a5JJc*1HO&}n{P(H$-13PIS_b?aFWa|$h`NAi?uOrD zkjr)K1+ssQs1;*kNsJaY?k^;kZxw5sx2!zt6j@W|rKu%4Rtuk6lIvc6tB9>{zT%5S zPp!HP(xbWQEtgu^!Ofzx~#1H=Aef^jp%`hs|0QE6@p4LdO7RU^n4_p_s3uCca*+ZGfkr>fEMNDcoo zFHwZIR*kK^(~Rpk%+E94c9RWDir9v~%T{BPnU7Xo#(T!S zX1r49a8dXo5Z~e_04lT-WUxJA2c|SV+#P3{uXtey9)azGttip6{Z1M;SW|OLtRLqt zTYR_pHu&yH1Cj%)nrZyj-{zj;$z-u+x_j>+=b9(ORi z_pjc=c4H4kFsXVWgh!o+V}`CgQ?Gb)xZf`3l?Solqo%C@VeDyY%|uO<>|#?(Dco$Z z8h=Ma{6v32>WH@rqmh|AV*9RVVo4m-u=Eb-e&Q)=iJ9fO%^Ds;u9ZVag67Hs?#TYvL0UH>T0(SBML9jdk zZU<39>gJo3x@S&z+Cs40l)ujvb-VV~*XPVKx(U>V0fIGvQG%ILbCa`xunSC>FyPYN zJ%Eu%V4*;ChC}rsz|YZv&CcSgZ^Nh&_E3`$2qdJN36XX2Qm&LpjH7aXPJcXbb%xN8 zr(_RS5ptJ#njvHGw6M)!hd)EEXgFv!g=neT+$`71WB~eVC?X(5Q}hrJ))e7IWOS3! z_4UA`gvuk4j7~Y&RUEDe7+C|cA`F255&&@`!71QQq;UGK7!v3hU;uD4caKaFYz^G; zUS9x34|uELfezzQ5rGhE(V6>*-Ggp)Abb1`A;Vx$z#YTPDUxv1?+a9*Jwj*@Aglxu z4j__?$b^l?qZ3tmc2-8$tYL+7Rb9@P{5PC z{El@vFK}{mQ1-=#=Vhq^Wtj;;a7|ITEVHgw_7}U8{Hvag9!U}T2#;50m5=%bU63nV z>gZVN(uu&^38cqYSAAsk&Mhz2Abo9f8Eio5(EUqvV6rq?0izVDL{D67Vx?2H5aS+A zO%WvvuGJ+4Lu+GeRbFgu;1K})LYVnGV$)ye7Uv28a!U5%aybnSCI76SS`(#(3{T9j zqAT@!scyr?eMJ~(<=;Ani}zZ-A7?t;gf%~hcqjH%3OKS4VP6qj6uu^0uE1rIbTqKx z&IaZ}H>^P2gLaCmn!b7h0<&X9D7Nw2_ zs9?>D$1xmj6tEr;N~yt#iss}PivWMl1BlEB!*@QTsgrfR)JBJMpecVXq-dlzbY@oj z^DSJ@G?%jK!-4r}K7ic5py44+QKofi@qzC(c`-_uguCi3xsdP%^j`@AfOa26N&Be{ zkX?WwT#6^%z+JEuP=Ygx09CuCm%scr;dYShd!KZ_O9Q`N4F~cp(OVcS+p#e~olRs6 z4-t#&+nJQ)As=sqv-j-B;^D#S>KcK=ROKSaX2h1Py()Xgo*$t|X%cPqQ=0eHp?3j) z-xGX%NE8aAd!FpT!~qIbc#9E$_h+-&)AeIxQ*(PP{{UyyKrdiY;ss}$1;0M9e;@Bl zL@sBrJe1SD;$w9|*eNRmsTr;dGyY<+6bdB)h4-9pCzCx=fG-FuLGh*?*DOoyL)?b` zq3Flk%u56xsVe`KB+(M8dBVMqdp?TK&)`_CGkj4Ly8bbm3U5u2edHb@kotyZx`rLz4)G#pY)-6l>pZ4f!$(N&xM#gAJ)`74u(nQ|Vn6f2}qvuC8$lyUv~Q2FTc#wV+n zE-g#kQ65O$LnzE;lj5z{MccMlF}oSt6rC@X3&`u*%9$!q|#AV|3x-cFJ&+kz>uiCw)^o3iB=*L=T$_|B`k+>HvS_^S|3w%hJHx5pJ{#Aw^lDPfCnF;UASvr z$KHf*!)e@<0E>mdFS43$s>`b6=3}>D`@v5s!WwGYf-y6`xl=l`JUTBpUV+W`u$^8#h#ln0&_o(mN|DMqakse#*$dXsI69Q+hiXU|pb zvv%=Dik9D&lgJH-h=|ogJ_`<3<|sSFal6t12JWVI*@i33tIvN7|Hv79{j^QM7`Eoq zJ%kq%5;g~@Iko9>-E1~95il)5upEvK5{4F2dR@lCCp8RHFCzS80&%}9y*I2^w827R z%&_OQyTg76e^F5$NkDV*dB(wwNQIRFZ1ge|1UeX#`OH02sbaV}Zmc48GKE1McqId^ z^w;q7Cf}T1GeJ%w&^&?E(k7XTWEUWfUJG_KYd0Kn1+Mh+OGBbyr+oq-M;2!}g-T7)`cH9zpiR z)h==u)3D&Zr~%%2XeQ(P$oJgcXEb9t%Vey0EHe?~UsF6c&T1DH@vj&L82Hzz?pXBK zeUPBqsiJv3&O?%j%$3{Lg_ot2BK7geh=`+2p64IM-K`DyE{I+Uu7AnfQ+@q&ND0k%p@e4Hnc6E6-|9%8 zHy|F+1ETrWKqQq6y=I`&C(WYKKB_gyDj&@n4ktPjd4hjNxs#I)LH(fcYw1LC*Z|b! zH}3Erd(6bjJ14O>?G*W@Z8TNX?EmUgvsUHLI{*-Zsq=G{GLBHZMM{P)w=QeKDMv>a zH^#&k`2b0qq#2-oRUe z6zxbrNFWL?rrlD)yhULL<`=rFzOM52U8Eqg64bZi+2`dP%b+O7wd9n62 zga^=LE~2ZUn%u<<^ej1-a&Xw8Qq|s+j1ip$JvUD7o7#9M_TtpV^~`7~0&d@P2sYTo z*W163ndZ(iHl5QE7UPU!eEp^gSG9R>jiu2Qo`_?C(Y08Fb)p4an0@N8|P_rsn#f!iD2 z@AR21rKOLlAR+%6=#~Uu{q)T6$fE~nCD_9t4bDW)?XDhM+jI=3L<`|YICJ4P=~vZJ zjT;^9fUCs1=)OxUR+5Nj-8*NfOwQfx(weF{W@*1q08hG6;`m5r;yf%0Dt`7CnUnCC z)w@!SVhL!uEdKVbydSsTIB7pKx1=Qz@+MeSiyp#80O zz%OqG=!sw^{eoC`rHhB0f*qwTHBZDCpOdI5#R52VrZ6!QbmRIJEp_s8U(GFipK*GE zPrMQUHh@WpVWn&kJ?TJ{3e~TR7*GTqj>3Gr^+PbOsZ~S2KZ_pY{qAnMvO(PO44EsJ zWv_N5GNl{=6}!UU^Hyb+d=Ycy#IS$#L948UgH&m7m4{P92Of!pHUVSZi7C%%1`Tp@ zniWSTdnO}1E5(9yE?OQpRN>>9hsszYl_msV^~>O5|L zuLnKX%|1V6#K}7Ikw5YS4X!+x+!G%~vLOjMMUtm5gU*DQe5i9V9Z8o%jJL?g3dGtF zs6dPrIGqk1!fH~WSDam~(N4nYjQZ9*bfS|U7#P-Hb?Lc*4Qpbd0Mo5Uk_k%)pl=~W zAPA3LU|fa;a9DV@i3DDN7aDc+@ukrnRmb;csWGNwGC@-kzsfJICHmD^=t#*Eh2kTd z*5QQ;zr^NGPwv8BEWB%~+(`UDX1t^xEGE>M5@s5rpCP7BzGOOc8b>_&+}-``-G>-w zjt8g9;R`N@G%JvxB|;7Cb?)w~b+UuEGo?6hPYUQv73WF!9=1jb+`2Fx}<+hDpwVSUthhd1r z)B20dc)77hn?>Md~%n01S%o|)ibH}G=t zZtC7CgG%fJP2-{rLL%x#Us>ogWpw4t0K)soV&R=r+!?GGWU1QOUftrr==pnHfBD9I z{m@!CdDo`kXo9c?)=9kT=IJsQuad#0uaTZur<;dLdxh zx3o)$*ZgXVm)-HZl8#Qwr{)`~mXnfGN`_FUKgw*0X=_^g3fS461E`Mm5La0*+ux3$ zXYqK~LL@##N!)2yN-{kdRnabP z?nDP`fyVjM#vf!>H5sahU+)ho>IoRSDqYl{s-_JiMW1r&8jug|=G}iqbr=`@*aF5+ zSXW&`6`6_5@_BQfu}3OYa+o{I@<&FW7+~-C%-<8cxaRw7!8TI)Rqhjy3%p^+Z$`R7 zIYXEtN3keW^t8_nVo~{;ZMD~1i<1*5<>m6$$wy2|X!-Mk1yA!_v$=$#9K}AZi(ke0 zH*$9Py>c>ooVH~0R2`D;<(rhfJrkqiakdTn=mBbw^ZaR(iB6dvH?zeazQvpN>xneW zaOGBgLuZ?$Y`Lsu5km0BiCg_-Jp&(KJ#VI1-czwAPK2pXD^>LO z5UBby6uQ-XmFFP7WPV^^$7=I|?}cp3i|v%7t~vI^mSFqQa!|rI7j`PlIPOVpvwm;y zO>;>Dm!8+rt5F6^#r9u>c&y6PAKRGuY2dLB(}HRVo?A93w&1q7a}59^lq}Fttg_otkae78;Mkl zGE{-0=$`a=`yQ1g+sNicCU+nXF zGgynV7Vm7@{WA<%H25hSov3`wyDs!FXxDf_(N#RpO>bD61FJsxpoEb9q!~S`D(;fK zS}n&&vYArd9n70;r%i8Y_`Nq^Jr3&n7=-%}T2q+XmqYn%g!dwgOP=;x!tLDdgWQ$f zZewG#y95d_;tu00K8I3t!85-w?Xjk@A8SWIljO*gVsoj!WzbT9R-S^F}p>3F!H z203{NaQ%aOkl&J&nxFir@q9XJ(c?8?WRcU*frxdPe#|l%x7;%hKuda9*@dFc$xYt4 zpT4ztO{G!|uREec&bHPgK^pZ-H+6EF^Y?Y`a8%j}nykjRda_^vqu;$IzPT1TNfns3 z;?Z&QCkm94Y=lHjo6MggtZ@`LoxfU`sc=&(CTL>Y`(ud5GEa(8p_Qec^cR<{{CjR& zM-xU#3n-ez*A`1U-a{1HEM=2ySensHo?Bgjm<*p`jg|8q(y6=ZAF8px&E4)Vz73m+ zId(+xH?t07hfzI)L71MAS*J`p-84Yvk7%s5U&*pDm!;B=du`jsBdlR-{2yYevLsZCWj@StCXoBZwj$ky@oz5t~{uI#4xZ z6E$n3D514tYmI7A6jh_vbANyT^Zd_q&XeOLxo70Q?_9a^x!&*By9CGE`L6#e1shj| z)2jv|y2SIYP>3#zkvx2WN@a)x7KVMu-}VuYUlcp~a^G^SpOAhcW{$I@@}NjI&1Nqa zL&ixIcDS_G<)y+C(cE|(Y@jhOT`2noF?(csSYs2yEel;1RDu|ErHnvXVn1~F_XJmUW5tN7AqMLPkJ69bI5O@N<>bw;j*9oDq z-n`1NeEQ~Tf+&#NclbT-%w9B?w;;Cq4(!Ys-1&Z6!d>C-^mXG75(2Zu>#ciVndLAJ z(T_`)p8xLYOv2KnOMc(!uRyp8|j5nCwAs!<#+O@fao^Ghc7M1af+ylzp?+G zYe#GvF7hZV1*jzr*B^U-BbhixS!chwl%P=oxB%F!^J zc#k|7vW&IrRqF*Ze=!%}i>h`Btb6sohp@36NVA8K70n*#XS(hpe2YXKS$dCk#8f01 zu4`8YTI+@t&91L{{WsDRjNfRM+a>x5$uR>n|N5x;3(GMs`2k}h^J~~ypc;}AdXPSV zMGfWM+sl6I)fh)_8*0Q1e4^xd;iUXa2;WE^~Pt8SWMkKqX^FqOfv=aG#c8J9YZr zU;m}SJX6v=jt2cdZ@QllBVPr#`qu|o$U4zje)Iw!n>yw+9BpD)VR2>2t4omnW7B>{ zRhap1dnqi@svg?h_{!;MS8n!rb;x*?cR#fp~ zXv~-5;8J?x8ike)=W00i@g4X){UkGshK35g_Hp=f^ay#d`uF~(in-1y(c8t9`d66e%ehApL#YF)6UK!cegl?S8XfCHUGqQu%-+0bP55N+)dn0ya9 zU~MsS#Dq{SP#K-BwGbN5Jrqq(Fa9m5!_`#}Wl3cuLPo16u?l5kFi4uK0hPZ-nZg63 z$XeCn?kF0^k(oIFb*K?A%*&Aid)EQ1&dyzhAc1WKv8f&iV7ht=R$Xne4!#$P4m~yk-27>C1b2k76WowHqcyO|L#_=SQS@x_$bK|ojzZ~doAJ7X4 zPstvR3YA#+@LG#u*PGpu?{lrNJ*dF zkousiZP0XzZk(HjYbqQ?FXaYDM>xi``viLx#%M=w$jom*i3JoB6@BDuc&Tem#K)G5 zS7q!=hx3W-Qt~D82*o>!H;$iN@(lb|KW*XQt+}!D9!4W77j7{G*DG`HTLvMKf5qX> zA4R5~!GGiah8{1C8oSn~ncn%>G3Z*WY{Ad-TjKWXSw^eTIPT563i6CMDqaX*pZECg z;`z5x2uX{Ym!{bNaQNh9pS7g0x+%n7G?>mFxz>1#hUzRcqNER5OK%th5=Aw5KGx#P zYDs25`W^a5k(|PoWTjrsb%Jb3`fkOq1|Z7!;7UE>ZZuYrnN2`m$TzX8jr2%^Uo_?Z zZsl^qZ*qg9yW^>l?Dt0&EcA7%+(R@}zww_?OM1k7I}!ZH*UO{}G&q={OfLay4F@*M zUKIod`Xp)y&BRc4tsFckp)6HJ{V5d zUC-nB9qBm)Xq^k%;#fy2xWAW!LvpY4A9Lc z=z_$cD|3UOB|50=4z<4=Ig#V{8s9i9Cjb?E+T)FSl;Kq$%aOpCAsDh^9eWRT5>Q|- z_H~2SgX8dzGdmCw&vKkHzSggq;YbHZV_YImOa8I~qMmjVGTeyD+|9=!eUjx|PhxR- zdV01uy5btD6C7D}_Ly#Si_)ea+^oFK)~CV-a?n%iqE0{SCb>R?dS>ojd=}Z)O`*5% z*dhN|=zl`N5LD$dK}V`B2Afu#nU#q}04b?B_Jnim*9S8F1T0;a(B>FCLFV}g;1MHH zAS4TU<@CX)2{%@o!uW~t;*>nIkDD?%OEUa?)Ry}8N2Ufu7w*cGAs=@Dm_Pi&EwK?ojp1_25RJ8W8N%Dz| z%tqjfrPjd}ZG-j#SQY7t!Pw*8W8aS--W?DvI(k%;@DB0&BNkgq4udWx$~<)OOLK<@ zDo7fQ*|wEPvrp;9;(6E67D`Tw>H5Z} zu%aIP_rMc;1zD1?2xi8D#*%$I2?1-~S!{0{2k+gk7lr3LX!(+2#xf5pgW^SfnsC*$ zD`Ics!nF?80>BmdE6X@N{lcFp{gnXymeg&LFR|O~M`F1S2P{XIf(Du+y@kef4%792 z;#=~{tog}mu!g&FXU&ed);Z7Ki&FZiQ+P37NfoaoiamW-q+cwZGYKlsP_SSftV?!W zq`r{7$Hd_t4rYm$F{=FuS8?iwqhOs`Kgbz78yidZpzB{_%P9-8w4_oA@f-jsuB0Sy zHys~Q98v;tEPA3hm?FoYkfpZrC8aaw*N_g&?~Itl`5*bHwJu!s58 zy4sa*Ht>*aewY9qZ|}VF`r?m6ld)vvP4G7*w~H=OZqrg+pEP8QJfBZVmHsM3?kSJ| zes8!LksZ4w6*LEW5HU|eh;neKhAShPzx=e9dYn7ic?eUN`)~laL5&Puq87Nv^qz$3u)dOTx^Yp-%hHx$>@@uZ)#uW6knti8wk7 zzu3SxUfva)YgL64Lq#ahbd08A+GF=JzIU3oOBD*sq*;*UM@{r?oNWd!m>0~8eCSwN z?&k8i5#ar`?)6NEi-i9QDaEQL1rE1^zd|ipE)(W zs+r1{lYhhX(+`QRU&?AiY$zsd^#KbeX`y`xx1`_R<<}Er5>0=VQU=wh zOfJB>Bzn3R$9hp)1;YHBV#kF$t$>bR{qz;e=vLy$(xehLweF5@L+)8_F&T=e8dG$? zeaO{Th$J7&`7||1X<1TaL`iffq=2l8LiJ$FI60N;8z3K1y+wcT&&Ey!7#s;KcurmM zc1FE&S9LF?q%M5Sb_qb0;p>aL%7UF$1otNbvz_nrEQP1%cSauL-VmvOnL*kyg29oS z3!FhyU*}F1y$m9G6sJNLStM$5D&x zv1upCg`)z8^G6;THb!D+BG$lm7w1Rho%e~_IS5scQT_sl?0xpGt5}<147M&FQsbJ9 ztavZ*Xz;KeFk99S;&Q>Ps_OAI0&h}+(s9<{6?i&l2+rgvOyfCzUTD;LR4GKt|toPty zc~$cpJHjfC8wD`|99vEHRDsY!=jhJ%m5mDBj#c|eT<^99)MYG`3R2iwNDlh_9U#h% z@@%DknU{JZ^-ua$DW^?>LyyE2FN$8RF)DAHcYXgbF|F=`h+SV(u-~Fqou;(upK^iy zq9bQcphC5FC$yaec71>tMo~d$+Iw+Ei1I{%zaKcE_6*#)eUhoDODIT$9xE$z{`g$P z@VaUB*ta0Q;Jy>XNMdHJ7}wwC*zhe!S3O4pIUPn*=RAvG3Ovto5?OYmYm_=zAJG2}LW%&Xr5A`H_zF`<`XEi(RA!>nrg{m7mg(B`3Il zJ=DJM$%A;LFl(_%Ibpr_8CVWtQB4(C_w=mW-nD0;m9!uhs7bN0QAU-E-K_29`qGOp z=E6X10!9UxOrV#%=1Eo94K9w`^BmZ&^79BBEHO17SvlJ!|ru zhY2cD4Co6Z%dYo{wugS1{oeXdNaD-NdTU^bJyE7T&HAxX;O?iEuX3;j-OKk*BTj4F zl-9ob??R5B;4_`5iu!}gcz-BSFcO;1bJyZ0N4Tg{0oyK=W$qjgvkO174<+K8uR!Kv zv7dKow2zfZ$&!>5IccJe(Lng}g*a&K;=xs8z?MWW@#?~0lUqEHE4a*uK6I+VJa#lM zJ!XNbh{P896tePgN_$4SeBx(OZFDy_dt`gllI_$3_t;0pU3pFV>EYf^A3fqVAoUHN zFGn`1)wf69<3I-Kzz`1?05dudG;@fK_BX6(c|Cp^jw?j4<9enVX5+xVdc&u9`J_90 zHeh3Jq=6Vp6ai3CsJy$-8X~L12a%RWIprS-cNK?O=Obl_Ljwx16-(k8W z`ri8|Ew-jd-TjGwZ%UjCR9*^PEqyZz;*j;I-EEZnO_JseVsG4*8L%YWn*UgaqsL>~ z9cfAASdo0p$5CU88Weyp9al)#HK%eCA!B@frF2nWTwM7op$j!x`SJ5~(V{W2>Eogi zXqwFzt`%1cW&2reE=NBc$tVx`Os*L6afl6ft zJ`l;puN?7iK4(u!O>D`IKUY&Q34I4wfpLAd=G%KI7%csdm8kGY@jyhv+R|+!xZB~B zW-8s`j8>f@-wwLLqAqk;x(RMJ@UMIf{`TBRBa2qA(pmK|q0Iz(X}Nr7XF9-hV`pP& zo1KG9D}Q`2-*f-c0_r~WDjD$AR?ZR@Gu?)zsZvBvnRHk>T>dk3mhLh8y{nQYM#!|m z*Zu%g@C`H)E}dVNkf}l`Q|>8%Hbg>e!c-{E*8Hzr8$6TBmD_OXK>7zOj8x761J_^u zNT~AYP<9sp8>ylJ+I5~xn9Ufg!d%4F@G&1TV_lQjqT&2^bP%k{Eyy>l#KfHX_BE{V zITl)slF1KdA}GEK3TyBm@EdyNS-5wc{zw0Jdl(0^N29%2>WS)~ z!r@or!U-MMw%GE>KMiD!h_n6b>_*w8#L0-2Aau$tx$D&=&SihYtQuS_A z+&+QvSx9Aoh_uWiS6WHFjMU0Wy}(j!x#$&oa_jz|qth{dZY32jZzLx5s+)K^K&Z;Rjc*L6(xuXNub5=$u zdozKfXGe>zBDT+DJJoF5ztTOrNFP*@_v{>6{zMOy^#xM~)hQhs#pPqXo7Vg--7%5- zlM+XACoI2}UyLU7%aj>=`06!!nrMF>X&pW$^}o`eVb>&CFWg_VgM*;<)V$o1+4ZGW zpB*9n(BO+e$t`pZB#v<6x1q@_#e57;3;;^+6G)tgdcXXjOtP1^sxxz$P2UN7L;)zB#V6Ej+JkQ?0X zxD~5}l{e;#4(WXE;AMDT+woIR9C-A`v1!_&7;AipU$R15Z{f=MQ=cxL$k(giIwFq` zx{c~tm80rQ%h4bYL6F3J&MK$yroArq-Ep-+1O>Uuy zlJ2#H38nSZ)gWs1!pfcWWM5qB5~df;VQbK|h^}6F1=!?LXQ}1sJS8-10jc)LbL~Q& z1X>9m6M3||c{CQ+EV6NF{OZuPLmQo{`dSsIfoaq|r~Rmhc*dS^k2cnzA)P$7$>YHn zk{x?0)hFfM0=h&tiKUp}P?w|8#2F8X&2Ln`*R508bNWVW2TWVXT>I$nmOy>j ziV(eB{d}Yf=62lR;(og7Y|wOBbR>h`Yl2#dp^V&?o!x|w!WvX=WgQ~MScHDa5`XFL z@HxZ$2k~J-uj-_nqXr;^P?FdK=fj6rD}#U`zgxXS`y-(Z!XGby<$28 zE%6oflWX}Lxrq)QtS+lGiQP{>7wLO>iL$PB3oSCB{Le@ecEU{^qMaz{FIjeijo4Yz zERwuE$}rFNbkni}1gJK_vfGVh8+$hA@Hw%cy=sc$jc5hD2**BbMco9X*F3r8qn=Oy z5SB1z?tfJk%u0o-L$4}X=-yH~xn4ab)J{9`ZXZ}nYoCeq)vYUxt=#l$;^Jr$8YjF~ zR#B^56jE-dM@kJ_gpol4MjCc(zLsmn11s~32(Q_d_1RS)YFJY`s}N##g_`O$#%2XA zG&TX1s+wd3|7sK(_cob)C1gW*jo6=I1NJWbsN2^twSDS8@)alp@9m5CQpW%<%(lmA zM;Y)1*4y+^xA79Hp7p9%^YHaiZ$uY>riJXLg%ZZ`0C0+002M+5vt9|=p#eQ*7`Z7d zcZzEUYC3gE`w9PmL0>Vl>=f>nK`UeWkM#A{3#~3svk&{h?nX+*&Wg8W_RuXk$M^cP z->qL&>Y5*o$76;;Tx_wO18Z>_ zi1m#pg;@ZpmD;Et*!sjG*w1p+4zm0x8FyJ@L@@I+ zlw@<%t5wc7V)5RXPA}^0Q?Kz)ks)0#Hr@W{<5e8_0oufW$0{p3eqf!NJN4f&wkQx0 zxIQz|jn5jd@*!&kN+mraR1wZ z5OA#jJ4u7ZVF{r1at<|2dpR%^pW%y(CyYTB%av(p;LujCzoz_u&M#;^5)7OGiW)>2 z;n_Y(%^e1DR02Nbp(B&>vc=)F1XTMYc6XA+0@p<=4y$WBspFNDY#?iL`f25wsjHo> z=ayaMyboF!rc%LC(cq=xi^u!)9{e1ytQ|ap$9>s_-WRzgucoNr)#d6@c!L)A8mb}z zRarRx=C}fbAl!gR99Y^cCQRbY>Mjso-Gk`Cx&?Q3$2=Z$?{(ao{a306Tw?2s?I{I9 z_Y#+5Vk06Pj@bEYMGD?n-~Uqv89RM!Z~H9m$(|_kqh~TEIfQxRGPV>Xw<9v-$=i%H zTd|q!+6u4Jg#7PK5DI0^X{+x~G8>sAm^hF#hpd{@tg>JW-fPTwt@8FaIkP}QSLih6 z9Pg~8WA~3PrF=4POxz8spJv9ekvqGiKMV68GANQLvO5C;0vnG}!u0V!!W@+LNTTqg zNYEPIac%V&saHA*4p2!D>~c+`##w`qPhO%01O!!RAQcZ2cA`qTN+I97(OO{CBV88w zaR7zR;$2jo4HnHjhQ1HA%^6F`Fsp!A(xI$ei(ZX-HnvzHXst55ki)iQnMOWt%Z_6R z6q@-o3{ibp_i2lz^6cH3-&(7TBt}wOkB&=o-E4bYC@|so--SV|5vu$X_&)RpwQ4T1 zu)N#!8*orJW`9j*k+X0m=Ml9zcMv{7_@ zTE^b z@Kp^}ksR08kAFZVf+v@;1&zIg8R!?p)!C+o!Nf$F4oj==dE`5Tl;WyYmr z%uQu}fFlZ&R}}{8f|e|)bAa24?B#ado(<)(=pWaB%+N-P$CzO{lJF;K`ebapVJb+Q z%jB_Pbh*4xRRG$=^eTKG+Xa7xey>z-pO7y0k+5Fnp(1&Hl9k9=naIj^##xVbN{VP` zQf~qzhIxBYKH~VR*WNZFKYG9|%SY-Fy_GJ`{qtVhBTAJ$r3jiWF?R{8jA+yyQh_BR zO&aawL3V6R>zPyL4HC>B+Gq5_&T5#I55CyQGMVfXNYQ_wc)H~K@5IcA+ZjjmuLz7E z8IEAm4EEhe**{c2RBD`mV_o&?%gwOK+D6BBthqtP&Yoh5YD>O! z)=zpD5*3K4TG=HZnKm3LZ90y9h|ZMX8SFS5Mvl+U&xuqKv>kqVJ~f*YTeGN8ea+H! zndaZ%DNtej${sYfYIb`gujU`C*6J1;k`E~?)E>r2a^1{7rrB2=ta(GUZ~a?(Di^@m z&~g{4fHXi>1u;ANG4odB92#1fu*Qip)T#02bA})DnV9;0N19c#w(k>d!MZ<%;wrv- z-c=7lv8BuqQ2$b5MV$68AMMUa+RJ$=m-f*FsvMo#X}OlWd7GBZ{U;HSgWL8}#~zwR zdqtWTD^$%@rH)v^E>%Bvb3~qd9(=jQ^|NG~JXHFw?`^B$5vndxgnc}{_n@Mg+$k9T zy44~=@f3bgP=>8Vh~e_8jx z??ab9#q8LPHXr$Do_s>SG+Jy|a_@JltQ&HQPhi4jF%0>FQf7lGmMTx+Z9><_lF=%k zrD^Hu*T*8tC45y9tf-QUgzr>dE3)LM?Q8U+mxdW{CKtb$&L(>k6*)QN{iKwz`YX?l zi`fp3f9Ods^LSXg^ph2UQ)0b^uBPAUK861X(`O>5@mfx+uw|@2pVJv+d0}%wDZ=pC zh!)q>x1MPxC0-Olsrs3qC4s31Jx z6k@R91>)_|Rl>~-`&^7P58Q{-`fcJmORU|0D0wJr*L7@(nGvR8_ z?>#&hHm{LsHgM|Z-SsVnfz4|SZNj3I5Ae^cV95hh>xpMVBLMr7y{)ApV5MhKXIn+> zT!M|#z%VhbDvXW!#uVqdJmn{qI~NpR`1?%we2XH zi&=lI@}(jXg~-t1Pm_XC!}T3gD>PB_(|0i6C&7<784ZQl&!{k_;2m8NRM!DxNPJw8 zf!L?ZXE|^7*<4o8Nf7cr{pfF-g_}9?xB0I&eTEImPkdfrHpFdRWoYg_CSjwC-u}7W z)&OTeVKmyKYdTfS5zlBfdu72ZaZ?$NsRd%Drhnw>V>=C*ucZysxMFK)_CH#*20rKI z&k_)VV2{d9Vw|!KHcYH)BipH7KCX&BzDXFxqp184jS7eR);_|Ln*rZ)?6TFT$6gLX z_Ug&Q{A0Blhq6#&ejh3KpUz)dgd=zR_ycT+l1PWGeJGg4t#W<2In~-J%6wq)EW0m!Dtc&P&<8MoOnSfbqQ3>xjA7)Spj|Ev_g zCf*&hZcX;_uZKm{&K0tT2|Akjl>A_qMJiRl`#c*BD3oaCkiW{QDuO36i7stK_Gm7bp!FNM&dAIrl2fmb zh&24s0L`oTb8-9IkKz<%1zPqs*vAo-`#ryJ;H!06Zx+UG!I8%S$epodbHCoSwB$lN zJMm!Y)go>EvA{YKO8dUd$ja|@sTeb zCmW2a*aUnNwt#P#lCsk=ONd>*6EVl$Xu^gmpn#P|^L_8McVft>3=ENyPlAlr(m2)@ zqYg&p^A6HYq$j*Gx)S&$IMhT=)VCU&E#&w`a&RP0Y?;25IqmS;pKZj7N(%{X6C8p& zymsAR1Frtx06!?QWqMawj-Ly&=x5(XeF1x}7jh{}yX0SFi>C99f_ozO)TmLPx+FbF z2zqSR0-tBpY?q-C0Qsq=>E)J*+fYz|60{d!7!pRQL}Wh?DZiU1ly*<52S!al@A>(R ziXyWW#EPH867lM@<3jj6$)+kyP-jq~+*)$}%X}l+(ClBZw6ON`+-WZBtz?{*mFDl- zK(WJb^;*g4b;%sfp^+&NW+s4M209rMY>O*aqZ?!InPEc>dRv86^?26p{gLL&$E+n? zXjyMrH$hL@@9NQfT>jt@8Pv^_KvGM0q&1&jVkOrLo%ch)| zh2D*)3hQx-oyqfmo+Qnrw+kz}Zo@~E?AXjYl%EVsNeXaC^D}MmHLJg_xN!H}fYk`7 zPh76Acad*9;PM~+&lU?4enqQfdduU1kp}`T)6W2!O*mhlX&fOyG0GPN`Z8rt!PBEIG1Fnd{Y4^$jZGXd$oH_pX$B zK}&_oOBY#sWCq+3U>YJQ<+}Aa-J)mOX}c<3q{XQ|qYEC(6ZxxNU8LjSQH9djORg7V zFo1bQ4-b~xYHaoLQLzmut*<#cmR^DYE$TPcBcb= z!u{d<{Bl@dzsKB@S9j>aq)jM6$$!pmHC^BZG+pte3n<| zsG8W)PwkGD1qdPTa47g;d==GLJ3eHJ?=XQiVwQON_L+o!&h;htrCA{8yK1{O& zd-%-sg>@zQ^V6JHuSUWz_%LG%Vb9n*I!C-3gk|xB+KDAhWc>yJAZ(+;fDsG?wdB|M ztyP4dAd(3B${(=N)L7sINONtS{-Nz{y<#uk&%I+K%pK><9UVGotOlNKqSJr1xo9-A zz0|8-QS!!ioruQ}9(?QOrr(htXSg!*ckg+Uj5 zg=*Y1U9Cc@#+6KO!Pk0T+=KhbeIVczF%?k7QfdC5i{ zioEUR-jGBj;dK1^UuRyk(4ximwIZ>R+|NhX@c=#Zq7AMjkHZj zO4BmI)8*;?FL34cD)wox(rLjPT&ILDvYD%~B@I6cvTn*PV>?bO?AiG9OEHr0q5DbX znI{owe79!C8?l=$-Ju=pol~IFCXf7efFPVMz@zr$vTo7!4orw+PUH=m(%rW99@o_y zxh_Uo?knwWt7cX8W_la%Xy9$n`P`9(kZzstG`-D+XPCCZi6RY+Y17C;J`Gu(Ue8|V zcJQZN?|~}&3c~zWi%Q~S#|1jQ+qz8Xi>yxqzrPs|jB$2WQvVd*#|av_4drr)*m?uc z7Bc*f7>`qjf?ReX&2b{vBfca4*t79z#F~JU-2{6uHfg$p7dM9qpxgR@*K=bpU&PL-{5{4 z@@dZ*qDschN<>orHj?Qi$|?|g{7%!0%NbKF%y7E5^CQ+t_qy>ZBE66~8KFNAdb;}d z+%W0I@P&tky1J|?*SLM}UgW$R*<%4BipL?Swl)|{X3pZA9ENaZLf>7er`TVOM}u#? zFY}99_x1TVpn4TgBIbuUfApe0ML(-~@K=4K>Tb`#(_|%|jKmw%i532(1#l$|G(SHV zZ$lx92(Z@o7P7Iy769IyXXhMYa!~n4(kh@(M~&LO$}0?iYFEzwcG>sJ{cuh8m_+aK zNOuThWgAYq;I7Tv)q%MjlzRw%(XQSE+}BtA)UXOu40u)3r2u^`l?9!5!|(2VqhYaB zXlW@KvHksfc5#?^EZ!{QwuojC9k_$Q?ye6%`N7PV|3SX0_Nm4+B6GIuV2_vqD43+l^xI zya=Kln9DGE5tV0QRgm17+WC5G7AOuZDvFUPZ|!v10bof}19IxjwuXQhvA(I^YZ)yz z{|6T#VR+sL8z_>p(rWupKUN)mU&TL<8d|=_6S@_n|2ru5FRxg~>XGmGPxgDZopW)) zY=aBuZZE$p2$7NsKi5f_&vnaDZ%NT-i*bE@cfVqD(p+NlleKlH9M+*W%k-PLHJ|VO zm6SZPI2p1uUmYi?&>;7f8qXuJ)kBMX{^fkevX%DGqQwD8dA}r`|JEj3?_su6F~!Ql z;fqI^GfDbMx&kDM9&&%DwQ4KZVa%gk*>q13UF*?tk!Fs>h8qWPvxh~mt5x%7$}OoH z>{Q1bx>53M4Q;WZo7bUphc_``{TC1KzIh;WGjuS));{NGR~%>Hstr{AT$?u$pZQ^w z;S!a~P8Vk{5E#gq1YrC$a=Pq$b7ZBgXL&igflv;s#grr6LiNyb_4tONX17UuYG6eW(u^j*>2Zk8v zW<^(z+MyQ9Y?knNOaze8jUnM|`UGdlBoo`0C{=K=8-)f{WUbAtA`7wB12ShobG_J|%%Uk=NR*jBj5wU}V5jc)97$ z*Mpu1)*ky}9lk2##Fdqk%Q>?Miye!qx61Ei^|t-|;uY`J;IwFrI|CWTgh6^oujixk zr0IM|lF@uN?P7c^YFzZeCHZ~q-f6czq!!IGCcSrGlH3ou4O8{FXC{mDcri{fGVp4= z1Y#9;nPknoOw`khBU?yX30hIgq>@V-tMB-U1Rtz(t>AuS1%JJzb^1+CklFKz2YXk2 zAD;ejnWvQTx8|3@TpBZiD!>7)Ix^t4Fan>Puh^=QSH+%RP<}^Ay6eiVUz?QJAm1P}Gh?LWA;5hF9NxgP>U@Kj zhQJema60nemcRn38pS*2?@~*h0S7pkYGJI50GwjLuZ{nCwasdaFQ-Yn0x7!hUZOte zy=`gx%VzLLt9vOxU~=_?$ahcAZa5UB>T{1Q3sHjgZWsyB!1|RHihEV?T?#Y~ z1XYnk0eCCMu9SjGDu{z$@;GY*$ZO?vEiDM+C@r&9a4WO%0PtZbd-}<>sV56d6qU=N zMi;`8nBShKx=<-6aeDOBz1n8 z3q8zI#mSROk%b&8V7j7!UYXDG$$d{%Lo2t;Fuhv0YOO91@};;yL=J#ul#Xjgt9h{P zp}oDDP`6jK9kx_~b}mcq6JU!c-xH^3d^~*MC$G(8@!Q6$$E%%)wzcK}SYQHxZQVvI z%$`4vQu^)?kC}>CbeeD9jmK}zBYW3eqd=c8KtZhIb^KQ+7^)E$x##d`HKCab=FT~c zSIZNSoQ#}qy+Dg~O2@{kS8GS23Ks!GcMju%!Ybl+MD#Y*@eyympthB*h~pIsmGf)j?>xr zaG1hQNN%^}qKQoyvUD_F3YwIlJ@bM0@nHqVL3A*{_*u`M!$r+WGsBgq_My72Q8=EE})9S!x^$)H}qjb=A9~*FM{^2 zRc>o<@eMRQE81^Gbv>T3>%N=@7+3BPc?F$lI>CWzc^qV==J6DV@$mFC9UxVP!qa}h zEB&rP8^a`G(=$0}S{#}o(ktVn{o*OtS8#(TE|R~HwV*Znduv@mBf*fA>Qq}$Tk7Hp z8ox5X|6i%5{6Dtmqsl}m>bvW^MH-4WXO$vu$NwfJ zj029`(0bfI4)nz30Rlc$4XGZ_HnF4D&~3QnE6jZ4D=;6SHJ=hwA3OiiArNfZ!7twD zUpJH_>A-k8=Ef!23gbE6O9A<(N~ADiSFGBw2hafmE3|kbIk@2DO8ZK0UtIQ6lEZw} zKWk^AfO{hD>z?(vvaV6ByUVA+=YHC=Ps{K9M!!-xjN3yTa9RH-PaHmujn+)<8+*S@ z(Bym91d*U5$Z(l^;Clafy{^>R*9S{&a&khLKIY~~!axb9|0N2)3 zYM-DVnN~2eGnw&Y)kW znq5D80RlOD+9N@zllI8sqT{gp94B`*M6?Nlzmc5$O6lt5i|d94W7e_cH$5BM0O|4x zmv#O`{=+zE)3~4t^s3=$by4UIeiT23s@rs{&MdNxYMRDsub%|UHBR6zkWZ9i3-i0p zN~M9jb6Au#Qg@ITRLZH2N||$SuM{h#@9OcsIukm(Xc#2}#FjgD>c>INF~<7jn0P^* zIiuSjo$><;_)Nr8rGWkj7SYk0$0?1d%wuOxTU}vVEY6kNFc22>r^szpaP4#2^kXtg zDT?N09+=cyxbv=*q)d0j4X2?JBSgq)#N6|UMH|dLe&h1ckRv_kEs<0?q*$>-b5xgn z(qY=As1BLGf!(7EC$}&u+u7Wbuxm^(OFu*@0`z3cbA<3&1(R_4#`7+5qf}PDC>PmK zpQ}~zwc$?B4Jv-WjEH}JwBG%D{JbJ>+~ndg3(fv_y7bCm8D#Ki6ju3_2~$VQ?Rj`6 zmt!rQXM<*Moq;zmq8d9hUdpxGkbxo?JY9QNi{=0^t0BmJY z&i64c&;F6BYfZGFxKXBpORud0R_eS_rcov=KSkWU7Yoe9!ZLw{1^-)t^na!mTzXQ( zjes?bG7Y7YdtItCVVQ(`@tq35<_fm|t^I#?@ZaPA=DAb@TS%qIy4Ju(6==5e{hqi4 zbp7J1xcS9y*kWflKcSy62CX4o5657Y^v;E24B5SuENVjf@0va51B>cKu}QF^+q%ep zx*UQgfAPmwjTui-D!yR4w;!ea%NFAw?KddxZz7agHz$#_cv0?-_K>O2K~A&w3WeHK*Z9iB{#KEt@~$kiVC_eBtQdp*ky_tH$pOasu1F2T;I3%O|q?{8qcE73fqVeWl$tNk`rSc34RL)-eG@VUJ#o0)%5w$bF6CIL`l5FEh!!2-(KBY znwEZ85F7k*r+G59VL_bAc40+Af16 zMZVs;2HeEbZpmuN?@E9F?@MOpr&^kSgmBq}tfaqUjUOQe(_YbeV*3Ld2RF z-0ms-`{K`VFr%Q*t+>8vOsT+5QQkq3#rWTV0L&61FnBwmP#=xm<WBqzBTZ8Yyja@VgMw; z1x6vjY(WNQZr1;vT<%T2As%MQnyIP()@?lHlyKoY#vIlx#wZtv8*4lR18bO=yKqhl zUFzJalHgoTqoN~=UN=s*cLNNpqB+dmZVU{ZN&^f7ZV(2>J9oIbPcvN1!f+a!8tLiY zlqe7{7}-7(z4A~Z2BPF%pyQtfydcZX+c$2wGl>_t6+ApstEZP|%(w_~W6aIdQF0rA zxaUBCb%c8k3N#YeTBYRACSC~Ym3g^W9=R4Ysjk`7to3*+KbSUFF#0GtScO_%N1d~r zdYJd>rRzi%{efUhk7Y3TKxfHOcp1uI;!dU&B<&turd{Aq&(9cYl!7((ucmhC!S3(u zvW2zy4}rCRl?$i1D}O#)1FF9>o10(k-rT=i7r$CujQY0x=w^-Hz~sZ56HcX456$(4 zqTG?|a5Iyh5Tz1B@iepOs8eS`20|HI|IxLxEAF#fOFYT@-TF`La3|7q zQ(bOL@sLkcI7(Xa>hkW9c1Evia$JJ<)2sNW##eKXNl6L}=ut#_#I_xKxH@P$wI+m`}Y#b>_GJbTSbdn_==w!C zmtKAGzxTcS)?I7X`-`AGsNZl81O9Zlz49^VoU~*MNqyMub_#0c?t|71&>n zVn;iqI5`atr~DuhWdSmub5eT@huISQ5<5-`7!-cy4we1bn$pNLG3tq#+UYx9xp4tP zE_I}nQJH6{la&WS&9O=(>LxlB+RO)PQpVkzB$0vOr^4Zc_1x-}r}H8JGO9?8bmRrIT0g@`Zc6Sdc08%cT3n82hj zOT_GmSLI+wz-zj;RcLxf0jKSO zidMk5==h5-L9YvHbZza`2Dq}b!?;4S`xUag6{rz-jvBp?>`{eEo&Jj9ho#CJo1u7j zv;sd7E`?QD-D4zO0^M4O)P5~3Ekr_m1a_#TBiZtw6I&sY@ge<)9<$_>AXGIW%JNm9 zVPnycx{_CQb>n4vm8eP-o-v>YQ&}fM6Hd!R%d1ye(8FsVPCu$QD@<)V%0YckAnS=8 z=_f6&g6uFBt}4yfm6{4Pc)lE37B02Ogo^3sq<7L$O_2<95xwWzewKf(+g+o{SlIl; zJMt1)VG$@aDN^f7P^Eh`0D%6_`dt?QEeELlcZTW#j8DQ|_ki;TdH|y!+4wNuk(C?c zd==>v--P(f1*`dt3|d3Ukht!yKbst{c(Wd*wi1ppPcl;q4!h%LL$%(|UqcOCu6o(v zhb{ST>S7U3ts6cFWu-ed-%JubZF;$3EoW7%Yq_9J=^bAy6b<4P{hW-BB72l^sjf=X z*i%UCD$FlU@f%V*N7$rhq+wM-7jW-8lmPqv?6UV_wE~mBEe`6cv5~Q65Me^4I&5T& zc9AC632chP7+ALL6EF}x+`!6%o`V<+oGoS zX@B(7MmQNo;EA0Cjj-dV&iLg#5*aw}oq{FBz7E_nX~h>W zfnJw>JkmaKX{$hCKFc1*fu-jfm6z9~$B|RS3L}!USwcc^HUbpcqFmn%xWcZEFREVF z+ebQ29YCEOIt8-hot14~XSip*Epy5W5`7NIwL3 zrpV$$#0B15Gh-Lej2iWP3aNAtEu6CJELkYE5Wvz+X-3g^My@?K%T-%Pl|I5p?r@9r z=mWCFFlr zg}NIqM8F^Yz_W&y(B-a?rjJA}F}WT2dr9z@Sn8IYr`#SU>Vw$0(pWJzXmpt$FeIhz zCcUc(cIs`g%IDL4P{ummwSaB?;K$;%ACNgrB>D&od_a-1DJ|gPtxyN>F_!jem{M)9 z@4LEk6Eh-sOu>1j4|08H@3>&QZV<(_^ty z*KaD)qnAq`FLZbmig@Mq!a}lt*wu;B4qD=pOzu<0Nw{3^IC7v~fV8n$RsEF+BtJ04tHrYP+vr9GfYJF1Cjd=!nLx)NPRyEF%pwMJOUt?8C zo|;E|-asj-NmQ^r_2=0~?q}@1Wc&evk$$(>oRscHSqr|MC5XUw5I4&?JSPc~f8}0k z-|M_9w4oPo%u?{>OOcxsV9HI0yC;(Rl^<-zBC)U5jcvAe!a{$i#M=vPXsaF#6V8t` z3&rE@^pL3JJOD~P0;W=whL}LLfdRSfYna$rOd)rYk#otQpkwd7WZr(fIcc}2V42`h z9$MVdNGMODGE93`@9dsp%AUgH;*b-g#|FJ3UWZUOiAE*k9B4 z%KaFt9R3zq+OYe%SGu)~6?;4v##OlfKb7i;(os6mBw03LWV(Sp?1Z4uQ~+>b=DSaS@|z!aQI(nHl2ma}YmWw|$K#>~1oDwF zj*Xl`i?3q6Jd`L+n+1!W)()(_6j1mQ>Mz3*J(F`b?o0KP^W~W$OYX;j6U~qcjY08A zD0R03i~)G&SHzNHFxOMMO2p84JALmy&_yOjI~IAm{aJOYH-C1Tlj3hrvt2HfY`4}Y zN6QT|a`?AA!$|;jItOXDS;qC~y}O*!eXOWA$e@QO4z21*o`|T#_0o#}JKNLqno4l^8=7G~g@27@FgJIA*Q6vCj0Tqt6^YpoJ5bQ6tt z4+=~a*DF;25s%FeRqxbpylNW5EaQoGDib02C#V8>EuwhcCusm3A)29uL3teX@#A^9 zBA`Mwn0gp?j97i0iU_GeNBrSS0oOy~poLAz;IHm2GL#-JKe21p{iP)iK>t zrO156SA9xnD+MNGVPjofFZa&2Cf`S7n@g1~EtrJdx*HvLVbbo)B<;4m{_T%%0)PA3 zwa@%wqt%iwtkLON{%XT4N0qyWa{>u7W9H|vLnr+A#^*Ed@`~--@YpP9l0{2d+BHn= zOO#5|cBW!GOE-y$f+L`<*`SKd&p4{R((tZ(R&89QJJsdu-$=J63=9FMHg%9a5=Eg0($&glZn% zR};h0xM%vLXr05=5$T@;IOY5C{RyPQhSN&PPJAZh)J2rRUaJARdV6@ZrkN-^KTYwt z0TA_s)Rw4MUY|+cn)o87t-Wq3ioBWeTg!alrg0+GHKF3DI~B5NEjlTGlXK1>v%s1& zzrV$7cUvu5L7eG_%!j=AtN4A)Uux~@VA8;As9CVebyipK6wZaoNjpfqkiOZfi;M0k z&254yzfz1q+V??2k$R%UYCdeI(|%OiRnv78TF2;o#G@icHejLz!YhE0MegqJBBmHP z#Rk%x`1$4(W?z8fju#WkFWN@7&oddn?3T9liWo;5{n^ENSx#>kcb+02mnmOnhE#jl z8P4)DhjW@oTUU z3-M~sqxveVhZhKW5*+QPo^m`zO?D-#1HJ#5rB6uZ?5hN6*a z7nuJLJ&{K5rx&n1STQTso%98*O*wM!#OMBHK&GoyyA|Nm5jMEHz0c+Hfb$Gbb|wf+ zhb1bqJ*)3QUt|k%^0NJ@Bfa|Sma60!_=1{ILH_CK1LUFSg3H2HefO_x6KTBiCOT_h zx64M?-J&#i;Q=?4H-93y{WRq55=GfDcj_+f%I>`iFne-cF&)dGDIX;V2hYPAJz9jg z#=GU_iKaxLp&jGQOLoe^Z?Ts_a>B{+z555;&`b9L9dwXxc;p#|9f&uIA0;Ci7UR2( zxvIO%5$IN8RX4|d|9!vq&Y^Zcb~~d#l>KS~`RWKJ*U;b8(`yWumzPI&Ny^I`Kk*0p zzFBX)X`fm=Jg};`0D+Wql`oxkFHML8PQDE_p6-ijy!cdeYMdwUQl6huqyJ9mci8+m zhU;7xwEmKoBH2AmUOCKPfHfqH#yJg^ku%rkG6&CQT62z~+UNuhaKsf#6cyDeW??X$ z+@{It-uRPvY??eIK}Bls;O`?mTA;RceommPAaKJ=K5XMeUFGP+{a|$prYt^F=Xc*4 zdwP9wu9wF{-90d(at6o2=aCg5C_S@a`SH{9f5MiXn@bvjKRZ{dj`>&)B=QVNxA_v0 zbFHDB`4+MJ5`1xYGv1&nq&!OTJYz&cD%4Fov))Fl8AoR~em-mc(a(4l z1-q5CdQ`X#!Pn}|hFZlRl<4*hn)CrA`e@!t0YuJMaR(sSdE(^K!*lHSKCjKME&`7? zj-Xa~7fOVp2~R)Vl_G$jz5SwMC59 z+D}wo*1b0@ozG#-9P0C@(Nf=iEi>J+J=9aApF<9=p2}a#g!@b?2C949;blo-jH;#3 zWGoets=Y4tvKo&eqNo@nFJoB01b0Gw^*FxZKXM zM^Xn;Y8&QhJKH1fFlFyLRad(@ODZMl=~xa=?yB63jtgVpBw!{|hmv<{5t17m&KilM zag_s;4f$$b?!9pOowAve$%ccSe06w6n(bJg03H&!wh~N6sUn5>7NqFy!!a`Q9MfWb z)S?qOV=o5#-lnBX)6Gc}!fVjrOrPM5c@eNgMl~$CbTxT={x&yYkuh;CSzSKw!3(&Q z6bQ!F>B%mjb;ogY6KXcU1u{LY(jJzSWd13+>q{g{&P?_-dOc?KyXgiXqUQ@B0xMn%-IvvfudUM z$_WA{JAOaR-nWKjjNDh!kXWiv)_XvHuk(Y$KE?2FiOjHHKEcy3HT&p_e~;*6y$F~X zUdydAj(-1%s5nA;8!(6d@sbZ*xlGI{9QpWcph|M7?5FkBF}391RNhIYJ3^anNBk!Y zbXZS1?O@mHLnb?a#TM4-mmR+l#*986PS(Ig|>J=*Yi`INcB7g_Hf#%eUaqG`evia4|c5pyR` z{mrBwpJM&sNdHmT-k*?y*T$TS1!f6OU}j@weyMdluZij~jlZK=%7w`_ujR!g zu*Jvc#tyQ_4&>sA+}YXVWBb`+6Z_3E2E4f-72ZN_Xum#NNvswoRs|Y6gIBq$3=*}V zu~6msDt+@ReFP>xmkm=DtIrmzHO(6zi_?c{#p>hr^4KaBeYRZu{$m3Be(fk_PoAtl zK@XZvi&9n)K=1=AY#vLeK+8)@{DK{Lx|iSkuGA}+TPs%&1vZO7;eC996KTPyo;92!0cXW!1^e&1$&3%2TQCnJioAz6e?9ZQ<6pt*B zhVSQ`QuG5S`<4>DCC*e%+f>q4$pSlO_O!p+u`dj7>&J&?DTc);YtC9XY?&!xLc77s z6r4fL^+*bjR2@1W5VX0O$~~1dweA3EsIXReyRwlj_0t={wNE}gy-HOD6Ye+afFsNm z5M0K9a79PJeCBI6%F^SQvLZblH_yc_*q$6DFGlBS0pclXj3DbFW2HRl({(1!bZ7E8* zXXVN}Apbo_K^en^8*`lOj3R&o!JQmI7rXNa1xuTGqXt{(^zvL1rPy@6f~ulEmZFzi zonzV$eR!1?H?Nd~$(2pi%H?)C7uy&1l|aU0LGQCZP>TYfFEGc%>X z?q@;C$o%7@vonUnoMG|NqyS;9V2$O`kgnsXZ_#8pP|Wnf#-bevq{ukPNEW;;!w%{+ z3$8}PTmafdJ^<@c_;4hzbq;!4FE>hgteT7}y4m*l?Appl(DieBR=V%dmCODWCgfaS zGoF-PJ`VJZ1^0|iYHw&){L(2UE}cnl>vS<#N%C-K%8$6Avw1U(WPP&X;&A8pur!E3 zF7TUs>w`W2j=DtQ)>r7~U~xJG?XlV7?C?zTAgnT+zOpc)%0lonR9_WjL0P5M9Z9E_ z5GROMjO2NNvX3OO>l41vFV9DL-il7zAZue|c*hyeL*4+wA^*d%Jb5duokpds=jgnq9FcrH)Y(Q3*knMZG=X2s7+zounCL$2cQhM5I^E+r7lK zY!S$q$wXt6Pe0*0MSoyWv@=sFQ*hSPgziSynw8j8X5o2cZ@<*2B)oG^RkBiF8#T9TTwlqLN!pm5jC}VXlcATr zn@AX2kix4zvxdEJP_rX5ySnFizAtsh%Ys^vtRf9;U(_HW1KOA zsyWKfbsCL~1-4e4IG^aWO4W2*Z>mE#;o{Eamh@#3UcL3kQ$AjkMxN!mMe9Z; z{{##PpNL0FO3@4C9ceDZ!yLA%5GpNFXD| z6W}h;V+Ms%6FsXWOI*FlAvF`5St+hG z4dKbc7L=!ZNJwC#GawDkc&sSvs0U~EimNeu_q?w1rgIBbXcAS8b6B)>2-cTq6POdq zkwX!O>5n7cho#|XsjA)LiaGmXVbRK)R3Qg|sL`R6g@@z@pAanZZNBI) zG9;a4C$yC72MMK-8$57bw-FE7FooQI8XsG-LwZ~bZ}?(7gByRMmOdt!@eHSTmdw)K z+R|9oW_|#_U(Z>&zP;eGIo!wrL&gn^ucfA@2neD)?o$OK5Kc$%*nG?mFl0pnk3Z;N zOM}N@@T6cI>YjMyLSTRBj=r0L5eH|ZqhuUrJDrmXv*IX@#Qwpj+JvNWQUwn3v*R|! z;Z&iWHn{$o=6UTZ*AuD*cxWijl{5C|JEPo-22SKp!!jz~@GIp_`bgHAPN^Kt10ZWi zLBTjmDmzDWlR-&&YJ6zRvG#r05wI=K#74J#^vH)vNhW9GLOMFwDyLk!7noL%9QAU= z`7q|rOY>rX`S_r_vvayqgR}ddJ)fAiekAN=z2aW#%jJw$AEW;* zyuJF>vT?+`&e=((nuD?hx7jNjq>%P6#w z(Qb&`yn3)YY}7e!fxLGc>1ZkfsJulh@~hR|U-=dhux08_!31C?yT+ihAV9ZW%99MW za?9K3>xcC>kKJw?8!fbYEECAeP0TN?OBs|y2JJ zUO7AsiF7W9p^>HL`$ath2}q=ZMlo9=w4W^zQ>6pNr-%024jPxUv*D+v|FUbT@YN?a z2?^a5q)W6Q>9k})$`&G#q^YZ6MP-S|6n1(xk$l(RWhNOQenfX6zhSJ3P>cP#yY~Wrw)GsgM(_RPPk0PZaTN>6c1uz zRWPymh%G+vEPJcXdg^l6dUU>fu%3PZoHykvAkllI$ot}6q(`~&)7V>g z?!SHZwMax!w4ju>#OCR^*WuKc6TYYSyXS})U6M${?U1Cew9`a+)YQeE;%2 zL5f*JWOU!#OwltH1AFMB?lW zMLhjFS`(H%`ntwIU{w0|CsyHip$Jzq#{g@)CyzR2UJz8?F^J+4wP?FnBMxX zOLzJA++URKPByBasH1Zr@O~d|P-mZG;u`Pb8PRAqqcoIxrhFrvSzNgE$9LS3hN+T4 zX^*u%vp&+Nw1=BL%)eCVSWE$u@axG}!^Q{G&o*q1Zc^P^lKFv0U;aL>p|Gd@sDjt= z|Ao{?EV3{1+a>Fo8(r9m=A>=~o9o;@@ZUzrCI;06w!97#N~1&6&Z>*`xdsf_8AS{M z-Uy(f%4UcnBzFQdSF72K4rI>Vx4*+Qc{(-C5aI1tSh%(~)22>L>a;&Z?e@J)`3YL~ zsp*WYU5o467wJ`RS}2jCEe4HjD1aJ)3jvDw2MA#%pyy-e@_&8%nas$Zdm13%a;7FRNXM&wYXB;&jJt72nOUtFucN zmB^Q=j1lnH>5&iVZhg5O`q0EJrVL#$`eP_QRi)-Osx|T@%M)gnI$!sw<6p&_+1G!& zBKme)EM^VN-5}G7p^ua#ylD~2xZ0JlcoMf6?4Ofsvvyet0?05|&jmk{=8*p~n(*%8 z{e4PbVj*Lzd&YMihnPseZK~i}wfAo%X-|%w#)cbE4CdxBEDqOIs=%4|ueJ6Ah*R!7 zB>H1RGLkR-`{MEP?I+gdQ-pslGq{CQT_25SDW6>f%Yc#xyX~yQJ>pfXu*#s}O>N_D zC)f#Sow029>d)AE1j@)MnB&Ou)ANdvL#I=(no)ai!Qf~dpX};X6{ie5NPbr8>ZzDH zS{(K2xO-Q^CFPyhrH|AFoo;X1VLo69o?_sfnsL!FV==;%AG(BI74Ye*v!KEsk`bwj|PK3Z6rRwm&Ytp zYC-A4mtA0Z*7WxS9)q>!&G}&~va!~m=v*9e?(&ARM)n5>I*BF+X~(BmEq>+UjIER7 z!ha%wfd~$P7fROmS;T26KJbmQF=Ma@M?i$qZ!C5^|Hq}I@4_ffs6r=4dk24!A_R*9 z12RJ6LgO$44LbjN{f#s@r+h!QAKU3Dh?44G9d1%|KGor#h?*Bw5uJHfCmZ(6AXkZL zZij6vs_3+zfjNb(UzLzYzJ_7-kuak1X(-{Nx+SeD6>DlO=&_IQGjD@}jh%vV&mEkO z9Z+16B|9dZ)A^4welQJ9dTeJ1YfAt`QTF3hINwUM43FX@6j}cjO4>h%GFL$OE!UVbQF4)wzV#GFHtD&Tdu)xXPG|INT7<0ZUJC zgcNhYSy8RO*c||4!6kwu-%gLUXCylS$7w`4L%X#cpIjWr$wy$R5qJ{=&{v9+KfGEj zIK6EN72lXOxUX&{{@pU1aT~YMmnreMJRV+^;(Yh`Ywk;$d&ej;eaGa76r|!*M`{Kj zE!!9J4pq#j{?Za1lX=!lKch9=2vSp$AS<=I$=uXW=U9RkEGiYg^rXBj0F2RXJ{S7Y z{`LXNBV=_BOwBI}p*UG1FkSuvuIUT;E>2FJT_E|bnG7lHL1fzS__=A&d@2P{x?pVM zOg+PF^zuyn)VYx0GlU0M%PYtDVC2DS)JqNDUE}aqCi+8p$00LZnp#g1*1mi$kF7cJ zv~a&!e-o@GQJwWWS0!hJ>hxQA-Qg!!>WWYc2Rrfx;zHp(AbU;x6mt{JmnNliO{EESJinj)HCPHaYZ} zY{0&Ya~Di=KGI%ZDcSEsS?9MVSo6Q#Ew4TPmPFQMA^R$azA%5#=&f6vz1Ovv$GPnv zx8Jo^U*-nXwTc5-sR!7cAu(1H6TCPU2TO~$vEw4q5hK0gLS>75zv?iyV#X5O^>IO< zt?a3(U*2smzi_Z_=iMiKPo@OWz?(n{$FhEDbfSH}`t6bMmk>bD^Y)K-B4#oE;+Xl*Y3T~(H zvu)Bx|IW_N!HLVSNGh_{_$+vl506GlN!_2@QR1CrvM;pGd9h>gj%^cT9w*U5qP@lO zG~DIfeTI~O9=>jn9PtG}@l(3y(U)9KK7zQ%`sv|Oe3*ia^{d9Piuk3JoP>gIsTGruP0mfi@qnq z(n+)1@`Owp-DDmcNv#Tn9zipmvDiXQO-+?J%(9>(B%MQ@8owt6!tN%gbK>yo5~sg; zkGdzyO`TxH4VIxVP4O#@lNoCU%&9?%P)91}P!wc~&1pPP`1Hm2lAQ?gn1#SpshRnQ z0#%2g)&8sS#<&hC?a*mKPYzD=O-RNX7C!)RHVV2avO1C|xb2=}6bL*n2wt#)8JsAf zM3vN0F<2+f1N_h8Px@#IO)Lg`0aI7e4#7CmM<|70wlj#ayQx6k_Nw2_yzPYWqtkNf zV){Kbbss_R7O}nk%@MDvl7Wg2hT>|Lg|Lth3~m%GBIH=1YzN*d+r@hQA-`8%DvT%bCjgw@S$DVPLYIVVEeb?n!Kq(=LON6soatZtQbc?SXfky=HV5; z{xUVifCGy>>}x0m)g3mug^#;AIMbcr?gdHY7Pe|~W~%0f(t zPO;>ZTxo+^H29cqhfY;qi6|tZ&|@Kxp?B?7>CU6ilccoAt5a60--a@^zt%P|(}_N( z8da+IQ_SyiEj%01RLVQrs$DMh(su)FBjDO2jGf~)Sqr*0R(J$Md zKkh!EuiR&$0(?`-`i*P#YN^jqF8DqS{4SHvUcoxv&|SZUyEbAF588SK(>k4r@JQ=3 z&`97@Ci>}S}GNY5*qrt*Kkso!F6UalFKbdoKLb}*Ol2lE-DQ};tqOVv0mxPI-#I?_ z7R~bF;@=o<4zc<)5hUD4{~=O)2|BnkGtjMUL`1sC_#*1@hgQi?=CfP}g(H#8eDCV@ zE5Bk~eAJ{tLMxx1IZgkmaJS8zf~QFvfBe8OB=^Kto}(q?PMoi3pU07yWBa%1^e2s> z!V=HfHC>ox-V!)SiAJ<|l;!DZ+1VeaAvPjc(~k~wpmT3uXLXIz)cHvHrv7@xQsEWP=POT2x=8j1{r>hwLs#uw@1C#P0cYoX^p~-N>=drF-6`vD$ z-T5<-K7ku?B^#kW0WRZ|A6;Z2|B@1@t?%A?+YwMKXh}s2iwF(put0`CnW_#ixkG>J ziJhz+=dvDTgNhf9vb#1o0p9beMe#&P| z^D0sIn)X^a63_?&#&3^(l!)KYtcYum&E#LS-Fm%Km|*R5Sj(u}YFRZfn5qT}QeOE> zJ@w1Il_LcgzX-~reugocnEte6-e_I*)@8r zVH@e#n=4%6ekn4xU9Qex8yy8%-9DKjao9QP4cjy-4C_oSMHJcg!Xci{>BWZH(bbIe zjN*=~nr9ep0Z|6L(>2BU$eG%_1R5I8~b@ru#Vc_kpLHP%fxUTbApUax=ca zT&dehtRHUdElZCd`^X^O!#EteJlfT@amf@=4UZ-ZCQ}MZr`H_K6<)?0u6l7T%^nGTmdaLUPwiG&qgco16Ln#y+oWa1zuIhDZ`T*=>gb%StAyg0FAa*2&)iSooW!AvYFi>|w)A#UQIU?pG_wYIX=XZ(NbOu`5z;X%`Jfb@Y-UVTbTFF}C9u+Bix`VA_*v&-QMX`` z@@snw(8jkYu{n%R`i2*(l?H;UKac<^@NRTQs99q+I{Y)J$GWPs@<|v#%XtOk%Q#Os zXXuJ+f&^TI+Y6e(NfnwJr_1)KFiXt>6sD7S7To#Hd);HN$I^w9lmTL0B_1G@k`nPs zE7@TgoNJw>G2IyWyeiZaDv%D3qYz$`YNbFx3qqxPrzB2vwNxJNj_|GzzwLix`D0T% zuVG3B8DWzTO&95Df|i=QSiPE9$ZZVS!1R)cvE@M=Hb%$$TSB|LRNC9VAA_kqA8Qk9 zFO(=d7lbo2e`GIcOjWp7XbRH;ETA3R`$~CG!|w z`v>D?rF?y#xve=<<>!i|!J+bpg03CDW(i)`r1#%6>}oLc^*9?d8HQx^ZIqF$z~hCb zfn~SQFneg#FvPly=S~6$k)6Qp6#16#K~%YVD}}n5o_&+?q#q+fQf9@ehmP+2YQt+!qJh?fKEBFA<$~pFsZDR%PG8L~ z_t1LX^LyLenTg#8(40U2BRwV4_V+`t`uAD;df{$E^%2Y8v$;=xdijRkM0gz?th7f8 zKOrmMj+%`AoMgd2)^c*`H+$$e@;hMP>e0__H<|jYmiBoI56EAcU8ggh_7v;W%Qn^I zj&nODV`TitY87pmn+wl^&oI}Gs7%oCd1 zOy%&Au4wh(#VEv<;k!LjKY-Kh`{o&{*V2Dbtl8&dODVK!$o(_lGW-HcT$Rt}QaXNN zWg|uRXl$hkzWGBM1!n4tEZ77vvSQy3UCM0yI%x7ycXU?$_So*1K4E)!sGW z1B&A<=0L_#aU?}CeeZWp(NP1%v5%2*6fS*t1mmqQQ_rM_%Q8KSt?deXnoL|%FAEVG zZ%>tF5CezXCvaIobjPhemKFNfF?KBS3Je3x7X?L~$Xn*IS*mREj6yF9b3kly*VxH9 zcS?RmigSY-YGF;JFk56;LTueY&2`E9K{`CoLpa;T(NNuIMd5s}TN}xNk-Y{N>?1!C z>LHI5S;NUS$iezqYgsosX}nAWV3EmbhmDF{;=eFI_cRDBq66Z931U}RJ4K+ymv*(6i(XQw+}5De?4)` zdZ-v%@hSF3S0#lA?f+1FHvDdB5F#pOOvl{LVv9~phx2TsB+7+Qsj;v=%V0-q-V|I3 zs}+4(AsTDRUU^u|LANn*kL^VZ$Add>sfQbV9WuRBC=9WEJ{Y#^wW~s&BNpeePaVO4 zPG1k8UJEB>$7qrqADy)mbQ+>(X6jcMI>Gt$Cm5tvRcZ+1MmLQAZV{PwwvN>6?!e6K zf^}A@s7?|{Df8l!#T8kz5=GE3iwKw9M#)pl6VILZxAwNnSLVy7Hg4UzG!coL1V@(F z@_-CO!Y!UTk8Rj+j{2zr^;D>S=U=$e{dzZ(S1fwIO&nZ6U(1|S5l>W5|Y~Yh8}^-6^MBJ2*eRT9v9T0OBJLl%S~-qr}jNHlp0D{ zDKcbN!$7G$_GN{VF`Oz(b5skzr6>?iN~`Avi=vKiQ3%Q{(bOr&hQ`T^>6mg5`@v7qZ$098QO(Wq@lpCW=79A7({Z%wZi0{(+nk z%OPKvwd_{VRjJ=5i+YMy_@a1GhmZ_l@oaQ%z;(@{G zO7cn0ZudQtROO9q)TLf=N{)tTQ71fPqV>+#`n$dvBj)q7u0aEr{6YRDZxDez)sxST zJK?w6cq!|E@1C#BfAUZ8#kC_Qj4g5zxq+D-W~b$grkSszzmd&U?=_7z?k_Jsw7v-n zp9q+?;+?b=`HVNq{%4^rgtx=~hS%n2dld%Re|b=i<+`AA0_eUD4DzUdXn<*VR4EMu^K z(-j7hNOWmv2OxSx^nQ08B*Tk3;?xAK(>co2%*Qyai>H%g+8>?ogLPBCG$B(j8oK>(JJ zG3tovkEl^(Q68EEp(C_K!kvQviyMJ>6Y$VDeGq;J@!vKaTa}86mX?7&x0b$L6|_nR z2}0xox(K;>9t-3mP(d6#)J2(grbU>dVslJ$=f3;;0g;kuIYoV(_Y z{w8DJ-n(_&{}VC8y&ZaGaByPYe0p{M{(cKN?lxfkj;~eiNbI)0PDB-+y@QpOTmbe0 zOL6hHmDch)BU3$pZ1ZTfF@N`ChQ~TSw7nccJ>C%W^oVqMdg>)NI;~x}9(Cf!bP+0b zN>GhLKYW(ci@SH5X>sg$Z*P$Oe(}UYtT0kb>vsD*+%$4E{>^T7$73%V>b(*O&OVS3vQ0(+b8z^YD^A^+2#x@U=P;Pz87Jw0HOX2x zzeqsh;=SP{le>9C3@6JIK zTDYy@+RLdI!oQ#-LL?&??ix+X*fo-SSw*R+@qWt$RCm(%9*!CMC$C?>zn95sF_j{z z*8i~)a`Dim_Zv_In%CAIU7zy9)dIe^y9ZxQl=umkXEH&p++%ztuIM+LZ&wRQpwx;p zUM+~g;s9Xk1$`Fkdu&&F0B(@-h0C~4d+^?0sw4Nk**!7iUrxWzjG5jxdYQC$GX|MO zfFrO2vznnnfDY%Ov7i}2eGqT*N749_suDm#-^Nf>a8g*Yos!4WD-)T__46CQ%;4f@ zha-~saQ1~1eJqk$N821=|K-p;fS`!v6buX>Y^K`dSzJw<$!lI@m1KKpLuYqreRiN^@(B^mFpe4I($7PcDQ=&9+a#b9Hf@4rKs5TUj^knCV zcSyBXV^s-K$pb*lJMe5_dfgETLGUx~3OOnoc`VgzfL-gbXla9I4Ta@xvyjj;AK%FP zu9~#b{=-a36sQbB5s~X6W=l%);y_SyT)ZIJY?7X_ziPcPJnq}& ztY`jW{3pK2nLj`8h^5I}{DG|xz+#Pp2DjqUdIiwuK55P34%_qZ5(ZFseyhqzAYB(7 zM-ppTLviqs%Y9W|alxfzY%f)47hp87OOZr2*Q-STfw0z!w3U%~Pa?fuN>F!owd~43 zF-cS+A8$<3!w+H%MpIC60}dln)`&`FE^>0_&^zm6tkYebna=Xu@m~Y0Xd7evs@M0< zO%AK+u3cHr&eOR9Y$(Sq*rL723%=gteNnrYcbEf1uY!d;sPp?-$*Kf0xsGc^LyY-$ z8U<6He5!_)#h+)_NKB87tj~LH+2%nCp|vKKm1WXBkkv7$bT|Da_^7b#2llL-2AN-1 zQ#3k**)()KLFbdsq(2s6`_!SOq?ZG;Z?)t|je(*R=_5GxMhk0Xzs=WkXtTbfwMODn zyI&h1Rks9DRa?~7k@Y3mF)a{Gxl1!}i(W)DM8COiZNU7E>^JTvZN1Wm&_W+en2rHA zIW-LjKp+tLcXm zuRp)q`I{CqWF z%yU+e){V~u{E|O3C;H$mQ|%nBW3z=od$68SmjT~UhdrNZRwrO8uz9!c8AAWbjQAH6f%g9~?JO@~tW2AR9{A#L}to9JiA)F90O!F|!Q_UX%D>*(4ed5clj580eea=XCU zYbyr-8{nb$w}Eo_qz0tNwsu!_1ajf+R32^eklT7d@Q-IX>+gIM);oh4T+{-FJ%%kg z#=j4}y8WWtI>tVkgrl=~;&_GZcHwrSM!m(n&*&G$-NsXZasr=+52s!$Z7;m0+Vzo= zEVCIBQp0p3%;I>FMzKm|7euO%UxSkYTTnuUj991t_Cl^pgG5 zxW;r}W6PJJ7gT2^zy0j%rtvm8w{H3RF5TLj^6f4km`d~NT0doSyvW~{xxN2b7s4Lt zph{nf4!AclNDC1#GF*xk>7XcYW4q|OHwE7qP8N7=gd-MEHTaH~D6!)X#20nr|9cie^}$)K@tDr@sHvFyNb4ukt_b zIrV>td+)HOzNJyvf(VKt1T>(4w9s4VRYh7LfP{|Jgd$aX5fG)907B?hgwT5x0w}$M z^d{1KmoApOK|SYp-t#`s_uap4o}HbQwO89Svu0+s8T{*&v=sMlgq~IM7s6-IcdSDJ zND*{K|0(}pSo#MB{|0%S9AJOo1z_!Od;Zk&j|%@0OvEWHloS%(n2==u?<{AC9>vGs zq&+8#zqN1+0^Zmf&dd0X@^i4@0j2!KbO{Q`2Sofu-fzJDe@Fa=0T^-yl)r7XRp5e? zGp^zRhi*^g!Aw`CvRfS+v~6K3oY$VzBm4;)N(AK?8fpc`kqlqR(mb#?W<{HjHg8}) zu6mol^{HYgN<0+Vb>`Stt9J@b@*X zIa<2JY6{-bw25>yc|qasQ@Yyvmt1jke3y4MPQCH*E-cM#O#a zDtbC z-R=EqvFrw97Q5q|f7UgC*ZG~9Td#zmea7mXbkBROf;qQSjL_YG^t!t^8K5(tzm2!f z;u6dU@0=B$)Ab*k-|GL{JG~{hgd;wV4Ts$Ip7?j#GsgFugZ@Uqe>LD^PX^t8unqiw z6!{+oopC>o40`%MtvGLf1OFL%{&1DEAnBK`ZVaBS9wmAMOrbjfkZNfgfZ+e^fB*ol zd#?P2TzPV zveAYRfzBDAb2B~t>+^p9w=MwD0Pjp@xAZuN(C=4@;YYU4{G*8f5d?Z6(Bv}-^f&n# zm7LSTKY$H96VVzu`O7E%!7{W;z5vxbmK2R{upC|6q_n%l>li-z@rfQ_l)NBgKC*KLDIx^mM1396ZjSzE)b7arBmPxXxb3 z4}0+lGI`h0Td}bBADFw%u023xrtnqdH?P?@qw0(L?0f}ally;OX2ka&+!iRmWw_^G zU5WG{{YP;Q{Xbh0@TB0i0l7vX2=*@ z;`&9T8YPN2dJf}V-}WsjN?TnV?n`60Tu}hJR$?W%q@H@p<;5NGnKQnqzt5iBN|>&} zTdYfkGeU3NxoR_p61{Q`nJXD}_ah=gZZo+!+~zw68j!w0f$~gj{{dYd#iw%~M2pfP z?HXeN?*FD!WJ?HOk*9s8LC}gf1KhrUu2@h^c{2PbPyG!I4nUBgmx#<@O(KsNe3S1- z`c>vj#c^Q)l!5yu-^+wjE-rP|>mG}?5Tb2-Mb z!AElI4a|Gs^9=wbU)C#Id4>HMV=Gz}fHs#`6=ZOVl~ew6{sSdvlp|u8!wKM&(DHYW&?>2q)s#4XaR<1aYb`}U zhm_QIzw#x#`rxSP6QG)W1oR9*#UT9ClQeiU_njQh`|q~j)Bq`v@sHYb%5J$`H~R1Y zzty1MDqZ=XZpz=VqyA_aTMTa=M`*@tsrPUMR>rg-Z1X{&i+7Xo@8D3@p_KxHlB)0p zv@Xf8EaDMO$?3`Is9w)?i)%wsexGvHZ_#O8u{0O(vEn%$^Yxc`l;a zv~d%N+}9}D6aqy(F$y*c@+aL3yghd#Nc3{~8bx4cO6u&(Fnw=vP?fWrb6@69Dk!ka zB(-i?(M+puTYwVJ`(xN(f8>_PD=m`mP1nS~=&E6wnylZ0-XT3x9C!ot*WO1Sd!f8F zw|*pDa!4Zd=q7*qftD+g)Zy{~=F@lA++`T`qspHlr(6!X?zJB-a@(It??-+)|KytQ*jB4Looso|ONzZl->kD_UL8)D&!1DJ9QX zdF#olf{70;LFI{{p^R=9+0wcWIu~~P*_9q@mz~`s_g~6o>S{`p- zMB7mGM(xjgho1-pkr%J-6MXmDCiq#D8Zdmsbkz6tbLz43;_j^Yuk@IDo#(*f?9}{s ziq2o+9#2>UVHt0@E`NmG@OI~W+yqiCe~GrL<}9TV(L_}hzE9B39-Tf^7ECaWN4fN_ zk5;K~-~6dhm1Slv4DFJQ!Nl_o^9{0>UGuSsy20(ad?FV3IyeF3-3L$c7)A$LTzqu# z@~>-B?GfvltJK_gxnG#&QtuyJ63l19lWKR~mCrd^Wt~saL%dmM4Sx_Ml$%A0yFdFj zcRZEYXL>SsC&47@{&DiOz$)iB1NBuK;!YgHr&_1){c*k@lu*Xw5lO@>*xo50`IlQ7 zE@msZU~U=SHx1lRA`9N5EH;~yvs8b~I*sK$@)FFV6Bo7LjKTnWEps`WCH;AMm82Zit;)c(>F?Hb zjG9RINYgGj*{+Pu20Dq!N<~WUF@`1FmUIFXe_>u;Lq+WR`^DDiY!>`LC z&ZgZw{O-f1>ZwI@1#hj(F_f^9a$Ds6$m#_oJxA(XN1!#z%1VPzC**d&PN;RU6)Exa zmrifrPLNT*7Y|>2H*xwD{+6H4*y$ywVvj&z{%(&cE!!n}DFBz2J4ToD)B4WHZ^*tmru=&UXwM8+4RNII|ASRh`TWZF9=vY{y_EFYoYUWUOCyPVT=f+OYre zAZ?Uu7$Rh*M#-$EsRNuEW_)Ln$M`P7=vkRM9{tmYP1X$o?9-90qslY_`Iim-oNJojYS-q*q8Nf)i(rxt&o!9f3jwurvb{@bdEL`7lx zV1AkGrLbo+VS#hzNkn%j-(5+>tt~fZCw5(<)A&BKAxrk~-UlhJ)pmmiO{&Lr52EEX zzXs#yt1pDcz53ZCiMi;`65jLqgGc1Z;M5LFyvd>RY#Wi<>4V)=L&-aH5*;lMKkV9l z(~npUbWh=i@oID#OdjAkl0{(wQm6#_d*7TVP4-l8ub>Sp*$c78d2Ai}@~c#EQeHoT|YpkNuviD5Wb*AMG<{Vce zXh?R!;T7Nd@`g_h^5RTUyj`_Ty}0DqFxUOlaOyA9IV-lr?Y6|qWo;*6SF^g>UY!c> zJ0$H(^eI11+P}Q`@xrmghj@7GTMy#&y*hE?yxCR9dd7vipj#xjq-^Q^rIc<& zl0x~l3N*joLI{%Bn+Wzfvd3BqSsfOv(GF9i>q{vqi6dt>KaCvQ*sRG;m zzNK6kIJtROF@6)8D)dFR$vl(Rxh1|0t6gD{Hnp<#qprT!LxOy6*R}pm<6-?BF29|s z$Fb~BuaXDP;WRC22XHDpdU+MEt8Bh(yW~xEO>HXzyX&S4{TjM0Tj9PwW@h#&e){Sf zj(!9gx26>hC)M^&eAb4))^4Q0IuWX|EHEY2K7V}*ITPB1&pBl?jLT(<~M* z`VaM@T|QMoXNgyJaW=)YMW8f%)U4L6UUP%7p;SFKE}0J%I5VyF{jWI{q+FJav%XHx zvJ=S*ihqTi>LPAJE-%q$beaf6R+Nk%^|r2#gD=h>imM)Z3TAzt6!UC-y4w2eN*-;t z;w8|tTLQi|+;R_@%?TMi_0uP_B>X;9Pw$njWOe+Ae4?w8t-1Dtx_8QNW6IeUw?eud z?KQ!pG2~$%s}sooZk@ruv6XABr!{gr$F|=Afoa^X`BEqN)jnt6T>rgS`PTQ(ZNBcQ zzErKu;b^e!^Q#U7ADVVQX#IS+K5;G4t?!P&%Q~7PaO&qocvj(-iB+%e2g&1unz|nQ zf^jHc5Bq>QUxFe80~~3U0e%n`z)f*VCNP*?tK#|cM5y~9{wu&^*oC|J7X&U`Xm~|r zeF1!#r`&?o;Kp5*D&(7s#lTTlFz~&M58Tc_L}&MZ{X6@^eF2~E!UZ1om?}QQPZk$O z`Fp^Vdg(Ih(o3Vxd?-qR8+VlkEBPt;Ecl-FJ1;sfweqAtOH?nnR-`ho>~|jE>_+Px zm;-0o&QzF67_i_E1Q<(U#=rjpcVI#P{BC{r00@|dd71jLunfh_oXT-I66>R|gn$>_WR zqbTduXq3nn;IPYic>Y;yg=@j8#g~Lox6B(C@IM+}5Fol>b>X7V1@OcLZhX|UA+vCyigTH>0ZzRRCTnB9=+#hnpo zbDlIbWdz!2@D(P}_%@Gs6e2mopX^-}mPMKcZH#Eh=Tn8r1OHXE;LO+%l%Q>9ydV+p z4c4dfh?WtC#$Z(FO%#|X=#8gzY|8W;$(XB~I^ms>TeVL8r(qvuPsDD8HF&)SHIsal z*hYO95%r`V7cng?PnlxUPNuW_+_KD<&m6Gu| zRL|^&a<0TivX1b8O_S5z;%005Mzt^!v(epotgEwP?`PLe&dTwO)~GHvh)%qkhfZD) z)>1wOb3eE0;Hzl?^2A`#)M==X*!=4E-=0tLP^oAF<4fdRA zl~ajclK1)DnB34`3LB?EZ3pccUng3F1#aN`JbL@dyfTq-J~ps@++gM?wJg0ncwDRb zMCe=md`fbQZp+giZSK5+UOxrnab6hw z?XbKWb{#^E9KOGVMRukt1CaPlS}{C4y|9XVt;N{lk&8c)(psO4u#Ri6S?TOo43yuN zuMBSCm1pmQV&md5(EOITgy!xHhk#TO5+{uIW#qGZjaY-Mq-ht-@saX)pG37;{C)Q5 z3hxe`N{(EPf_w;sM?*6&1M$PN^OJN;Z)Yg?zo`QlOo{)B}see)vn%dmT>JE4Lml>1ad%JXsj#q1DxP%)FWf?6$z#30lbW#|g^ zAq+RWa;fYVXQ*)k;(&)Iy~NxftW~@on<>I}8{FLT8qE^~_~ zg=et*;EI>?gO|n!FL{&MwI53sf12QVyxUE-81?C~aNq#V!tp3)mqK6a{dD|-ODsH7 z-`#)8=TIOS83fU!!h5Yn~YDQc*)%re4MMaVt?joB0j`u6)k)tC?>L6}hguh0R=sT|N*#>eh zTxO-O9hY+Hq3L?L&E#`XkXN`Uj`Y5u(*&<|RZ#PX6*CtY1HKJTW^J-5#OAx?jW)Ng z<&?Fo7t=}-$~#^Tc6&q#(}=tIuS<%!Lw7GXTMq95c5GN40hXq&r~v(HZ%gW$tBP-$ zeJ57i3K1teg;Q5!k$(~?dorz{XE`_8Q|R`^?Od{Ac%h`Eq%4%X;f5cY2ZGEyMzu}z z_n&O-wOYruY8wv|ykU`Kc#|3YwVVnJbqRRoOwgb1@iZwgFfjLKVNt@Gwh4>LYlcWU zGA!G+s?Pi@_VZNzWPzLILP}~FK_DI7+xtH0)OV>ONbbrbSg1tS&$jtd#Bn!C*+zxi zeiP-+Oc4=z(840*sYK2$A`vd@_p@5%bMiN3^8v@Wl)&Qu z`R9SbfD{LCt0^!!1rYb_*p5+SGPM#_YfIR>HlT@g3-;_z_rlV%%$u6xZMKmMD#L8S zF(E;3#GVSKFlW5&BxBADn@|{;Ccq;AHR@N+7j724$s#MHoO?fyadYdH3FRAGhj~8r zN){f#zF_^DapbP#gU|3oNu=p$$cw17P86n2E~!qkC)}xFmP-8+FOn>c!H;ckbOl?K z(-gwV{$ATCiPG79Vb`8SN=B)WkmHSibQ_X-L~=#y*35=cOf&{K zH=WV^RVTDWLqWk98)TKVEO>Tk!~%Bzp$B!HP@NJ>ix6;SkdWL>i@PErsG z4udFl1dSW_j6J*^fCO>K)lTHw&Er-?^ zNyC7A^g(ZufE-N5%^Rg+gBtMNL$SIA5afc0Y! zmP3|(d$!r8*>5zmo<|=Hw8NF}zmZb9|LA^Tk}^H{>g?qk+)dZqJ>*kKvx3AF6_tZj z=iHT+JvHTa$*JiVlG8IRgqfa|zL3pu4(kuhJ`7tp4x?9Tjv&&x#2_8S=8Y2WU*#_! z6wKs+;A=HJ#*5;uu=uV#gK!4eh0w#w+XNNUTK`Q&DPl(%Y?+awq)J>{hRTz z3(Ra7>5p&NfP@p3c>5DF8=4Z`X8QY>n}{9!){uc^r9NENET#X51pyec7$-w_|E8IE zU*Hq(FJz7hYM!&OgWB;61qC*hJdu(KEKzyujraJrY7k(3W6pR}oL}Gf;P&IfPO;t& z%w2#g*S*3pozB^(!aZIh|yjuu^Q zL}zPhYm9jWq*EhTXpYK6-IUXWeNHG$ST~~*=j-QE1UoP6j4I13j*3Ds$qZxhCN1!DUjaDg_PL35E5q538$}XF=MNN^>-xl4XZQgM-6< z=&k1;)H)XOH6qE{$oxUKaQVGa+_q1A(r<=B=_{mJS&%toh`7A0+wcVO_e-XxV}np| z7dtO#ag`YFK$&cpN!B-&X6oEDM5NrU`wt`K&J0BmGQ7ToN67Fe+8k$+5GpIzon3lc zGChnO!$f4;m}|tt92inrC?!e9dJH?aEWr?ochhw~%sRSx)v-o;b^{Wc6I5wR3hf@0 z{ZO?bxIDGE>oT(H=_M&w8HMG@&8_MaO9ZTGf`Fr&;VcTzV?L!lWPVb4LQCLAAW1C= zTX=ox!jrVN7_p~vs@_o)Jti(eLWS^B$lu&_6J$_PaH%5E| zlO54L!1MfuS=gABe`+z2n`f?kLbK$Y-2H`QpGkFcpc8>)rK6*lM_8N&9tdmbG=M!E zPrq^R>+Hta-*QbaZUNK*;+FR#%BVm9Fp$mzO@n z5hh6>4onp<4>=y?Z&F{sM9iR_ zh=Mh@?36mgm6|&y%`Zi1kjf!GpyqW>pP+lnJN&f_o7kbiS}-H}@kH{V6<`B8oS6E9 z;JArYtl;F;zS-$oSYz zs{65vvsIa(eP#XHmPhg(X*yw<&W6 zro?4sQAf2BAnv_@@E_IT?)KCz>)iv4VK$|wWtqkXEhomG8P#@_c)XNzY$Svr8lV%g>r7~Tw% z0y6X)|7|#5i>&H{wB|WSF4o)vz=3q^=(^dN0rD8J^`fyubR!C4tk9VU(dh1;L?lGq z&JTh{sv76ZjH8hzH+>szo^w5ZI}r7w<(`nG$&Y1(>38`gxDq6be3jKT1va)8F@BG( z86hMqw@bw&H{=`~PMYBwP7-$7c{(Lwy*7&Dlf!fIs5f}<;Le+pEB;z0A-7|nm6cT# zaQ2&-Sw2()tAWX`;ghf8=~!)TyQkC8#&Eg&w4*4l>elua;if&oh&bo@FCvyLu0_-$ z@$6+xHf(6;!r{p(xH_s{-^}HA5|<`FQRbDES-)VT6wXN;lb7-bf=1B{FN(k%`KRjY z&tb-tFo~J{Rj;7Q-Iu!qilF9qSQvATYMJM^h3?&EJE0`FvtyfZ4f^wXd9A*X?W(8} zb&?%0J9@^efTE9Tu&;5aTisPdqOjyt&&H-o?X9f#GIv z{<>tokUZBBxq)3;N$ALrZ**#Lo9gE498?q!shZY9oJtrW z1K+1e$wY1#t-M^Y2}5LDH&KVj$mH<;iJ8abZe|pgYi4t}T1=u>JaAu{WZ}7L5`92? zI=Hlp{HTV72cm{wRECIkn_HfqFLmLhN|lm1!=J(dw8 z9W~q?6*mwyu>_Y!He-4Na*9el{IqV9g)CWAwVo`T>!r-VI|H0>m@9Vq+r;+x{wkBP zY78KoRRs3}_O~|+^{eHYpQm#6$(V#30;<=Mta6*&<~a0BdTUqQGo?=!id6yhiZ(#D z>n&i}Gb1~r1?mph6*4QQsR!f`zL7lPS2WFLHk6JOv~bors`{gIFQxaKYp*wUK}{!2 z&F7TOLp}{U=jM(jBqRZb<%LZvLREEI^QU@BGULpZC_@;csUC*|Cp%bnX)2hcfddt* zROBL@LbIh4eAO-G<~B7-u~m(nE1O?t(SYZA-tzv;1UvOf)=~y3W4XXC4cocq+tA?% zI(j-O8J$vsM|jpeXi@Pfqs+Ko-EMW(m~05Xl$6@7KsnQuHW|exq#Za^-v-Gl6vhyJ z&szF%i2x+qZOfkr*?}qK#d{=m>wfVnEgvmm8sX<&@Oz}4DIDBUxV-Fm%@x7gh#=}0F9toA$%y8g&gn|niDY+X!9mMH1$yV$)m zc!QDG%^x0zq)R8+$ZjGDmQsIoWmfmM#G7rp$J5?y#2trLmy5U+L~KAu38<4F;3K3YhZVC=h{;V! z*o}99;?|>c^7)7VKdeX#q^v8bCEqwM_QHnfj#Xa+w8f@GxP`aGbz3; zdf2U>8U`PuKVZ!d>u)+jUP*xr6-0WU5Vv|i6sadje(rVD_?}SbL*C&_?VnuhKRaJ~ zwYAYScD;nVUWho1^QA@0Yb(G14(X_f(e~#>@x%jr=BwB;5$@aZ>ZwuNiQA`s{KRuTypPW=EB~S3Ya3kyNf~d#t<1j@z!Jfw7 zU{eFN{1sHu6h@WK-p)RDuJu>qBf01cR_1fc_kX8$?p6g@t%cA$|8}ZYuwVL zKOdL3HmE%EE`9>YF|DYbGVt%YFKhxhS`wcx-~fINo?iRV5FfZJvZor=B?6LXMkF@g1 z@!o33&zgIu9+oS5Ut4~l(yk(EN90P>gOeGv} zB~8u|0fUjVt7j$3d4AxNFQTdF7l1e?bD)O0*{vy!V;U7UbJrEwtS1j+Cza`qGu1Rq z$}uM9znC6u&pF|?=QTJJGL3uaO`bwFas2b+h0m{6GJEXxOB5}+sk=e3-)RDh&@a;x zx_e9^Bhg0uk=Yt5o<3_r#~5?%jr#b?fkTN!krCq}OSI=xW3PZRf2PxQ+^jR-{5A^O zqn_KXV{OXUl3*!sVWA*Dpuz!BRMF{(W@KbR_Ml9=w7>pfl2_gv9$Y(JiEy88T8f`< z0B_>Cp*i)E-kCivSiC;4;Rw}#x_ufxY*`2|s=yWzGB6{fRS( zJIl)aAibBrL;ImX-5^W7(&x>?^DaLu4fIGHxRTmjT zc3L~>;B4eg09GDW!@0CZK7KDpzhk;HdW|yRS(deIO7NUHIfkIaw+p5FK1muw(o0L7 zv^c;X7gQWCDBN-bt|5?{kFSWRps7*nwJFaUWfG%S>ZMZ-u4{?j0R_*M*7M&yn`J;6 zckE?NB#}FNtbTA3;lgXD;HRC5d$R*)t!dEoHoshhqzO)$h~BHf#zF`sPP1w z2UA+7k}Djjj?O6O@ZA?Gyzfg5y9XSn_^`C(s*$o=nIsfgre}*gRypzV#MOq^JDhlC zq1a22lX7HlVYG_!+G-Pc=hAHe_!PgnhKL%Js>mFvpU$XDwKyeyo=lz4U3&}t%k;gmrjr60O6PO>L7^g8=C*?U!uW=`W{VI0@y$9@YB=|-T1hVBD<6U9ReJutV|3Ant_hCPJ7hR9ruB82h-6E{(rs(^zF zzyL=yny8orDlpnRJXKV+Xo0i*c$N&q5ZMD`2vT5Sj|5z20QQHYqAoL&8e5#r`tXOc zqZG9!c+j|2-M)J{3(~$vLBmEOplDkqz{>9pr_`Dqrva8uSF@5$>-y^bUbb9RndWt8 z#X;;r<|@-jayq29zs6cRnyuV96jbgUK8my65ciY|=-I1_txeI&Gt!LMpHq+=$G_5FQNdwCtVi-l0-UY3sz+WlTqJyMDKD z)=$%9^t#*4(&3BbG7_a8YQS)WQu36}B!S3{=ZrhjpK4SVT=x?RQeOkL1pPF7X9qR@ zhFMbrttsb-X2CE_j$27gj*e(x^9EqgVwIdhL>92=36BGgrf(%}C4{YxPeC2ekz zj8HW-$FPVD;2XF~PEJLiv8oAVm)nkyuZ$apn!6~vz_BihnvR1t05)q}lvuZt2WuST zd4OZ?1H2j9HzV5QGR&!IW}jvcsdd&Nn4aJGX|Ups_r0DQ7YCe_Pk4R*Ll(5YcKoMK zFa0J2qFh=WGSs^a`$lE=fO&~>NkUO~-qv0BSi(3faupuWGdtU_X~0SD(YLLf-c+LD z5PT0rmI8*)N2oWNXajZ5r4Tl{V>*P?UGdtGEp^|uSasvCUN3ti`r?YKebSt1FZE-v zku{(=PhevhW7sQn0OBjec-z5Q-zNl|ZqGZ*DwNKCEQvJlCQ8Ukof<_LZ{A}9v35jz zeKDSMjBf6T2Bv+WNaHON|EsV8+ax8B?*?EGPX(~JS_n}GCVx6+W_95ZI9v$>G7$nA z?2iH?TFTlwO zokId+^d`zO4GIo%E#0RvXggPJ!?(3-=x5{)O&Zvq9hK_9nVMfiRE*#vgt*&02p()%WOQMZ%NX(vN z?;>bMFsmV|do6^5gH<7lOdv>0Bj2Q{DZ?8Ud26f4$RK%NGn=WJEaT?k=9bPDjJh_I zJw|6qmCbj)%4SO4xMQ5ZJ5!U~4rp9%sqsd;zb3o3rJTtv!v@*pBai_ z;@rw2w#xge#&$sNA#K229GCLw!Q&oq{Ii!*$yIPH3r0SAq;MMNHp{_jpS^7FN*LtZ zXdI{HhN;ZZ1dGfIMqFc zz-5x}J<^WoC0z|RU{Vj4=%U)FszlbL__I%BxOh|9#iR4UL90cG!8Y)*w=9d$XTwLA zU->?NSzqt*BawMvlWM@jY|{-{f;A?BZM0qc zKqg7{NFLu8D>E$=1%*z!Gr|3J+NqQ&-8)n?#(UL^83LKpHYtfaE|c936QcACmY%Db z6-8Zh+sU9HU0IT53!yLv zJG7~(iQ274mu>;Rhzo0gal!>)(D!xXYo5Hi02Yzqw!Lz|Fed|su{Vd+877mIf>t*H zZww>@;^~3Fj4OR0mX0--fLXZ7Z@usxUG7`&Yq`Hi8QY>gb0R$9Hr-<4WJ5!(ndvIo zLw2B;vGa+6^O?_83SgGt&p3Bh)RC^uZX7cdfvOe#7)lA)S8h=uQGfF2iu##@IlNo0 z*8Rns^AdTjYl5Iv3cb&qoP4HQ9o1}K3pm`|sy`(&GLl9+Z{`n8C<>7-L`OK}9R38% z>TVv8u^F-(day2g9=vQy;j&%akk9+B2s2nb)h9-+xxwngC4R2F?!L7YC_K|?M>pYT z<})R4qa47HUY=V2-TdVh9R)@|k1tH`Tp@6O8Th13j3yt_GgWtQZL6GOmhl6%IYuy?hu-!Q7W32M1TVYM!c1!QC@34?ysNCuTjTQg3 z%h%i%l$-ozTq-PA%uT#cw2lnaC5X$$i^!Yj!LuQ%mI*IbDt=sX$Lhl9^J{A}y7<|n zW`lMqgM-CbSnc{!o6QkfQnqLo=KjoJ5gH#YxrhGjdu>Y&I<^#i1FS=>uWaEz)+{*i zp43a(-hbQ55sZgsqu4s=JYOG-j9o9R8C0Zn5u9oaRf2#ThD{HpJ|jHj1C;qE4W{*7I)lRkhn}IC`uW9}T;=yuH zlo$7?f}I@=SDLQzZ8Qbk{1Qfa>*si`keUVcV^dQ}6fZ9!t0nTZ+nRdXOM7or7qGuH zN~~;+nxv-w!n3(L7;YvR_g@iT#N9t1rHG%T{BY{C3GNH>>F*y9389wt5T*)yo83Mi zkhNGj2}zbdLbbg#D|8;HcWS#i(Pksc_hi3?`Nbn~mX(J>;ymUXp7n2pwu=H}AIm$N zXQ5up-2G-em+QDPuJkoG_p|7}+3GQe=Lt<%mafTkKqT`ft#b8aOayOX7-TyWkvK?a z-^q|02_qznl#|Oej)s!rW7OXBu<%X+ixS_KHM>VjbXqHdM+EJ+%rnUbiN(UBzV%sC ziOCmHT8-PRJ02n&U#kuvT$4x!MCpAIf;7~g`7Jx$=rPK0#q_Nj>vW4#5P}lVitZil zCAv%qV0sTjvJ@{A7f;425%C6)I>Dhbd-^#CfS%ho)~n||+`L?UfJMb8g*nXb-n z5sNZ6x#EG%zS!`R+f2rudnB6&eB#=~VjjTY*h$2{442#|ZJa5{gY@_3@Pe9PVduo`J%n_ys!WhK61LM((Fzz zm!Ty!P=3D^jkr9YSlbyh^t?#8e*jybE=f@I3Jj> z6pf!Y5I8MD2+Ciym3As0rnn8>C`&gVcQClIY3X|@@V2~^KVIN^VyIHYfRHRf4vkk> z6|Y3qokD#*r=G>-xzl=T?%jM8HNT(h-1`C%yF#{b^0`_uqj{}XG0SVaEp|GN^SYYU zY%Q*P)HbGW@9XWqt`|P%600}3>Q4-;DFR>BCO;unS=k#xssVmtEE@}A(W`4qx;(Z+ znUwj+Vk51Ds3vu^hIp>|(|ggO)v>~+g;|6$H(311n*1PWN2PTxM!y-0JWHO0iJY+I zt5EG+-aD_OmUJz^2<|5q7EpQzzgii!@SN9cJ+@5o1W6u7j90zS}j%6f`b$BD`i$wdOa{5efsjNnuh z{$kVJhz7@yT!jwDj9Tn~?V6aqSkmviCL*ekEHkPxDofSp2CKD(HG^V*)7>;l#>j?( zxnDt-p7i5j;rV9L^$dJJZx@`I5tOzR6P}HhJyjF6}$Fx+N4QV|*y2 z$ISGbiQ_@|JJ^71iD({8B(ciSimdNWDv1f81O)?gt-x{;uo96F4@Fw!1HOSoltx=7 zTtu%`hn`Iq2gJwd#2|T4lK95JsvltLK7n%>xgqIqPQ1~0> zA|`V*w5{Kkz_jVLO8iaYS|Qw~km%C#%7i#Nz(A(___MF0dcd|*qSjHJEmMvP0HA3M zetdF0CFpoz*1emHi#uB^tz)T{3nwF1%5S}reVrwUV5DB}WDg-Bl@d7}QldfYUBSdB zDlS9evW&yDU%m>(qZ9$%bW$P%RMNwE>qZu#<2Afuf{zaBS;t4$qE&zSzX{%+ zKX&8acd^vw{n?3J5X#r&=hI91MWL%y?_8i5&wdR1y1#wfxDtXy71%M1BW9{2Q?Jpv zx~nBG{E+mr?pde?46!|z`XwD{s(Q8bmfw(}FITjg>WVRq<>t+()GNbWG+A{k-~D!Z z;S(6Rs`5=Tqc(xmZl#4;rx<<#ikCuLEAv%6)~Vf#>vSBN6!(LCf09nnj1cUU{BTOd zkHc}&e|>Uu?j19ov)-$~5jE}zA_`Ob0{Sfu>yIQqFUV}}KCIIVlztU`V(~rIbvBNj z$8y|HTk~B;?T<4v#*>)n;ubl{bZ`!pDa#hl&67}T&Ez2o8d8Vm zO-qUkO(U*!Fn&_J%*EH_%GT(%rJ2(u**%&vO4Vo$Sm@M*Z;)#YAF7LrV0KGfONcJ( zV!%!3+icAQuc8|9Bbeh#0=cTM*5$TG;9qN=9y;ov0ha8r%-_^%+cYgzWb3JaB$E`z zg{?iMHP#;LfY6%+@C@aw1M7#sh|uhNr@pq~wS{3T%nI8=|x%wZE3r>(1lsWqxqT2z*|*wOT;|$*PI?nCks;luIviQxsaUA0>Y8qzvya&fCIz}PoZwlHIE zsZ8&{RAaaTb^X~|gmzGIqI@N7zB;DHsk1x3bE3p=Dn+0A%H9*7>0I)CYIRPDDlW6) zvb{RC6T)#((YNqJyF(DS@ZrJsdSy8ux7$?88vJy(WO4Tx;{oerwL5;`o(4i1Oj)Lg z1#eAb6o?9C@w+EYL(TcySTf05a-2JzLHN-gxm%nI-$X9^uH|;vc~_7lk&HpX8O_W* z+}wF&pQ47Jq^uqPw{M)ny+OTITWg~+rxO}6ac{1v z0jB(5J4}aCt9R5f8smx9X=+l^4@HQyn!$l@y*Zu%Hv)F9%Qpoku3j>R4(gCzRE)|= z(>c(YN&X^fcF9dCJ2s`edmN=!YO)D0@;1(0-BFS{dRMu7w)ab+GU!rNa1OYxjb5lG zL{!?_IczpSwFE?a-=Dyk#xD2=&tbS(?8n*9rF+NyJwDHTc2zjI*t@?qitV}cQ% zw;ZXGIH5fiW!sQBJsW>F3V(=SKdv9}Y~Ma*>K$`TCABKn5+U9U^7D2j+)<`;`LPL% zbk0@-qp&gGIgYi&Di&wOzPc?$0()5^VN8yZ4_`Mlh*3G$j;6RRE~hZO!2-)(Do|1o zl!Yu)!VvyjSm@=y`POmq${>NZjox@bYS%pPi`t<+IHs zAGN94sHD)zE0pP*UxhcEr#6|u8?76R0-J;&D0tZTkX`CNv=PzRm_Wsr6156>%U-LP z&Vl$_u%KwL;H^gN(nBjP%h;R+vM+WD%S#u9zV2T97+BL0(U%U+r~y+a6Gx%zo{1lyaD~)OIY|==Y5uys)iq&8*G0ri$0x1z~-5s8!;EWiG$;ge&kMT|% zJZqg~^o)JlsFC~^=HIBJO1(?VPgky}6@Xi8PxW0VjEF`}WQQx*5Am z|EI0*4risadgZqv)_gM8#I4A~Ay2-s7%XK`9Z0sJoRIv2J^7 zZ82N3C~EIrlorqF_xt-j*Yn5ozH(hBIVZ`Lb8^n-eBST(YdBo)QROH2b^k4V^4=`F zYE0MT$u`03WwyXdwKyBP(`SBtVO#;Gx~P67fIIxl0Gr63Rl&&;c>f<0jPnKBk1MFc zYL}LQQS{L@?~5k}WU$bNuQr!Hqn$a1GMO$n_04!GK#R zxO(Um+$Y2b$#_dE%G}K|i#)(MnMM-`D!r(rqMJc;nY-FmJ2Zan>EtDw3@iTX+;Wxk z>)D99N)V*G+lI3r|DSfZrHF-t+1h&0&P+jcsMReaURK?CqbaSO4Aiet%I3v>VYc@K zuT%Z}lcvN*dJh}pD|z}#6YouEZT(29H6tQ$0ZF#uNCj$NInO!*PnkTFvxfjxf(I@u z31Cj;<+~rHu6-CfsLL@((f;>(C*iDa>A~`-RwU?pTR%=s&nXIRJ0r!(l2d+b2pHU! zh3+Qi6^K|`AX?TYggkF*K>F18H(J)l(x8~E4=5M1r)ANi*Or%8knTBu*myBH$zb%B zh)%hzsmL8?1Lq{of+Ttm?PaDThAb3DbX1ciVTTjYdO~!FQ&L;o`1t`LL@rUi(@ZO| zELG=e96GSj4%2^r)TBxV_ujM+Fn0ZK;abcFEw95Ib4-b?)5N*hC@CpVOza947NJkqaY2P82m)M(;&ojy-vBTr)rsYWl zZub21(k6fjg4U-pM)sy>kfGyB?!88D(8j%>25$EIDS>MDTTVJlaEXe13pYoi!(7Xe z`O+EM`#)cpk(E1@zWs6yW)>(}Tov4eb@=QvS_==2MN?L}99C<+4BN3T{BUD0HB-8g zOJExJYorZ&OU8JSuHRyz5TG1xIIi`5c1)LDMPZ9}A5CnTu`kAS$yeP{lLs#utoG`H zn_jLStqz#dgFJihOm=#FPIXsx>_{Vq_VWb1|9+r+XxwD*eNguuF(z*tXMs(az+U`v zUeGov8Z1mDl||YSIHN9BvtRfTC%=GkJ~=S`jrcB<7>M=5W8E|LdZjuIwTkiR*y<^( z%Jp5p&9NhZ)hm&&f0-0p`#CdHWJaB+#w$S)UGeWz1cT__{)vOyQv^QNm0o=zNEhTq zH@3z&$k$s}Qp3O$v9hJtba%%>r@`CPzpQ+t%Lz!N9DDvkxOB>yYV(*(!>yq#&*J?} zlVkLZE=ZV#mNK!K30dS>Y4Vq7`AYhk4%o`Nt$tN3R$N4b0`n{i68m!v3S)GtMFR+=D&u2uPE`ov z%OM=k&@QmMq?;S!vfd~^W(aiBHg&YCt)oGy%d*m~ z-GvUl3hJUUg~0u8&;~?x*Ll~QMfE^FS_1 zjoiE_rj;`!p{yU#REQFP>e@lCuM9TOtqdvp>?p;jnjw!)(kfXr@Gt(Xc=Gc^=egbY zjLAT$lQ`JR;4=P}w-&GquC-uSNvWu~Z;z+txO4kmP;)*m#3nC|M?UhbFBeR4ALcMm zZMZJMca8LgI}`8H?p%$hb+O+vh+J=5@Z#CN;vOM?L2lHyX}WiV!05`#-+H$QPIeoQ z6i(-WkMOyVdlr9Ot;DQ#`W$U6t(3ooH>#hDbYY%wR$8icPtW5?thKx9n&+~y@~;{_ zN6XdWQR1eWs^;~>JJO^wrbIxR!*fS4pqBTFS%q;}*8)0NX$JN!BS!nX?rX2$vwLBy zUwYe4b(0m0@3sqq>=U2+rG`YbZkm2IFHQJJID6&GfVvT~uHMI&w*Cuc`|GbonEZe( z-ulq&kUDvbAeF_J__int{5jByv9+~v+?lt3k8jE>_~!PAo(LW9IXAN`{bZBUO4N*l zPu0PQ}dB7H16J%8oMBG6{eF)wNw(EAvPzkp+WRKRy35yv} z@qwQA(XdN~^BF|F14yXDX~!6lv=-sU3_e&)>C zj&sh@>OHnLbMx~R?wvtbS9I4D4@edc=&`oOa3{X_bCb@Ms!@s|(|6kW&5r;D2U>bI zkKCtuxF{EMGsxb$FXUokoe~w=f{4;+!as?69F%RhTSaX78T+HYNBMRJ|J%t=ebn28 zJs)M&PLI`Tck71YeIPr0rPQIBmBL~RfAc= zMHFW`(TYuSWr>)4d-s)_P|Xoq&~WyHj27e7|BQm3Mx;X0pU=+FO6?OKk%k-#TxEaf zHrcwaN^`TIZ)8cFWkZq87wHq;a!;dlo`nV5QPI8%X|3hPqR$Y`{BXK!Zj!|w%w$ua zGC>*eKnX7!ao4z1d#zNDY}e#^ue+vrMwbmewjc_c>)WU4Ubt`>)bOW77S>W8WnWE4 zafgvpT9X}O80PYnJdz!Yp27B!B7|amk6@O*E6<_H$-#P~JJ_9*fWL=;-7?h5f~T}O z^$IW5)WE|jJjMg|e6N>@4bDBf(5zK*Udl`^8WUqEjMS?oVaJ>wVbO9HKdM(M`Lg1p zA>a~%0j`sthevff6Bef|EftHMY`OCA#WV#6b6oM|$`?1?8#0?$`SLyQHfYV2vAKZl`fR;kX|~g}H-Moqm8O^6U&^i+wQPEd=3F0i zzwU8g>WiOa-dJ*=thcM40=kX>iI0q2cH%BUI6{&d4HG*ebjVO(qGl_Z{2Vjv;^^AP2gRtDBnu!F}w-Z>^b*=X~bgkkPj9SSf`IG?1wrWwG zQlS8um6f!KB+(>N7`tdmd+55Jr%AV21@4NenAX@%xvs;1crW_DVOv;6i?JY_xA2ME zkhMjgzPhQSLvck)1uD~&Rfz9K{9sT<*n!P=i@2L0b|Fo&rc_#{WCjl zFV=Qnq^EnvR{D{BTFTLU9xd^IrPiEY@dO&~dF!_RALFetHx*if%TC%T%Yl=pw1dbM z@Q;VLkM;Odc443Lp82R6^J>-p5zGELpUfMV`Ok`(BKK34^;QdvIIwFy2AOIZ zp=r;@$>X7^Km|TjLF*z@g{>wKwvWzU1V51eT~B`ian=B?K;Z{5a*}IM^6$pAlzc)> z7wt_bHnc;K+!4xk@p=bK!eg9Fjg}U)pOpBe>EbicZSMC10>XcX@Nl*!J(VMK(U3&> zR=1?2yJc(bB8Hwc59CdMH_T>eS@$s67^v+$~o{A87ADIo&A<)Gam z%V|4et8Vp+uE`#2?@f0m-N4#c>k`bI{ADTk`b6w58b$rFG{pU+x9vLPJMOkz7}Cp> zn4i9=_Yv~yOUW(4OXJ0DlU+&G3)?kw8V6Z#wfKkePz=AXQs~U=irO$>H%x|O7F9kZ=j-k~oTW_(CC)v(^;6phXE3TIB|r{| z$V#{>`EY0G@(hx0=+#j{yU=8>m*1t%crE0OeGB@fp6g(0`@X3DFmIljsCF;g6i$TN zatRxj|8zOIstAix3v&oW=HOY!+jQk&5g`N~yN3L91UXJPgL7^Le@}%h03_nJzlNXw zB()@PI3d7}3thO;XtJkxRizwC4(3uG@2C6Rn;v^}>w~(pe2HTO%)sgJT=HN^*GkcT z(B3G2)UvB$mKp$b<9-F)(mH&HwiUG!YoBW!h!XV+i@Nw>KImbpI+wf^vNkUfm11x-5q+mw~_Q={l!qEiaAH zQGDQeP_=q^^WeuE;ZF==#q;#h$|(e2xUuLfOH>~wn&|`{RQ#$a__mp_Dh3ym$S0}v zlkXMWdV(pO@jHPUU8#UteOr{zwEe*4yI3%~^@4`dJ>IBj;8OBU1^_Ol+4tHWSC zc|FoW|B30<&7!-fDH)*bg@#uchrIxkU&(T2{s3-CXzeQ$#?_@GMOo~gRjKvwKf?&>L!N^yni2lM>O3g z|6xyP`{VOEfQJ*{0scOdJ)xQ>MpjMZCNl{XUuZu48wSPISd02nDXYO88!lZmb2_EHeMVvoy3U+*=3D!G3<2K7Fz8MzG`0h(01Dp?Gtz!t`w% zoW}NRHxX@FAXdL>!9@`0mmOtPu@D0RZ~GO$0A(X}S?kgcdSyhT4GqTGo|!%TNPV24 z4uiJIj(d@s==0Bgo#=M4PNf-&_1Ub$0Q^D%d`BWBJ(;;pq6?~1Dm(6E9W!u?Il)>Y zUCh(Vv_S0c8=(ikrz2&BWhDfNkhWnNwgn@NfuEcc#fD{W6G9QOZ@21!v6m19K*~NgkZTVFD#7$ z#z14{tFu8+B&7sEiguM)4-S1x%}({0_kkAPzYHk7mUI_mTK<2*AjAJRR36P#A^#h? zS5A}(op88(lUvOHtRfTtd$ww88%Ar3mn`&m4&eYb#776^0(py_Pn0prT5G|PLo6k2 z4@==GV;nzrgr8O`7v3=*z%0n)3niv=6@6m_Dd_ z#&8v(^div*^f3j9x2&I(voT)(JIKNEuZ}%7zGh&|cf~(oO625&r*`*S)s}t?20JSK z`~4}Yz|YKr>W~PDEv?Zaz#bO^*Vz9P_>yu{v;4x9YLbuqO*Br%w!o~cK!@mzz#6K3 zfN3LFta?(c=G&aTSs#WG`Jpi8QV?i3X~tVk-TKC<)Q2VcL)3?VroQu4$AB;9lmmxM zve^4cjD6l*UETeaQCuISebuGfR2qA7{o$b=>zhh`!@6_W18K;HvgORC#MwBlT~Z^7 z-Z_NXA^6MtI_B@BC4YPL@1N)HYSd}G$i3-Rq6Rj;7}@c7UC19bKN49tMxS`kolZ$);xSW=G=W?1pyhn7^c?WaOZPnlKn|XbJ6EK;ArTJ+V~;O(V?gLW#eij2cr~Ogs{3pMZaXz^LTDoS;K+czf4YZ zbgQ66FO(brMZC5cQe>ui1GnI+fo5JgV&GPcmLC<6dz7n$_W zLnZ+}<_j0_b-cV{vd<|T(`l}*QP_@BwbIvu#RWtjr>%`OT8zijH}3MPp1c?D^axnb zK3Ba<(&>k@b2yb7*Q>uP>D7_p`Bc^1J^c7i<@I(J=v`2x0M;ez;aR?aB0~g(uQv0d z0B(h>F)!mQP|ik@`-Moa|M_Sh9XrFz{Ba4W3$0R)vquZQTh0q^KF78U;464)R|+M4 zmS^Ah=)_N=5kgR$&`SAmQu^0n8<~O;n1EgXyvl{%qhFIk@{b(U(zq{faZWyGdcu! zjoM@(onFyovrN6uIPmOqS?doR3ZSuS_%}xPi23F>w0R9A*^TyEedQZ8gZbrIO66r> zR2(!J)ai!qWB;HJ%fup$D5kk%WF2{gX(con;*|OiUHeFJ~I$q3<`%WDxd)stR zI`d20{x&FcsXu0r5tXWor#9pb-N$BBYt@pz(PKZn4(2E|YwVivSwU&N&CkS&WYxiP zH}{OtqxkoENV8ieFN9`(JgK|)HC9h~@JAMsj7zf09Nd0^GyEOCZ*OdCf$|7K)1fPk!3%xgEuo*AH793pfs_ zJ2))%%2Xux>X!d(xY=_Io@8^q0?9|KbFr+geht{_=srAC1!vLLdv!@yIfL`yQ1w^l zdT;3hV=fpqW-E2^(_;=bwFYxxn+pUN@h5qMKLx}ukqvlElK*^3q4Zrh&nDew{riGI z_xsxw2_ixm8xXfW5_B$gVtV9IwuA1QQ_Fo3888avIxfBal#S1I5VlL2MmAP^P{_~Mc&QUhpX7QAdYImQQ zV_r6JtW;Uwni10UhESFEx;x5|60R(cE^HMKqGGihFXW znhit`&Q=I-G6`VCw|6%!50y;H;+mxPK4`UCo8*g|>xauJTDA=CIda)ZStmAW9lJ$& zI^KDw$>5}NhKZZSztc{Z!5BJ^;lmUAiRcdg;0lH)Ju)Ebp|q~e$!Mkr6Izz(huHZ` z?_RNB?(694C&R=P$kKxZ&Umn9l59effXVx)(tbBbmiNzM8xx6|dupI@%cka|91;W;EfR4vip2JpjOr~_d_p?lf)L>hjs z#@sWS>)7PWoD?+KxAPoH*XZlCoErDtFM6{hfOzu{#O^x83rw5Se1ZIj71OBc1|el< z=>ag3&>aTf&u4Li*tqHSiK(`_t++mK(vM@m70Sxjlp%b&g2!?JY=_VrTMi$$gOnwoXuVytC@-r+|`Q zn4hio|b(-u>k+sY2=`H64Xv?Uq@Tg*SlT+GVXM;>j#G#+t0Kcb|NH1Na zSyP72zT2LFlQ`G~oRYm2ZAvHNkM?6UWm|}8?6w`gy*e)fc{Opv8d#^u>Ct#ed62-R z4L4snOf)XdH{#%hY=Z85U|VQn0e)!0Qvc1$h^_*ckc4-7sq&UlH?f3y78z zdX{e#4c$*tOqXxJI^ck>TNT`}SQq?d?qSE*y)IBm`naSJr{XS^vlygv(!U#nsjFV# z(oHu+=i-x<-q$pb^!h4LI;XNJ8p3wBj*6$OoF4JR?vgR8K!s2xNa5Vzf&n`0OO{+U zhdFZcaja~@rWdiF?sS^}{ZNsuo?-DRhRcj4aRs#S*#9ZU|*SMeT!P5Fz2BsVd^}iMnyRJ=RMr-r7>OT3V7bLG)-&A5f zksW87<|>G~;2yKXcA2&d)2KhvnVY@-wwbgmcEhfpcsT#6e~Z)BGd&qY3DdibZq16&5*z1YiRXYOW(e?T9pDU~t|g=wak zcOMG;_I(__S<7(7&bd#p?KY$h6nXoC6~De}aTS(;^976)`htr-_jLt$HL_EZ;$2B8 zj~Ng2a#}1Zt!3~e8f)k$3wYqzqep_1@!l!xKB{HvZ_KtIMn&?DfzFFm$VDQqU0+4W zglP?9G(9t~g`EV~uNI=#zk2GkTV?C?*W?W1;mXv|H?lGG=}Wm<(vu-VIzQ+)?K4e1 zZ@(2>my~iPu1~^-HWb8fce?f6+xU0v?q~H-Y`<ztxdjA> zp>LWwK?p(>C>u8DANy(PZZkXoBJ8g*6GNg&>d{5&$EZl}c=zhzck;+f^vnzBvd^u~ zCZw~^4Z_ivgd7qMdN2HWn~O#2@*mgTBcoxLDG#surcb!{D*hbb$@17xm=o@JuXH2k z>=4Px2CR}v_(Lb5$_@J(%#XB+9KM8P)nZ|xrq@{IbSJ%+6?9lq z>#y|KR@f$j1)GgpyAq!AJ(DmHf1Fv+}~tziN|98?}O-HyA&uyJp>W{Fh;?_Cj8X{^-NU z3w7B^CxLY*ej@bCWB zs1);+)N&aT6dTzrtn#X_(m(yeeYO61=DBzWLa_pj^tf3>=9ihdIQFY~UNVO~B{$Dt zm|Q75HwfpjLF&ttWF7bn>HaWLF?xR@BC-+iNWp&S{HK4|bjVT?9R0*s#2qCSCr*>gYKLVGSY~e{IB4al` znHq`Oz->f0qIx5E%#c9k29*p-tm#UDhCZu6eVGI5ngB!B%Tz9vOLn-o@atpdcYq3` zJMRRCg}ey+74s^uMU4lwB|P$<(x(&vJ+}KCCMDR|oj~v?kLJ?%sHmrax(|rMEci-( zS4MW!F*7{5Rqj{!@P`-Wn-IE}-?tS0a84dJ*1a+xON9xN@-`BzU;nwY=?ylon!1r9gM`M^a(%=>O;1S+jA z!J4-4ZUpM@YyUM(N=pR-6-L1Fod9a3q zab{1&xRho=;u$W;8?LOLKic~HyTruKl$BLH02;!-l?1f@0AQs;TBaeIAqe1gDGpdK zCMG7E3Ty_JVl4k~Bqb%iaR9`xALeSIUvfdH)C3}v18^ghE-MfN!AlYl2mvY6va&KR z^-+5Oc=&&r8#I~_4)`n(zljI8(J%i4Y|Y(Yb*iW9KJxIhJf89S`qm*ezfA{kH_<0L z8zGWTu`7+<$w*KxO{jQ)MEwr?5n($2Z5Z08dJ)uM_nGrXCI81tWiND#N94m`<>ESZvSN!_#c z2a&#!b^G7;)vF*>KwNkLvu|@Jw-lh?!j+iXL1MT>TGnR(noRF6%WA?}#80Pv|K__X#BUn9nF}xU^liZ=9pWdX}F2h zhSfPceyq<~I&Z9&rS9s?dYg@}2|<9FSOsUBG^;B~hYnlXCw_%t4|${qoPf%#B4I#i z$GL8?%~hL@vq%f0&WLKX=w0Yn2uIPtit4vzwFQaQf0fPfW@TGcA)i!M%{@y^5=F~p z2?`mSt9ixbH7f1^lAyfn?mkfT{m`5lVI|I}xAA(*Jm7vAUZ0pyNh$^0Bnjs1mS{t! zv`Mi@G+z#kXEbYb$g_06K|Wuq!F+`FrKh3 zCDCEMj4Ik}v;NEIr?E&1#mo=&O}}1ka$m*omp^^{*P(n=)uNsXvtL+LT+C0kJ3rZ= z@P8}v_#oeq$ZB_zHt~F`Na&X1q0s%7k(iW#pnLMh6b2Y~X76OeQDVEO+u39W`>Djf zV1-^gHD*<&=4(bUjmmWh2%Wj%XM8V#70?p2Um9r<(g?`m?GB8B#H;_|nVY^TH8*fr z&**<8PB;?vG{`G3$Q(bSoD4M4eJt4V9c7l4n~PH?nDlz~zN}#WUU+59_KSiG!phGu ztrSWjGeA2r8!jmu8)qkqB{3eGN}+Sw&?-as^~+nEe~UpTnx_ZtT;hL|kQ{Y&Y6SLq z+LCh|AKU#)g*rLEe1HC5=Maa^5N^BCY&f&RU}fpU>w+uL!r#<18~)P$TkSg-c`h8e z$M^^U8WgbwFmJ|DN3je7p-};JsVe$C#k75-f7 zb&m>1l9fP{=~V*9;G(tnnUOg;>%5t405?y?PX)BH#|liV`_n#jrBsg1<_eDdiv&mj z#{U8dcPt>{*hT~NY}0CM0KHPjr?t7@p9IAE!CM?mi%)T$64Z-OfD%X5e7CPX+6Ni% z)E#5Lj19m_jlSxe7U71Pa|XYZIP%IKJPVI`^W@^omWYd&oMP2Eb4psDtIm~1K=wR; ziIR=ocfOl1`^GBS6dR`kN&{Xnb*LFEwkrRXVsLQdMpg#6IVpE1WA2niIdW6cT>vGJ znRk0fhG%Gz{Q425ug)V5*r6F2ZjJs7Eg$}}tS!4s-r}&@QN%j$ReJbdt89ZwRKwd1 z04U#LuJDW_r|R>1W*3KYxzMfg(U0iX>VPKKa~F}zGTLUy zJQnlTYqMAmPMATuxw~*@`JWu>qIoTTIWs4_U$)4#qppvRQ;3t$P`4%>9YgkF=KCN$ zrB)m1RAhgDV$tN{WH4tGx-%hIGiBn0z_rM&l13dJu@BBycS9MF9?`{AX?$a=jTq)@ zd2$$MVb*{%&2ojpIgKurRvgM`fo1sf$v5~(@7_AeXp^k^Lc*A|zq zXAGhm2?yhRT+`xR%foI$HiS!%EyaZM-fQI49ZVb!)PtcqPW?|z{{agoM&ksFIfkCz zrEe1(yI(BE>UzSCniupB6q(nOsmzD{@>baj&axKvUz{j5GSuOPL44GRrdDXdXRcRp z`81tmX(w6TdIdQft)-SRIL#>=9;A-Ao@dqYs~mtro49Yjg{|Eqssx@!NuV}g&piIc z7c6_aS~^%^+-JHGrgt4#XUyKL#b5iHP8zrYb;M6jdX4fOIpYq$DU%ql=id z`ep4viK5f>WMcfz+nYl?yDRGPgR8e&h1B)ZpADrPPRTQ@6d4WOI>ekV(?pGh(nk4n zU;Ms>!W75T9Y0QY@4jxkEzq6(C^AB1;kKU3OaHY7`O!Q1(3IA^ecQ{LX1Z!%iN<*B zQ*Z>Yr<7FMZOfW;(^6w+SwPHR{WZ6=`s-VqpOgQx`Tg9!OF-Iw;(4WBCOa#zarlu- zl^6c+&AsE=%8!0mjyKu|q3sh57nhgj4xW#_8gX(}IlVE+pQ~%F(!F%=bY?>{`w|<= Jyr0YM{{x*P3-ka0 literal 0 HcmV?d00001 diff --git a/src/ppx/dune b/src/ppx/dune index 7c697e902..fa41af888 100644 --- a/src/ppx/dune +++ b/src/ppx/dune @@ -3,4 +3,4 @@ (public_name reactjs_jsx_ppx_v2) (package reason) (flags (:standard -w -9)) - (libraries reason ocaml-migrate-parsetree)) + (libraries reason reason.ocaml-migrate-parsetree)) diff --git a/src/ppx/reactjs_jsx_ppx_v2.ml b/src/ppx/reactjs_jsx_ppx_v2.ml index a36ef88ee..239ca823e 100644 --- a/src/ppx/reactjs_jsx_ppx_v2.ml +++ b/src/ppx/reactjs_jsx_ppx_v2.ml @@ -42,7 +42,7 @@ *) (* #if defined BS_NO_COMPILER_PATCH then *) -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 module To_current = Convert(OCaml_408)(OCaml_current) diff --git a/src/reason-parser-tests/testOprint.cppo.ml b/src/reason-parser-tests/testOprint.cppo.ml index 0340139c2..762300edc 100644 --- a/src/reason-parser-tests/testOprint.cppo.ml +++ b/src/reason-parser-tests/testOprint.cppo.ml @@ -19,10 +19,10 @@ * not a super easy path to "test it out", but this setup is hopefully not too complicated. *) -open Migrate_parsetree +open Reason_migrate_parsetree -module Convert = Migrate_parsetree.Convert (Migrate_parsetree.OCaml_408) (Migrate_parsetree.OCaml_current) -module ConvertBack = Migrate_parsetree.Convert (Migrate_parsetree.OCaml_current) (Migrate_parsetree.OCaml_408) +module Convert = Reason_migrate_parsetree.Convert (Reason_migrate_parsetree.OCaml_408) (Reason_migrate_parsetree.OCaml_current) +module ConvertBack = Reason_migrate_parsetree.Convert (Reason_migrate_parsetree.OCaml_current) (Reason_migrate_parsetree.OCaml_408) let main () = let filename = "./TestTest.ml" in diff --git a/src/reason-parser/dune b/src/reason-parser/dune index fb09e4697..0d9bbb27d 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -97,4 +97,4 @@ reason_recover_parser reason_declarative_lexer reason_lexer reason_oprint reason_parser_explain_raw reason_parser_explain reason_parser_recover reason_string) - (libraries ocaml-migrate-parsetree menhirLib reason.easy_format)) + (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format)) diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index 3d47bd6b1..99dba7589 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 open Location open Parsetree diff --git a/src/reason-parser/reason_errors.ml b/src/reason-parser/reason_errors.ml index 7df0a1b9f..b166d5ba8 100644 --- a/src/reason-parser/reason_errors.ml +++ b/src/reason-parser/reason_errors.ml @@ -127,7 +127,7 @@ let () = | _ -> None ) -open Migrate_parsetree.Ast_408 +open Reason_migrate_parsetree.Ast_408 let str_eval_message text = { Parsetree. diff --git a/src/reason-parser/reason_errors.mli b/src/reason-parser/reason_errors.mli index fc265e8a4..c33a6fff8 100644 --- a/src/reason-parser/reason_errors.mli +++ b/src/reason-parser/reason_errors.mli @@ -8,7 +8,7 @@ was too fine to be captured by the grammar rules *) -open Migrate_parsetree.Ast_408 +open Reason_migrate_parsetree.Ast_408 type lexing_error = | Illegal_character of char diff --git a/src/reason-parser/reason_heuristics.ml b/src/reason-parser/reason_heuristics.ml index 86160980b..ac213064c 100644 --- a/src/reason-parser/reason_heuristics.ml +++ b/src/reason-parser/reason_heuristics.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree let is_punned_labelled_expression e lbl = let open Ast_408.Parsetree in diff --git a/src/reason-parser/reason_oprint.cppo.ml b/src/reason-parser/reason_oprint.cppo.ml index 9714b2b34..8e8fa2a31 100644 --- a/src/reason-parser/reason_oprint.cppo.ml +++ b/src/reason-parser/reason_oprint.cppo.ml @@ -85,7 +85,7 @@ *) #ifdef BS_NO_COMPILER_PATCH -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 #endif diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 842bf8e08..be040f13d 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -48,7 +48,7 @@ (* The parser definition *) %{ -open Migrate_parsetree +open Reason_migrate_parsetree open OCaml_408.Ast open Reason_syntax_util open Location @@ -1074,7 +1074,7 @@ let add_brace_attr expr = %[@recover.prelude - open Migrate_parsetree.OCaml_408.Ast + open Reason_migrate_parsetree.OCaml_408.Ast open Parsetree open Ast_helper @@ -1371,19 +1371,19 @@ conflicts. (* Entry points *) %start implementation (* for implementation files *) -%type implementation +%type implementation %start interface (* for interface files *) -%type interface +%type interface %start toplevel_phrase (* for interactive use *) -%type toplevel_phrase +%type toplevel_phrase %start use_file (* for the #use directive *) -%type use_file +%type use_file %start parse_core_type -%type parse_core_type +%type parse_core_type %start parse_expression -%type parse_expression +%type parse_expression %start parse_pattern -%type parse_pattern +%type parse_pattern (* Instead of reporting an error directly, productions specified * below will be reduced first and popped up in the stack to a higher diff --git a/src/reason-parser/reason_parser_def.ml b/src/reason-parser/reason_parser_def.ml index ad6d4dfed..c9780de51 100644 --- a/src/reason-parser/reason_parser_def.ml +++ b/src/reason-parser/reason_parser_def.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree.OCaml_408.Ast +open Reason_migrate_parsetree.OCaml_408.Ast type labelled_parameter = | Term of Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 5b2cf4ed4..802e5d2e6 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -48,7 +48,7 @@ module Easy_format = Vendored_easy_format -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 open Asttypes open Location diff --git a/src/reason-parser/reason_pprint_ast.mli b/src/reason-parser/reason_pprint_ast.mli index e40511966..d76cbb814 100644 --- a/src/reason-parser/reason_pprint_ast.mli +++ b/src/reason-parser/reason_pprint_ast.mli @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408.Parsetree val configure : diff --git a/src/reason-parser/reason_syntax_util.cppo.ml b/src/reason-parser/reason_syntax_util.cppo.ml index 5beb81fe6..0e658279b 100644 --- a/src/reason-parser/reason_syntax_util.cppo.ml +++ b/src/reason-parser/reason_syntax_util.cppo.ml @@ -15,7 +15,7 @@ *) #ifdef BS_NO_COMPILER_PATCH -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 #endif diff --git a/src/reason-parser/reason_syntax_util.cppo.mli b/src/reason-parser/reason_syntax_util.cppo.mli index 9f34f6a64..f90549927 100644 --- a/src/reason-parser/reason_syntax_util.cppo.mli +++ b/src/reason-parser/reason_syntax_util.cppo.mli @@ -13,7 +13,7 @@ BuckleScript; ping @chenglou and a few others and we'll keep them synced up by patching the right parts, through the power of types(tm) *) -open Migrate_parsetree.Ast_408 +open Reason_migrate_parsetree.Ast_408 val ml_to_reason_swap : string -> string diff --git a/src/reason-parser/reason_toolchain.ml b/src/reason-parser/reason_toolchain.ml index 176254002..da1599fa7 100644 --- a/src/reason-parser/reason_toolchain.ml +++ b/src/reason-parser/reason_toolchain.ml @@ -79,7 +79,7 @@ *) open Reason_toolchain_conf -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 open Location diff --git a/src/reason-parser/reason_toolchain_conf.ml b/src/reason-parser/reason_toolchain_conf.ml index 99d5dbd04..d2b924d41 100644 --- a/src/reason-parser/reason_toolchain_conf.ml +++ b/src/reason-parser/reason_toolchain_conf.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree include Ast_408 module From_current = Convert(OCaml_current)(OCaml_408) diff --git a/src/refmt/printer_maker.ml b/src/refmt/printer_maker.ml index d3e879501..5dcd19e0f 100644 --- a/src/refmt/printer_maker.ml +++ b/src/refmt/printer_maker.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree type parse_itype = [ `ML | `Reason | `Binary | `BinaryReason | `Auto ] type print_itype = [ `ML | `Reason | `Binary | `BinaryReason | `AST | `None ] diff --git a/src/refmt/reason_implementation_printer.ml b/src/refmt/reason_implementation_printer.ml index 1f1f7d88b..6558dd153 100644 --- a/src/refmt/reason_implementation_printer.ml +++ b/src/refmt/reason_implementation_printer.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 type t = Parsetree.structure diff --git a/src/refmt/reason_interface_printer.ml b/src/refmt/reason_interface_printer.ml index 581860cc3..b0a1875ff 100644 --- a/src/refmt/reason_interface_printer.ml +++ b/src/refmt/reason_interface_printer.ml @@ -1,4 +1,4 @@ -open Migrate_parsetree +open Reason_migrate_parsetree open Ast_408 type t = Parsetree.signature diff --git a/src/rtop/dune b/src/rtop/dune index c887da818..729cc19da 100644 --- a/src/rtop/dune +++ b/src/rtop/dune @@ -4,7 +4,7 @@ (modules reason_util reason_utop reason_toploop) (wrapped false) (modes byte) - (libraries compiler-libs.common menhirLib reason.easy_format reason utop ocaml-migrate-parsetree)) + (libraries compiler-libs.common menhirLib reason.easy_format reason utop reason.ocaml-migrate-parsetree)) (executable (name rtop) diff --git a/src/rtop/rtop.ml b/src/rtop/rtop.ml index 45b79f3a7..e98c292db 100644 --- a/src/rtop/rtop.ml +++ b/src/rtop/rtop.ml @@ -1,4 +1,4 @@ -let () = UTop.require ["ocaml-migrate-parsetree"; "menhirLib";] +let () = UTop.require ["reason.ocaml-migrate-parsetree"; "menhirLib";] let () = try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH") with | Not_found -> ();; diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/CHANGES.md b/src/vendored-ocaml-migrate-parsetree-v1.7.3/CHANGES.md new file mode 100644 index 000000000..a16c2063f --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/CHANGES.md @@ -0,0 +1,198 @@ +v1.7.3 2020-05-07 Canterbury +---------------------------- + +- Fix magic numbers for the 4.11 ast (#96, @hhugo) + +v1.7.2 2020-04-20 Canterbury +---------------------------- + +- Remove toplevel `Option` module accidentally added in 1.7.0 + +v1.7.1 2020-04-15 Canterbury +---------------------------- + +- Fix build with OCaml < 4.08 + +v1.7.0 2020-04-09 Canterbury +---------------------------- + +- Add support for 4.11 (#92, @diml) + +v1.6.0 2020-02-10 Moscow +------------------------ + +- Preserve compiler version of binary ASTs across transformation (#79, + @aantron) + +- Allow not exiting on error (#83, @aantron) + +v1.5.0 2019-11-18 +----------------- + +- Add support for 4.10 (#86, @diml) + +- Infer file kind (interface or implementation) for binary ASTs that + have no extension (#80, @aantron) + +- Add ?argv argument to Driver.run_main (#82, @aantron) + +v1.4.0 2019-07-04 London +------------------------ + +- Initial support for 4.09, tested with 4.09+beta1 (#76, @hhugo) + +- When encoding errors into the AST, duplicate the error message for + "ocaml.error" nodes for OCaml versions < 4.08 (#75, @xclerc) + +v1.3.1 2019-05-20 London +------------------------ + +- Make sure opening `Ast_408` doesn't shadow `Int` or `Misc` (#71, + @hhugo) + +- Fix a couple of issues related to upgrading the AST from 4.07 to + 4.08 (#71, @hhugo) + +v1.3.0 2019-05-08 London +------------------------ + +- Get rid of the ocamlbuild plugin. Nobody is using it in opam and it + is more work to maintain (#63, @diml) + +- Set `Location.input_name` to the original filename when reading a + binary AST (#66, @diml) + +- Add support 4.08 (#70, @xclerc) + +v1.2.0 2018-12-19 London +------------------------ + +- Remove unused ocamlfind dependency in the opam file (#53, @diml) + +- Add `--print-transformations` to list registered transformations + (#55, @rgrinberg) + +- Fix Windows compatibility by setting the output to binary mode when + writing a binary ast (#57, #59, @bryphe and @dra27) + +- Switch to dune and opam 2.0 (#58, #60, @diml) + +v1.1.0 2018-09-05 London +------------------------ + +- Allow ppx rewriters to specify when they should be applied + +v1.0.11 2018-06-06 London +------------------------- + +- Fix handling of `--impl/--intf`. Before the driver would crash if + the file extension was neither `.ml` nor `.mli` + +v1.0.10 2018-04-19 London +------------------------- + +- Add support for OCaml 4.07 + +v1.0.9 2018-03-20 New York +-------------------------- + +- Fix an issue where cookies set from the command line sometimes + disappeared + +v1.0.8 2018-03-15 London +------------------------ + +- Add a `--null` argument to suppress the output. This is used to + write linters +- Use the new generic ppx driver support of jbuilder + +v1.0.7 2017-10-31 Paris +----------------------- + +Contributed by @hhugo: +- update Magic Number for 4.06 +- fix some compilation warnings + +v1.0.6 2017-10-11 Paris +----------------------- + +Fix generation of `Migrate_parsetree` module. + +v1.0.5 2017-10-02 Paris +----------------------- + +Resynchronize with trunk. +Add a migrating version of Parse module. + +v1.0.4 2017-08-22 Paris +----------------------- + +Resynchronize with trunk. Contributed by Xavier Clerc, @xclerc. + +v1.0.3 2017-08-11 Paris +----------------------- + +Add a shallow identity mapper (suggested by Anton Bachin, @aantron). + +v1.0.2 2017-07-28 Paris +----------------------- + +Synchronize with 4.06 AST with trunk. +Accept --cookie arguments also when run in --as-ppx mode. + +v1.0.1 2017-06-06 Paris +----------------------- + +Add support for trunk version (as of today...). + +v1.0 2017-04-17 Paris +--------------------- + +Driver: add --as-pp and --embed-errors flags. + + --embed-errors causes the driver to embed exceptions raised by + rewriters as extension points in the Ast + + --as-pp is a shorthand for: --dump-ast --embed-errors + +Expose more primitives for embedding the driver. + +Fix bug where `reset_args` functions where not being called. +Fix "OCaml OCaml" in error messages (contributed by Adrien Guatto). + +v0.7 2017-03-21 Mâcon +--------------------- + +Fix findlib predicates: +- replace `omp_driver` by `ppx_driver` +- replace `-custom_ppx` by `-custom_ppx,-ppx_driver` + +v0.6 2017-03-21 Mâcon +--------------------- + +Add documentation, examples, etc. + +v0.5 2017-03-11 Mâcon +--------------------- + +Specify ocamlfind dependency in opam file (@yunxing). + +v0.4 2017-03-10 Mâcon +--------------------- + +API cleanup and extension. Added driver. Switch to jbuilder. + +v0.3 2017-02-16 Paris +---------------------- + +Use `-no-alias-deps` to prevent linking failure of `Compiler_libs` (referencing `Parsetree` and `Asttypes` which have no implementation). + +v0.2 2017-02-07 London +---------------------- + +Install CMXS too (contributed @vbmithr). + +v0.1 2017-02-02 London +---------------------- + +First release. diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/LICENSE.md b/src/vendored-ocaml-migrate-parsetree-v1.7.3/LICENSE.md new file mode 100644 index 000000000..344caa9d2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/LICENSE.md @@ -0,0 +1,203 @@ +In the following, "this library" refers to all files marked +"Copyright INRIA" in this distribution. + +The OCaml Core System is distributed under the terms of the +GNU Lesser General Public License (LGPL) version 2.1 (included below). + +As a special exception to the GNU Lesser General Public License, you +may link, statically or dynamically, a "work that uses the OCaml Core +System" with a publicly distributed version of this library +to produce an executable file containing portions of the OCaml Core +System, and distribute that executable file under terms of your +choice, without any of the additional requirements listed in clause 6 +of the GNU Lesser General Public License. By "a publicly distributed +version of this library", we mean either the unmodified OCaml +Core System as distributed by INRIA, or a modified version of the +OCaml Core System that is distributed under the conditions defined in +clause 2 of the GNU Lesser General Public License. This exception +does not however invalidate any other reasons why the executable file +might be covered by the GNU Lesser General Public License. + +---------------------------------------------------------------------- + +GNU LESSER GENERAL PUBLIC LICENSE + +Version 2.1, February 1999 + +Copyright (C) 1991, 1999 Free Software Foundation, Inc. +51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +Everyone is permitted to copy and distribute verbatim copies +of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + +Preamble + +The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. + +This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. + +When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. + +To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. + +For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. + +We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. + +To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. + +Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. + +Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. + +When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. + +We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. + +For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. + +In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. + +Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. + +The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. + +TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + +0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". + +A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. + +The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) + +"Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. + +Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. + +1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. + +You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. + +2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. + c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. + d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. + + (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. + +3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. + +Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. + +This option is useful when you wish to copy part of the code of the Library into a program that is not a library. + +4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. + +If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. + +5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. + +However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. + +When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. + +If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) + +Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. + +6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. + +You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: + + a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) + b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. + c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. + d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. + e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. + +For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. + +It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. + +7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. + b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. + +8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. + +9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. + +10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. + +11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. + +This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. + +12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. + +13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. + +14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. + +NO WARRANTY + +15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. +END OF TERMS AND CONDITIONS + +How to Apply These Terms to Your New Libraries + +If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). + +To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. + +one line to give the library's name and an idea of what it does. +Copyright (C) year name of author + +This library is free software; you can redistribute it and/or +modify it under the terms of the GNU Lesser General Public +License as published by the Free Software Foundation; either +version 2.1 of the License, or (at your option) any later version. + +This library is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public +License along with this library; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: + +Yoyodyne, Inc., hereby disclaims all copyright interest in +the library `Frob' (a library for tweaking knobs) written +by James Random Hacker. + +signature of Ty Coon, 1 April 1990 +Ty Coon, President of Vice + +That's all there is to it! + +-------------------------------------------------- diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/MANUAL.md b/src/vendored-ocaml-migrate-parsetree-v1.7.3/MANUAL.md new file mode 100644 index 000000000..95f909dfe --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/MANUAL.md @@ -0,0 +1,339 @@ +Title: Guide to OCaml Migrate Parsetree +Author: Frédéric Bour, @let-def +Date: March 9, 2017 + + +**Table of Contents** + +- [Manipulating parsetree](#manipulating-parsetree) + - [Talking about different versions of the compiler](#talking-about-different-versions-of-the-compiler) + - [Migrating between compiler versions](#migrating-between-compiler-versions) + - [(Un)marshalling AST](#unmarshalling-ast) +- [Drivers](#drivers) + - [The legacy way](#the-legacy-way) + - [New registration interface](#new-registration-interface) + - [A minimal driver](#a-minimal-driver) + - [Custom and standalone drivers](#custom-and-standalone-drivers) +- [ppx_tools_versioned](#ppx_tools_versioned) + - [ppx_metaquots](#ppx_metaquots) +- [Findlib specification](#findlib-specification) + - [Standalone *"--as-ppx"* rewriters in META](#standalone---as-ppx-rewriters-in-meta) + - [Using arguments in META ppxopt](#using-arguments-in-meta-ppxopt) + - [Conventions for distributing a linkable ppx rewriter](#conventions-for-distributing-a-linkable-ppx-rewriter) +- [Troubleshooting](#troubleshooting) + - [Accessing shadowed compiler libs module](#accessing-shadowed-compiler-libs-module) + - [Using functions from compiler-libs results in (unfriendly) type errors](#using-functions-from-compiler-libs-results-in-unfriendly-type-errors) + - [Features not supported in targeted version](#features-not-supported-in-targeted-version) + - [What kind of guarantees to expect in practice?](#what-kind-of-guarantees-to-expect-in-practice) + +This library is designed to make PPX rewriters portable across compiler versions. + +It works by versioning the definitions of OCaml AST. This includes `Parsetree`, `Asttypes`, `Outcometree`, `Ast_helper` and most of `Docstrings` and `Ast_mapper`. + +*Note:* `Docstrings` and `Ast_mapper` contain some global state which was removed during versioning. This affect registration of rewriters when using `Ast_mapper` as a driver. See the [driver section](#drivers) for reliable solutions. + +# Manipulating parsetree + +Most of the work happens by shadowing. If your PPX rewriter was written against OCaml 4.04 AST, just `open Ast_404` (alternatively, you can pass `-open Ast_404` when building the file). + +This will introduce the versioned modules in scope. When compiled with other supported versions of OCaml, the definitions are still compatible with 4.04. + +While this is enough to manipulate the AST from within your code, you can no longer have expectations on the version of `compiler-libs`. The rest of the `Migrate_parsetree` module provides tools to deal with that. + +## Talking about different versions of the compiler + +The module `Migrate_parsetree.Versions` provides a way of abstracting compiler versions and getting functions to migrate from one version to another. + +The interface of the module is quite technical, but one doesn't need to understand all details to work with the module. + +The main problem that it solves is being able to talk about a "signature" or "structure" without being tied to a specific compiler version (that is, while being polymorphic over concrete versions of the compiler). + +The module type `Ast` lists all the types that are abstracted for each version. The type `ocaml_version` and the module type `OCaml_version` represent ocaml versions in the term and module languages. + +Instances are given by the values `ocaml_402`, `ocaml_403`, ... and the modules `OCaml_402`, `OCaml_403`... + +The `ocaml_current` and `OCaml_current` definitions are special in that they refer to versions compatible with compiler-libs (the current compiler). + +Functions and functors that operate across compiler versions will take these as arguments. + +## Migrating between compiler versions + +When migrating between two known compiler versions, the modules `Migrate_parsetree.Migrate_40x_40y` contain functions to transform values between two consecutive versions. + +For instance `Migrate_402_403.copy_signature` turns a signature of OCaml 4.02 into a signature for OCaml 4.03. `Migrate_404_403.copy_mapper` transforms an `Ast_mapper.mapper` for OCaml 4.04 into a mapper for OCaml 4.03. + +When working with an arbitrary version, it becomes useful to quantify over versions and migrations. The `Migrate_parsetree.Versions` module comes again to the rescue. + +The `migrate_functions` record is a list of functions for converting each type. + +The function `Versions.migrate` takes two OCaml version and returns a migration record between the two. The functor `Convert` does the same at the module level. + +## (Un)marshalling AST + +The `Ast_io` module implements AST marshalling and unmarshalling abstracted over OCaml versions. + +It can read and write binary implementation and interface files from different compiler versions and pack them with the corresponding `Versions.OCaml_version` module. + +(FIXME: marshalling format is not guaranteed to be stable accross versions) + +## Parsing source file + +The `Parse` module implements an interface similar to the one from compiler-libs, but parsing functions take an OCaml version as first argument. + +It uses the distributed OCaml parser (current version) then migrate the resulting AST to the requested version. Beware, these parsing functions can alse raise `Migration_error` exceptions. + +# Driver + +So far, all tools presented were for working with parsetrees. This is helpful to implement a mapper object, but it is not enough to get to a PPX binary. + +Drivers fulfill this last step: going from one or more AST mappers to a concrete binary that will do the rewriting. + +## The legacy way + +Traditionally, mappers had to be registered in `Ast_mapper`; either with `Ast_mapper.register` or `Ast_mapper.run_main`. + +The registration interface was removed from versioned modules. If you try to register with `Ast_mapper` from compiler-libs, remember to migrate the version. + +In a few lines of code: + +```ocaml +(* Assuming rewriter is written against OCaml 4.04 parsetree *) +let migration = + Versions.migrate Versions.ocaml_404 Versions.ocaml_current + +let () = + (* Refer to unshadowed mapper *) + Compiler_libs.Ast_mapper.register + (fun args -> migration.copy_mapper (my_mapper args)) +``` + +This method might be convenient for quickly migrating existing rewriters, but we are trying to get away from `Ast_mapper` global state. + +*ocaml-migrate-parsetree* offers a new, forward looking, interface. + +## New registration interface + +In the new interface, the state that can be accessed by a PPX rewriter is made more explicit. +- *Compiler configuration* via `Driver.config`; it snapshots the few compiler settings that are guaranteed to be set by the compiler API. +- *Cookies* via `Driver.cookies`, `get_cookies` and `set_cookies`, which work across different versions. +- *Command-line arguments*; when registering a mapper, one can provide argument specifications, as defined by the [`Arg`](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Arg.html) module. + +Rewriters no longer receive an arbitrary list of arguments. Everything happens through the specifications. Collision in rewriter names and argument keys is *an error*: a rewriter should be registered only once, each key should be used only once. + +```ocaml +open Ast_404 (* Target 4.04 parsetree *) + +(* Rewriter settings *) +let foo_config : string option ref = ref None + +let set_foo bar = foo_config := Some bar +let reset_args () = foo_config := None + +let args = [ + ("-foo", Arg.String set_foo, " Foo value to use in the rewriter") +] + +(* Rewriter implementation *) + +let my_rewriter config cookies = + let foo = match !foo_config with + | None -> raise (Arg.Bad "-foo is mandatory") + | Some foo -> foo + in + {Ast_mapper.default_mapper with ...} + +(* Registration *) + +let () = + Driver.register ~name:"hello_world" ~reset_args ~args + Versions.ocaml_404 my_rewriter +``` + +## A minimal driver + +The code above gets the rewriter registered, but this won't produce a runnable binary. One or more rewriters can be registered, the final step will be to run them. + +`Driver.run_as_ast_mapper` is suitable as an argument to `Ast_mapper.run_main` (or even `Ast_mapper.register`). It acts as a "meta-mapper" that will apply all the registered mappers. + +`Driver.run_as_ppx_rewriter` does that, calling `Ast_mapper.run_main Driver.run_as_ast_mapper`. + +The order is chosen to minimize the number of rewriting that happens: +- rewriters are sorted by versions, lower versions first +- rewriters targeting the same version are applied in the registration order + +## Custom and standalone drivers + +Using `Driver.run_main` as an entry point offers a way to make custom and standalone rewriters. + +A standalone rewriter can be used independently of the OCaml compiler. +It can rewrite source files or save processed ASTs. Try `./myrewriter --help` for more information. + +When the first argument is "--as-ppx", it behaves like a normal PPX and is suitable for use with "-ppx" (`ocamlc -ppx "./myrewriter --as-ppx"`). + +Linking the `ocaml-migrate-parsetree.driver-main` package has the effect of just calling `Driver.run_main`. It should be linked last. + +The purpose is to let you make a custom rewriter that link all the PPX in use in your project to reduce the overhead of rewriting: + +```shell +ocamlfind ocamlopt -linkpkg -package rewriter1,rewriter2,... \ + -package ocaml-migrate-parsetree.driver-main -o myrewriter +``` + +# ppx_tools_versioned + +Some rewriters make use of the *ppx_tools* package that offers conveniences for manipulating parsetrees. As *ppx_tools* itself uses compiler-libs, using it directly defeats the purpose of *ocaml-migrate-parsetree*. + +We provide the [ppx_tools_versioned](https://github.com/let-def/ppx_tools_versioned) package to overcome this. It offers migrate friendly versions of `Ast_convenience`, `Ast_lifter`, `Ast_mapper_class` and `Ppx_metaquot`. + +To use these versions, just append `_40x` to the module names or `open Ppx_tool_40x` module. + +```ocaml +(* Original code *) +open Ast_mapper_class + +class my_mapper = + object + inherit mapper + ... +end + +(* Targeting 4.04 *) +open Ast_404 +open Ppx_tools_404 + +open Ast_mapper_class + +class my_mapper = + object + inherit mapper + ... +end + +(* Alternatively, if you use a single module from Ppx_tools *) +open Ast_mapper_class_404 + +class my_mapper = + object + inherit mapper + ... +end +``` + +### ppx_metaquots + +The *metaquot* rewriter allows quoting of the OCaml AST. The version provided by *ppx_tools* will quote the Parsetree from *compiler-libs*. + +The versioned ones are accessed by using *ppx_tools_versioned.metaquot_40x* packages. + +For instance, *ppx_tools_versioned.metaquot_404* will quote `Ast_404.Parsetree`. + +# Findlib specification + +Some precautions have to be taken when writing *META* files for *ocaml-migrate-parsetree* driven PPXs. The ppx and ppxopt directives are affected. + +## Standalone *"--as-ppx"* rewriters in META + +If your rewriter is produced as standalone rewriter, then you have to pass the "--as-ppx" argument first: +```diff +-ppx = "./my_ppx" ++ppx = "./my_ppx --as-ppx" +``` + +As long as the PPX command line begins with `./`, findlib will expand the path to an absolute directory and you will get the correct invocation: + +``` +/home/me/.opam/.../my_lib/./my_ppx --as-ppx +``` + +## Using arguments in META ppxopt + +Since rewriters use the `Arg` module to specify command-line arguments, anonymous arguments are no longer allowed. + +If you used to pass anonymous arguments with ppxopt, you should pick an argument name and prefix them. For instance: + +``` +-ppxopt = "my_ppx,./bar" ++ppxopt = "my_ppx,-foo,./bar" +``` + +As you can see, arguments are separated by commas. Commas ensure that filename expansion still happens, such that invocation looks like: + +``` +/home/me/.opam/.../my_lib/./my_ppx ... -foo /home/me/.opam/.../my_lib/./bar +``` + +## Conventions for distributing a linkable ppx rewriter + +The common case is to run ppx binaries on-demand: a findlib package describing a ppx rewriter will essentially add a new `-ppx my_binary` argument to the compiler invocation. + +It is also possible to link and run a dedicated binary that will apply many rewriters consecutively. A package following that convention will use *ocaml-migrate-parsetree* to register a rewriter using `Driver.register`, but not do any actual rewriting (no `-ppx ...`). + +The build system of a project making use of this feature will first build a custom rewriter that links all the necessary packages to produce a first binary. This binary is then used as the only ppx rewriter for the main source files of this project. + +The convention to distinguish when a ppx package is used as a rewriter and when it is used a library is to use two findlib predicates (see [META](http://projects.camlcity.org/projects/dl/findlib-1.7.1/doc/ref-html/r759.html) documentation and also `ocamlfind(1)` man page): + +- `custom_ppx`: we are building a custom ppx driver, no rewriting should be done now (in other words, don't pass `-ppx ...` argument) +- `ppx_driver`: we are making our own driver, registration should be done using `Driver.register` + +### Linking example + +```shell +$ ocamlfind opt -o my_driver -linkpkg -predicates custom_ppx,ppx_driver -package ppx_tools_versioned.metaquot_402 -package ocaml-migrate-parsetree.driver-main +``` + +The predicates change the behavior of `ppx_tools_versioned.metaquot_402` package. Linking `ocaml-migrate-parsetree.driver-main` lasts executes all the rewriters that were registered. + +### Package example + +META +``` +version = "1.0" +description = "dummy ppx" +requires = "ocaml-migrate-parsetree" +ppx(-custom_ppx,-ppx_driver) = "./ppx_dummy --as-ppx" +archive(byte,ppx_driver) = "ppx_dummy.cma" +archive(native,ppx_driver) = "ppx_dummy.cmxa" +``` + +Rewrite only when `custom_ppx` is not defined. +Link *ppx_dummy* objects when `ppx_driver` is defined. + +# Troubleshooting + +## Accessing shadowed compiler libs module + +`Migrate_parsetree` defines a `Compiler_libs` module that reexports all modules that could have been shadowed by `Ast_40x` modules. + +## Using functions from compiler-libs results in (unfriendly) type errors + +Remember that because of abstraction, most values manipulated from within the rewriter have types that are unrelated to compiler-libs definitions. + +For instance, you cannot directly use `Pprintast.core_type` to print a type. You should first make a migration record for the version you are targeting and then lift the `core_type` instance: + +```ocaml +(* Assuming rewriter is written against OCaml 4.04 parsetree *) +let migration = + Versions.migrate Versions.ocaml_404 Versions.ocaml_current + +let print_core_type fmt typ = + Pprintast.core_type fmt (migration.copy_core_type typ) +``` + +As for the error message, it contains all information needed to be polymorphic over a whole version of compiler parsetree. Pick what is relevant to your use case :-). + +## Features not supported in targeted version + +When converting to an earlier version, some features might not be supported. In this case, the migration library will raise an exception. You can find the definition of these cases in `Migrate_parsetree.Def`. + +A reasonable error message is provided by default, otherwise you should catch `Migration_error` exceptions after any call to a migration function (either a call to a function from `Migrate_40x_40y` or to a field of `migrate_functions` record). Only backward migrations are partials. + +### What kind of guarantees to expect in practice? + +The fact that migrations are partial functions can seem too restrictive. +In practice, a problem only happens when an OCaml construction is used that didn't exist in the version the PPX rewriter was implemented with. + +This cannot occur when a new version of the compiler is released: existing code that was working before should work immediately after an update, since new features are not yet in use. This use case is the critical one for helping the introduction of a new compiler version (an opam switch should be usable readily after update). + +In the future, we might allow rewriting of unsupported features into extensions or attributes for rewriters that opt-in. Rewriting would succeed as long as all extensions disappeared when reaching the compiler (for instance, an OCaml 4.04 file using inline records could be rewritten by a rewriter targeting 4.02; however, a 4.02 files couldn't be rewritten by a 4.04 PPX that introduces inline records). + +Please voice your concerns if you have any, so that this use case is better understood.4.02 diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/Makefile b/src/vendored-ocaml-migrate-parsetree-v1.7.3/Makefile new file mode 100644 index 000000000..3f38cabd1 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/Makefile @@ -0,0 +1,42 @@ +# This file is part of the migrate-parsetree package. It is released under the +# terms of the LGPL 2.1 license (see LICENSE file). +# Copyright 2017 Frédéric Bour +# 2017 Jérémie Dimino + +INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) + +.PHONY: all +all: + dune build @install + +.PHONY: install +install: + dune install $(INSTALL_ARGS) + +.PHONY: uninstall +uninstall: + dune uninstall $(INSTALL_ARGS) + +.PHONY: reinstall +reinstall: + $(MAKE) uninstall + $(MAKE) install + +.PHONY: test +test: + dune runtest + +.PHONY: all-supported-ocaml-versions +all-supported-ocaml-versions: + dune runtest --workspace dune-workspace.dev + +.PHONY: cinaps +cinaps: + cinaps -styler ocp-indent -i src/migrate_parsetree_versions.ml* + cinaps -styler ocp-indent -i src/migrate_parsetree_4??_4??.ml* + cinaps -styler ocp-indent -i src/migrate_parsetree.ml + +.PHONY: clean +clean: + rm -rf _build *.install + find . -name .merlin -delete diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/README.md b/src/vendored-ocaml-migrate-parsetree-v1.7.3/README.md new file mode 100644 index 000000000..d532a01e7 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/README.md @@ -0,0 +1,164 @@ +# OCaml-migrate-parsetree +Convert OCaml parsetrees between different major versions + +This library converts between parsetrees of different OCaml versions. + +Supported versions are 4.02, 4.03, 4.04, 4.05, 4.06, 4.07, 4.08 and 4.09. +For each version, there is a snapshot of the parsetree and conversion functions +to the next and/or previous version. + +## Asts + +```ocaml +module Ast_402, Ast_403, Ast_404, Ast_405, Ast_406, Ast_407, Ast_408, Ast_409 : sig + + (* These two modules didn't change between compiler versions. + Just share the ones from compiler-libs. *) + module Location = Location + module Longident = Longident + + (* Version specific copy of AST *) + module Asttypes + module Parsetree + module Outcometree + + (* Other modules that are useful for implementing PPX. + + Docstrings and Ast_mapper only contain general definitions + In particular, the internal state used by compiler-libs has been + removed. + Also equalities are lost for abstract types (Docstring.docstring). *) + module Docstrings + module Ast_helper + module Ast_mapper + + (* Magic numbers used for marshalling *) + module Config : sig + val ast_impl_magic_number : string + val ast_intf_magic_number : string + end +end +``` + +These embed copies of AST definitions for each supported OCaml major version. + +The AST matching the version of the OCaml toolchain will contain equalities +relating the copy of types to the definitions from compiler-libs. For +instance, when installed with OCaml 4.04.x, `Ast_404.Parsetree` looks +like. + +## Migration modules + +For each pair of versions `$(n)` and `$(n+1)`, the two modules +`Migrate_parsetree_$(n)_$(n+1)` and `Migrate_parsetree_$(n+1)_$(n)` convert the AST forward and backward. + +The forward conversion is total while the backward conversion is partial: when +a feature is not available in a previous version of the parsetree, a +`Migrate_parsetree_def.Migration_error` exception is raised detailing the +failure case. + +`Migrate_parsetree_versions` abstract versions of the compiler. Each version is +represented as a module with `OCaml_version` signature. Instances are named +`OCaml_402`, `OCaml_403`, ... `OCaml_current` is an alias to the version of the +current compiler. +The `Convert` functor takes two versions of OCaml and produce conversion +functions. + +Finally, the `Migrate_parsetree_ast_io` provides an easy interface for +marshalling/unmarshalling. + +## Migrate_parsetree.Driver + +The `Migrate_parsetree.Driver` provides an API for ppx rewriters to +register OCaml AST rewriters. Ppx rewriters using this API can be used +as standalone rewriter executable or as part of a _driver_ including +several rewriters. + +Using a single driver for several rewritings has the advantage that it +is faster. Especially when using many ppx rewriters, it can speed up +compilation a lot. + +If using [Dune](https://github.com/ocaml/dune), you can +consult the dune manual to see how to define and use ppx +rewriters. Dune automatically creates drivers based on +ocaml-migrate-parsetree on demand. + +The rest of this section describes how to do things manually or with +[ocamlbuild](https://github.com/ocaml/ocamlbuild). + +## Building a custom driver using ocamlfind + +To build a custom driver using ocamlfind, simply link all the ppx +rewriter libraries together with the +`ocaml-migrate-parsetree.driver-main` package at the end: + + ocamlfind ocamlopt -predicates ppx_driver -o ppx -linkpkg \ + -package ppx_sexp_conv -package ppx_bin_prot \ + -package ocaml-migrate-parsetree.driver-main + +Normally, ocaml-migrate-parsetree based rewriters should be build with +the approriate `-linkall` option on individual libraries. If one is +missing this option, the rewriter might not get linked in. If this is +the case, a workaround is to pass `-linkall` when linking the custom +driver. + +The resulting `ppx` program can be used as follow: + +- `./ppx file.ml` to print the transformed code +- `ocamlc -pp './ppx --as-pp' ...` to use it as a pre-processor +- `ocamlc -ppx './ppx --as-ppx' ...` to use it as a `-ppx` rewriter + +# Development + +It started from the work of Alain Frisch in +[ppx\_tools](https://github.com/alainfrisch/ppx_tools). + +The library is distributed under LGPL 2.1 and is copyright INRIA. + +## Adding a new OCaml version + +We use [Cinaps](https://github.com/janestreet/cinaps) to generate boilerplate. +You can install it via opam: `opam install cinaps`. + +Add the new version in +[src/cinaps_helpers](https://github.com/ocaml-ppx/ocaml-migrate-parsetree/blob/master/src/cinaps_helpers) +`supported_versions`. + +Copy the last `src/ast_xxx.ml` file to `src/ast_.ml`, +then go over the file and update each sub-module by replacing its +signature and implementation with the code from the compiler. For the +`Config` sub-module, update the two variables with the values in +`utils/config.mlp` in the compiler source tree. + +Once this is done, call: + + $ dune exec tools/add_special_comments.exe src/ast_.ml + +Then diff the `src/ast_xxx.ml` and `src/ast_.ml` and go +over the diff to make sure the difference are relevant. The `ast_...` +files require some adjustments which should pop up when you do this +diff. Port the old adjustments to the new file as required. + +Add migration functions: +- Manually compile the asts (`ocamlc -c src/ast_{NEW,OLD}.ml -I +compiler-libs -I _build/default/src/.migrate_parsetree.objs/byte/ -open Migrate_parsetree__`) +- Using `tools/gencopy.exe` (`dune build tools/gencopy.exe`), generate copy code to and from previous version (assuming it is 408): +``` +_build/default/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_409:Ast_408 Ast_409.Parsetree.{expression,expr,pattern,pat,core_type,typ,toplevel_phrase} Ast_409.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_409_408_migrate.ml +_build/default/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_408:Ast_409 Ast_408.Parsetree.{expression,expr,pattern,pat,core_type,typ,toplevel_phrase} Ast_408.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_408_409_migrate.ml +``` +- Fix the generated code by implementing new cases +- The migration functor expects specific names, look at `Migrate_parsetree_versions` interface. + +*TODO*: specialize and improve gencopy for these cases + +Add mapper lifting functions in the files `migrate_parsetree_NEW_408.ml` and +`migrate_parsetree_408_NEW.ml`: +- include the corresponding `Migrate_parsetree_40x_40y_migrate` module +- define `copy_mapper` function, look at existing `Migrate_parsetree_40x_40y` + for guidance. + +At any time, you can expand boilerplate code by running `make cinaps`. + +Update build system: +- make sure `make cinaps` reaches a fixed point :) +- `make` should succeed diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune new file mode 100644 index 000000000..c99d0e2c9 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune @@ -0,0 +1,4 @@ +; (install +; (section doc) +; (package reason) +; (files MANUAL.md)) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-project-old b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-project-old new file mode 100644 index 000000000..2ce9b981f --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-project-old @@ -0,0 +1,4 @@ +(lang dune 1.9) +(name ocaml-migrate-parsetree) +(version v1.7.3) +(allow_approximate_merlin) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-workspace.dev b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-workspace.dev new file mode 100644 index 000000000..70c167198 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/dune-workspace.dev @@ -0,0 +1,11 @@ +(lang dune 1.0) + +;; This file is used by `make all-supported-ocaml-versions` +(context (opam (switch 4.02.3))) +(context (opam (switch 4.03.0))) +(context (opam (switch 4.04.2))) +(context (opam (switch 4.05.0))) +(context (opam (switch 4.06.1))) +(context (opam (switch 4.07.1))) +(context (opam (switch 4.08.1))) +;; (context (opam (switch ocaml-variants.4.09.0+beta1))) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/META b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/META new file mode 100644 index 000000000..50df05973 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/META @@ -0,0 +1,8 @@ +description = "ocaml-migrate-parsetree example: insert ocaml expressions from commandline" +version = "1.0" +requires(custom_ppx) = "ocaml-migrate-parsetree" +ppx(-custom_ppx,-ppx_driver) = "./ppx_define --as-ppx" +archive(byte,ppx_driver) = "ppx_define.cmo" +archive(native,ppx_driver) = "ppx_define.cmx" +plugin(byte,ppx_driver) = "ppx_define.cma" +plugin(native,ppx_driver) = "ppx_define.cmxs" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/Makefile b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/Makefile new file mode 100644 index 000000000..086a816bb --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/Makefile @@ -0,0 +1,40 @@ +PACKAGE=omp_ppx_define +OCAMLC=ocamlfind c +OCAMLOPT=ocamlfind opt +FLAGS=-package ocaml-migrate-parsetree +TARGETS=ppx_define ppx_define.cmo ppx_define.cmx ppx_define.cmxs + +all: build + +clean: + rm -f *.o *.cm* $(TARGETS) + +build: $(TARGETS) + +install: build + ocamlfind install $(PACKAGE) META $(TARGETS) + +uninstall: + ocamlfind remove $(PACKAGE) + +reinstall: + $(MAKE) uninstall + $(MAKE) install + +%.cmo: %.ml + $(OCAMLC) $(FLAGS) -c $^ + +%.cmx: %.ml + $(OCAMLOPT) $(FLAGS) -c $^ + +ppx_define.cmxs: ppx_define.cmx + $(OCAMLOPT) -o $@ -shared $^ + +ppx_define: ppx_define.cmx standalone.ml + $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ + +test: ppx_define + @echo "(* Original file: cat test.ml *)" + @cat test.ml + @echo "(* Substituted file: ./ppx_define -D 'var="hello"' test.ml *)" + @./ppx_define -D 'var="hello"' test.ml diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/ppx_define.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/ppx_define.ml new file mode 100644 index 000000000..2b0500998 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/ppx_define.ml @@ -0,0 +1,80 @@ +open Migrate_parsetree + + +(********************) + +(* Define the rewriter on OCaml 4.05 AST *) +open Ast_405 +let ocaml_version = Versions.ocaml_405 + +(* We will need to convert parsetree of the current compiler + (which is not yet known) to 4.05 one. *) +let migrate = Versions.migrate Versions.ocaml_current ocaml_version + + +(********************) + +(* Action of the rewriter: replace identifiers by OCaml expression. + Here we define how bindings are parsed. *) + +let bindings : (string, Parsetree.expression) Hashtbl.t = Hashtbl.create 7 + +let add_binding binding = + match String.index binding '=' with + | exception Not_found -> + let msg = Printf.sprintf + "Malformed binding: %S. Binding should have form name=value" binding + in + raise (Arg.Bad msg) + | pos -> + let name = String.sub binding 0 pos in + let value = + let len = String.length binding in + String.sub binding (pos + 1) (len - pos - 1) + in + let expression = + (* Parse the right handside of the binding *) + let lexbuf = Lexing.from_string value in + (* Use compiler-libs parser to get an expression + of the current version*) + let expression = Parse.expression lexbuf in + (* Use migrate to turn the parsetree into a 4.05 parsetree *) + migrate.Versions.copy_expression expression + in + (* If this pipeline failed, ocaml-migrate-parsetree driver will catch + the exception and report it to the user. *) + Hashtbl.replace bindings name expression + +let args_spec = [ + "-D", Arg.String add_binding, + " Replace identifier by the ocaml expression " +] + +let reset_args () = Hashtbl.clear bindings + +(********************) + +(* The rewriter itself *) + +let mapper _config _cookies = + let open Ast_mapper in + let open Ast_helper in + let expr mapper pexp = + match pexp.Parsetree.pexp_desc with + | Parsetree.Pexp_ident {Location.txt = Longident.Lident name; loc} -> + begin match Hashtbl.find bindings name with + | exception Not_found -> default_mapper.expr mapper pexp + | expr' -> {expr' with Parsetree.pexp_loc = loc} + end + | _ -> default_mapper.expr mapper pexp + in + {default_mapper with expr} + +(********************) + +(* Registration *) + +let () = + Driver.register + ~name:"ppx_here" ~args:args_spec ~reset_args + ocaml_version mapper diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/standalone.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/standalone.ml new file mode 100644 index 000000000..8834410e5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/standalone.ml @@ -0,0 +1,4 @@ +open Migrate_parsetree + +(* To run as a standalone binary, run the registered drivers *) +let () = Driver.run_main () diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/test.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/test.ml new file mode 100644 index 000000000..ab9e17759 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_define/test.ml @@ -0,0 +1 @@ +let () = print_endline var diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/META b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/META new file mode 100644 index 000000000..50fba2583 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/META @@ -0,0 +1,8 @@ +description = "ocaml-migrate-parsetree example: replace __HERE__ by location" +version = "1.0" +requires(custom_ppx) = "ocaml-migrate-parsetree" +ppx(-custom_ppx,-ppx_driver) = "./ppx_here --as-ppx" +archive(byte,ppx_driver) = "ppx_here.cmo" +archive(native,ppx_driver) = "ppx_here.cmx" +plugin(byte,ppx_driver) = "ppx_here.cma" +plugin(native,ppx_driver) = "ppx_here.cmxs" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/Makefile b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/Makefile new file mode 100644 index 000000000..e105f943c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/Makefile @@ -0,0 +1,34 @@ +PACKAGE=omp_ppx_here +OCAMLC=ocamlfind c +OCAMLOPT=ocamlfind opt +FLAGS=-package ocaml-migrate-parsetree +TARGETS=ppx_here ppx_here.cmo ppx_here.cmx ppx_here.cmxs + +all: build + +clean: + rm -f *.o *.cm* $(TARGETS) + +build: $(TARGETS) + +install: build + ocamlfind install $(PACKAGE) META $(TARGETS) + +uninstall: + ocamlfind remove $(PACKAGE) + +reinstall: + $(MAKE) uninstall + $(MAKE) install + +%.cmo: %.ml + $(OCAMLC) $(FLAGS) -c $^ + +%.cmx: %.ml + $(OCAMLOPT) $(FLAGS) -c $^ + +ppx_here.cmxs: ppx_here.cmx + $(OCAMLOPT) -o $@ -shared $^ + +ppx_here: ppx_here.cmx standalone.ml + $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/ppx_here.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/ppx_here.ml new file mode 100644 index 000000000..7b003e1d0 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/ppx_here.ml @@ -0,0 +1,29 @@ +open Migrate_parsetree + +(* Define the rewriter on OCaml 4.05 AST *) +open Ast_405 +let ocaml_version = Versions.ocaml_405 + +(* Action of the rewriter: replace __HERE__ expression by a tuple ("filename", + line, col) *) +let mapper _config _cookies = + let open Ast_mapper in + let open Ast_helper in + let expr mapper pexp = + match pexp.Parsetree.pexp_desc with + | Parsetree.Pexp_ident {Location.txt = Longident.Lident "__HERE__"; loc} -> + let {Lexing. pos_fname; pos_lnum; pos_cnum; pos_bol} = + loc.Location.loc_start in + let loc = {loc with Location.loc_ghost = true} in + let fname = Exp.constant ~loc (Const.string pos_fname) in + let line = Exp.constant ~loc (Const.int pos_lnum) in + let col = Exp.constant ~loc (Const.int (pos_cnum - pos_bol)) in + {pexp with Parsetree.pexp_desc = + Parsetree.Pexp_tuple [fname; line; col]} + | _ -> default_mapper.expr mapper pexp + in + {default_mapper with expr} + +(* Register the rewriter in the driver *) +let () = + Driver.register ~name:"ppx_here" ocaml_version mapper diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/standalone.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/standalone.ml new file mode 100644 index 000000000..8834410e5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_here/standalone.ml @@ -0,0 +1,4 @@ +open Migrate_parsetree + +(* To run as a standalone binary, run the registered drivers *) +let () = Driver.run_main () diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/META b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/META new file mode 100644 index 000000000..5092822d5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/META @@ -0,0 +1,8 @@ +description = "Parse strings into fragment of the AST" +version = "1.0" +requires(custom_ppx) = "ocaml-migrate-parsetree" +ppx(-custom_ppx,-ppx_driver) = "./ppx_parse --as-ppx" +archive(byte,ppx_driver) = "ppx_parse.cmo" +archive(native,ppx_driver) = "ppx_parse.cmx" +plugin(byte,ppx_driver) = "ppx_parse.cma" +plugin(native,ppx_driver) = "ppx_parse.cmxs" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/Makefile b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/Makefile new file mode 100644 index 000000000..06f130e92 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/Makefile @@ -0,0 +1,34 @@ +PACKAGE=ppx_parse +OCAMLC=ocamlfind c +OCAMLOPT=ocamlfind opt +FLAGS=-package ocaml-migrate-parsetree +TARGETS=ppx_parse ppx_parse.cmo ppx_parse.cmx ppx_parse.cmxs + +all: build + +clean: + rm -f *.o *.cm* $(TARGETS) + +build: $(TARGETS) + +install: build + ocamlfind install $(PACKAGE) META $(TARGETS) + +uninstall: + ocamlfind remove $(PACKAGE) + +reinstall: + $(MAKE) uninstall + $(MAKE) install + +%.cmo: %.ml + $(OCAMLC) $(FLAGS) -c $^ + +%.cmx: %.ml + $(OCAMLOPT) $(FLAGS) -c $^ + +ppx_parse.cmxs: ppx_parse.cmx + $(OCAMLOPT) -o $@ -shared $^ + +ppx_parse: ppx_parse.cmx standalone.ml + $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/ppx_parse.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/ppx_parse.ml new file mode 100644 index 000000000..7de74a3ca --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/ppx_parse.ml @@ -0,0 +1,40 @@ +open Migrate_parsetree + +(* Define the rewriter on OCaml 4.04 AST *) +open Ast_404 +let ocaml_version = Versions.ocaml_404 + +let from_current = Versions.migrate Versions.ocaml_current ocaml_version + +let prepare_lexbuf pos source = + let lexbuf = Lexing.from_string source in + lexbuf.Lexing.lex_curr_p <- pos; + lexbuf + +let prepare_for_parsing pexp = + let open Parsetree in + match pexp.pexp_desc with + | Pexp_constant (Pconst_string (source, Some "quote")) -> + let pos = + let pos = pexp.pexp_loc.Location.loc_start in + let pos_cnum = pos.Lexing.pos_cnum + String.length "{quote|" in + {pos with Lexing.pos_cnum} + in + Some (prepare_lexbuf pos source) + | _ -> None + +let mapper _config _cookies = + let open Ast_mapper in + let open Ast_helper in + let expr mapper pexp = + let pexp = default_mapper.expr mapper pexp in + match prepare_for_parsing pexp with + | Some lexbuf -> + from_current.Versions.copy_expression (Parse.expression lexbuf) + | None -> pexp + in + {default_mapper with expr} + +(* Register the rewriter in the driver *) +let () = + Driver.register ~name:"ppx_parse" ocaml_version mapper diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/standalone.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/standalone.ml new file mode 100644 index 000000000..8834410e5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/standalone.ml @@ -0,0 +1,4 @@ +open Migrate_parsetree + +(* To run as a standalone binary, run the registered drivers *) +let () = Driver.run_main () diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/test.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/test.ml new file mode 100644 index 000000000..1c00558b9 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/examples/omp_ppx_parse/test.ml @@ -0,0 +1,5 @@ +let _ = + {quote| + let x = 5 in + () + |quote} diff --git a/esy.lock/opam/ocaml-migrate-parsetree.1.7.3/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.backup-opam similarity index 69% rename from esy.lock/opam/ocaml-migrate-parsetree.1.7.3/opam rename to src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.backup-opam index 09ef0da3c..d1350ba34 100644 --- a/esy.lock/opam/ocaml-migrate-parsetree.1.7.3/opam +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.backup-opam @@ -1,3 +1,4 @@ +version: "1.7.3" opam-version: "2.0" maintainer: "frederic.bour@lakaban.net" authors: [ @@ -17,7 +18,7 @@ depends: [ "result" "ppx_derivers" "dune" {>= "1.9.0"} - "ocaml" {>= "4.02.3" & < "4.12"} + "ocaml" {>= "4.02.3"} ] synopsis: "Convert OCaml parsetrees between different versions" description: """ @@ -26,12 +27,4 @@ Convert OCaml parsetrees between different versions This library converts parsetrees, outcometree and ast mappers between different OCaml versions. High-level functions help making PPX rewriters independent of a compiler version. -""" -url { - src: - "https://github.com/ocaml-ppx/ocaml-migrate-parsetree/releases/download/v1.7.3/ocaml-migrate-parsetree-v1.7.3.tbz" - checksum: [ - "sha256=6d85717bcf476b87f290714872ed4fbde0233dc899c3158a27f439d70224fb55" - "sha512=fe9c74a244d160d973d8ca62e356edad4c872fc46471ddc668f854456d3979576895d446d49da2aee61c65b441b72c573225b0b254ab2eac4a0fb4debdbce9d4" - ] -} +""" \ No newline at end of file diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitattributes b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitattributes new file mode 100644 index 000000000..e0b4e26c5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitattributes @@ -0,0 +1,3 @@ + +# Set eol to LF so files aren't converted to CRLF-eol on Windows. +* text eol=lf linguist-generated diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitignore b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitignore new file mode 100644 index 000000000..a221be227 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/.gitignore @@ -0,0 +1,3 @@ + +# Reset any possible .gitignore, we want all esy.lock to be un-ignored. +!* diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/index.json b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/index.json new file mode 100644 index 000000000..b86952703 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/index.json @@ -0,0 +1,283 @@ +{ + "checksum": "f2792c821f32a51b941980104ee0d946", + "root": "ocaml-migrate-parsetree@link-dev:./ocaml-migrate-parsetree.opam", + "node": { + "ocaml-migrate-parsetree@link-dev:./ocaml-migrate-parsetree.opam": { + "id": "ocaml-migrate-parsetree@link-dev:./ocaml-migrate-parsetree.opam", + "name": "ocaml-migrate-parsetree", + "version": "link-dev:./ocaml-migrate-parsetree.opam", + "source": { + "type": "link-dev", + "path": ".", + "manifest": "ocaml-migrate-parsetree.opam" + }, + "overrides": [], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/result@opam:1.5@6b753c82", + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", + "@opam/dune@opam:2.6.2@20433b4f", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/result@opam:1.5@6b753c82", + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", + "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "ocaml@4.10.0@d41d8cd9": { + "id": "ocaml@4.10.0@d41d8cd9", + "name": "ocaml", + "version": "4.10.0", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.10.0.tgz#sha1:3797ee252dca8dec38d3cdd42162923f56dba433" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + }, + "@opam/result@opam:1.5@6b753c82": { + "id": "@opam/result@opam:1.5@6b753c82", + "name": "@opam/result", + "version": "opam:1.5", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/1b/1b82dec78849680b49ae9a8a365b831b#md5:1b82dec78849680b49ae9a8a365b831b", + "archive:https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz#md5:1b82dec78849680b49ae9a8a365b831b" + ], + "opam": { + "name": "result", + "version": "1.5", + "path": "ocaml-migrate-parsetree.esy.lock/opam/result.1.5" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/ppx_derivers@opam:1.2.1@ecf0aa45": { + "id": "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", + "name": "@opam/ppx_derivers", + "version": "opam:1.2.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/5d/5dc2bf130c1db3c731fe0fffc5648b41#md5:5dc2bf130c1db3c731fe0fffc5648b41", + "archive:https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz#md5:5dc2bf130c1db3c731fe0fffc5648b41" + ], + "opam": { + "name": "ppx_derivers", + "version": "1.2.1", + "path": "ocaml-migrate-parsetree.esy.lock/opam/ppx_derivers.1.2.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/dune@opam:2.6.2@20433b4f" + ] + }, + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2": { + "id": "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "name": "@opam/ocamlfind-secondary", + "version": "opam:1.8.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/18/18ca650982c15536616dea0e422cbd8c#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download2.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c" + ], + "opam": { + "name": "ocamlfind-secondary", + "version": "1.8.1", + "path": + "ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1" + } + }, + "overrides": [ + { + "opamoverride": + "ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override" + } + ], + "dependencies": [ + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f" + ] + }, + "@opam/ocamlfind@opam:1.8.1@ff07b0f9": { + "id": "@opam/ocamlfind@opam:1.8.1@ff07b0f9", + "name": "@opam/ocamlfind", + "version": "opam:1.8.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/18/18ca650982c15536616dea0e422cbd8c#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download2.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c", + "archive:http://download.camlcity.org/download/findlib-1.8.1.tar.gz#md5:18ca650982c15536616dea0e422cbd8c" + ], + "opam": { + "name": "ocamlfind", + "version": "1.8.1", + "path": "ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1" + } + }, + "overrides": [ + { + "opamoverride": + "ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override" + } + ], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", "@opam/conf-m4@opam:1@3b2b148a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.10.0@d41d8cd9" ] + }, + "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f": { + "id": "@opam/ocaml-secondary-compiler@opam:4.08.1-1@85df5d8f", + "name": "@opam/ocaml-secondary-compiler", + "version": "opam:4.08.1-1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/72/723b6bfe8cf5abcbccc6911143f71055#md5:723b6bfe8cf5abcbccc6911143f71055", + "archive:https://github.com/ocaml/ocaml/archive/4.08.1.tar.gz#md5:723b6bfe8cf5abcbccc6911143f71055" + ], + "opam": { + "name": "ocaml-secondary-compiler", + "version": "4.08.1-1", + "path": + "ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1" + } + }, + "overrides": [ + { + "opamoverride": + "ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override" + } + ], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.10.0@d41d8cd9" ] + }, + "@opam/dune@opam:2.6.2@20433b4f": { + "id": "@opam/dune@opam:2.6.2@20433b4f", + "name": "@opam/dune", + "version": "opam:2.6.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/4f/4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9#sha256:4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9", + "archive:https://github.com/ocaml/dune/releases/download/2.6.2/dune-2.6.2.tbz#sha256:4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9" + ], + "opam": { + "name": "dune", + "version": "2.6.2", + "path": "ocaml-migrate-parsetree.esy.lock/opam/dune.2.6.2" + } + }, + "overrides": [ + { + "opamoverride": + "ocaml-migrate-parsetree.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override" + } + ], + "dependencies": [ + "ocaml@4.10.0@d41d8cd9", + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.10.0@d41d8cd9", + "@opam/ocamlfind-secondary@opam:1.8.1@1afa38b2", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084" + ] + }, + "@opam/conf-m4@opam:1@3b2b148a": { + "id": "@opam/conf-m4@opam:1@3b2b148a", + "name": "@opam/conf-m4", + "version": "opam:1", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "conf-m4", + "version": "1", + "path": "ocaml-migrate-parsetree.esy.lock/opam/conf-m4.1" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@opam/base-unix@opam:base@87d0b2eb": { + "id": "@opam/base-unix@opam:base@87d0b2eb", + "name": "@opam/base-unix", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "base-unix", + "version": "base", + "path": "ocaml-migrate-parsetree.esy.lock/opam/base-unix.base" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@opam/base-threads@opam:base@36803084": { + "id": "@opam/base-threads@opam:base@36803084", + "name": "@opam/base-threads", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "base-threads", + "version": "base", + "path": "ocaml-migrate-parsetree.esy.lock/opam/base-threads.base" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@esy-ocaml/substs@0.0.1@d41d8cd9": { + "id": "@esy-ocaml/substs@0.0.1@d41d8cd9", + "name": "@esy-ocaml/substs", + "version": "0.0.1", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/@esy-ocaml/substs/-/substs-0.0.1.tgz#sha1:59ebdbbaedcda123fc7ed8fb2b302b7d819e9a46" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + } + } +} \ No newline at end of file diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-threads.base/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-threads.base/opam new file mode 100644 index 000000000..914ff50ce --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-threads.base/opam @@ -0,0 +1,6 @@ +opam-version: "2.0" +maintainer: "https://github.com/ocaml/opam-repository/issues" +description: """ +Threads library distributed with the OCaml compiler +""" + diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-unix.base/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-unix.base/opam new file mode 100644 index 000000000..b973540bc --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/base-unix.base/opam @@ -0,0 +1,6 @@ +opam-version: "2.0" +maintainer: "https://github.com/ocaml/opam-repository/issues" +description: """ +Unix library distributed with the OCaml compiler +""" + diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/conf-m4.1/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/conf-m4.1/opam new file mode 100644 index 000000000..c6feb2a74 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/conf-m4.1/opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +maintainer: "tim@gfxmonk.net" +homepage: "http://www.gnu.org/software/m4/m4.html" +bug-reports: "https://github.com/ocaml/opam-repository/issues" +authors: "GNU Project" +license: "GPL-3.0-only" +build: [["sh" "-exc" "echo | m4"]] +depexts: [ + ["m4"] {os-family = "debian"} + ["m4"] {os-distribution = "fedora"} + ["m4"] {os-distribution = "rhel"} + ["m4"] {os-distribution = "centos"} + ["m4"] {os-distribution = "alpine"} + ["m4"] {os-distribution = "nixos"} + ["m4"] {os-family = "suse"} + ["m4"] {os-distribution = "ol"} + ["m4"] {os-distribution = "arch"} +] +synopsis: "Virtual package relying on m4" +description: + "This package can only install if the m4 binary is installed on the system." +flags: conf diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/dune.2.6.2/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/dune.2.6.2/opam new file mode 100644 index 000000000..655fb0111 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/dune.2.6.2/opam @@ -0,0 +1,55 @@ +opam-version: "2.0" +synopsis: "Fast, portable, and opinionated build system" +description: """ + +dune is a build system that was designed to simplify the release of +Jane Street packages. It reads metadata from "dune" files following a +very simple s-expression syntax. + +dune is fast, has very low-overhead, and supports parallel builds on +all platforms. It has no system dependencies; all you need to build +dune or packages using dune is OCaml. You don't need make or bash +as long as the packages themselves don't use bash explicitly. + +dune supports multi-package development by simply dropping multiple +repositories into the same directory. + +It also supports multi-context builds, such as building against +several opam roots/switches simultaneously. This helps maintaining +packages across several versions of OCaml and gives cross-compilation +for free. +""" +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml/dune" +doc: "https://dune.readthedocs.io/" +bug-reports: "https://github.com/ocaml/dune/issues" +conflicts: [ + "dune-configurator" {< "2.3.0"} + "odoc" {< "1.3.0"} + "dune-release" {< "1.3.0"} + "js_of_ocaml-compiler" {< "3.6.0"} + "jbuilder" {= "transition"} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + # opam 2 sets OPAM_SWITCH_PREFIX, so we don't need a hardcoded path + ["ocaml" "configure.ml" "--libdir" lib] {opam-version < "2"} + ["ocaml" "bootstrap.ml" "-j" jobs] + ["./dune.exe" "build" "-p" name "--profile" "dune-bootstrap" "-j" jobs] +] +depends: [ + # Please keep the lower bound in sync with .travis.yml, dune-project + # and min_ocaml_version in bootstrap.ml + ("ocaml" {>= "4.07"} | ("ocaml" {< "4.07~~"} & "ocamlfind-secondary")) + "base-unix" + "base-threads" +] +url { + src: "https://github.com/ocaml/dune/releases/download/2.6.2/dune-2.6.2.tbz" + checksum: [ + "sha256=4f6ec1f3f27ac48753d03b4a172127e4a56ae724201a3a18dc827c94425788e9" + "sha512=d195479c99a59edb0cb7674375f45e518389b2f251b02e5f603c196b9592acbcf2a12193b3de70831a543fa477f57abb101fdd210660e25805b147c66877cafa" + ] +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch new file mode 100644 index 000000000..cda19dd2d --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Don-t-build-manpages-for-stdlib-docs.patch @@ -0,0 +1,24 @@ +From 0cf3c6ad7ce2a2b2806faceccfb0a9321da5e22a Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Fri, 26 Jul 2019 12:12:19 +0100 +Subject: [PATCH] Don't build manpages for stdlib docs +--- + ocamldoc/Makefile | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile +index b109815071..e31e441f61 100644 +--- a/ocamldoc/Makefile ++++ b/ocamldoc/Makefile +@@ -170,7 +170,7 @@ LIBCMIFILES = $(LIBCMOFILES:.cmo=.cmi) + + + .PHONY: all +-all: lib exe generators manpages ++all: lib exe generators + + manpages: generators + +-- +2.20.1 + diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch new file mode 100644 index 000000000..41f5f7704 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/0001-Fix-failure-to-install-tools-links.patch @@ -0,0 +1,26 @@ +From 705739fa54260b7a0e6cbba0b5a99e52c79f9c09 Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Tue, 6 Aug 2019 09:23:06 +0100 +Subject: [PATCH] Fix failure to install tools links + +In --disable-installing-bytecode-programs mode, the .opt version of the +tools is installed, but the symlink for the tool itself is not created. +--- + tools/Makefile | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/tools/Makefile b/tools/Makefile +index 530dd37f34..1b3014a3ab 100644 +--- a/tools/Makefile ++++ b/tools/Makefile +@@ -197,6 +197,7 @@ else + do \ + if test -f "$$i".opt; then \ + $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)"; \ ++ (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \ + fi; \ + done + endif +-- +2.20.1 + diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch new file mode 100644 index 000000000..e37b5e883 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/files/fix-gcc10.patch @@ -0,0 +1,34 @@ +commit 3f10a16153308f967149917585d2bc0b9c06492c +Author: Anil Madhavapeddy +Date: Sun Jun 21 18:40:27 2020 +0100 + + Add `-fcommon` unconditionally to CFLAGS to fix gcc10 build + + Signed-off-by: Anil Madhavapeddy + +diff --git a/configure b/configure +index 9a78a4554..0c54b560b 100755 +--- a/configure ++++ b/configure +@@ -12424,7 +12424,7 @@ $as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;}; + -fno-builtin-memcmp"; + internal_cflags="$gcc_warnings" ;; #( + gcc-*) : +- common_cflags="-O2 -fno-strict-aliasing -fwrapv"; ++ common_cflags="-O2 -fno-strict-aliasing -fwrapv -fcommon"; + internal_cflags="$gcc_warnings" ;; #( + msvc-*) : + common_cflags="-nologo -O2 -Gy- -MD" +diff --git a/configure.ac b/configure.ac +index f5d8a2687..775e0e2db 100644 +--- a/configure.ac ++++ b/configure.ac +@@ -540,7 +540,7 @@ AS_CASE([$host], + -fno-builtin-memcmp"; + internal_cflags="$gcc_warnings"], + [gcc-*], +- [common_cflags="-O2 -fno-strict-aliasing -fwrapv"; ++ [common_cflags="-O2 -fno-strict-aliasing -fwrapv -fcommon"; + internal_cflags="$gcc_warnings"], + [msvc-*], + [common_cflags="-nologo -O2 -Gy- -MD" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam new file mode 100644 index 000000000..905f9b3dd --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocaml-secondary-compiler.4.08.1-1/opam @@ -0,0 +1,51 @@ +opam-version: "2.0" +synopsis: "OCaml 4.08.1 Secondary Switch Compiler" +maintainer: "platform@lists.ocaml.org" +authors: "Xavier Leroy and many contributors" +homepage: "https://ocaml.org" +bug-reports: "https://github.com/ocaml/ocaml/issues" +dev-repo: "git://github.com/ocaml/ocaml" +depends: "ocaml" {< "4.08.0" | >= "4.09~"} +build: [ + [ + "./configure" + "--prefix=%{_:share}%" + "--libdir=%{_:share}%/lib" + "--disable-debugger" + "--disable-installing-bytecode-programs" + "--disable-debug-runtime" + "--disable-instrumented-runtime" + "--disable-graph-lib" + "CC=cc" {os = "openbsd" | os = "freebsd" | os = "macos"} + "ASPP=cc -c" {os = "openbsd" | os = "freebsd" | os = "macos"} + ] + [make "-j%{jobs}%" {os != "cygwin"} "world.opt"] +] +install: [make "install"] +url { + src: "https://github.com/ocaml/ocaml/archive/4.08.1.tar.gz" + checksum: "md5=723b6bfe8cf5abcbccc6911143f71055" +} +extra-files: [ + ["0001-Don-t-build-manpages-for-stdlib-docs.patch" "md5=6caa580fe6031c109d2dc96b19bd40cd"] + ["0001-Fix-failure-to-install-tools-links.patch" "md5=e973762c0b3d62b0b25a26468086fae3"] + ["fix-gcc10.patch" "md5=17ecd696a8f5647a4c543280599f6974"] +] +patches: [ + "0001-Don-t-build-manpages-for-stdlib-docs.patch" + "0001-Fix-failure-to-install-tools-links.patch" + "fix-gcc10.patch" +] + +post-messages: [ + "A failure in the middle of the build may be caused by build parallelism + (enabled by default). + Please file a bug report at https://github.com/ocaml/ocaml/issues" + {failure & jobs > 1 & os != "cygwin"} + "You can try installing again including --jobs=1 + to force a sequential build instead." + {failure & jobs > 1 & os != "cygwin" & opam-version >= "2.0.5"} +] +description: "Installs an additional compiler to the opam switch in +%{_:share}%/ocaml-secondary-compiler which can be accessed using +`ocamlfind -toolchain secondary`." diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in new file mode 100644 index 000000000..12e3ee661 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/META.in @@ -0,0 +1,3 @@ +description = "OCaml Secondary Compiler" +version = "%{ocaml-secondary-compiler:version}%" +directory = "%{ocaml-secondary-compiler:share}%/bin" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in new file mode 100644 index 000000000..d13023c9f --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/files/ocaml-secondary-compiler.conf.in @@ -0,0 +1,10 @@ +path(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +destdir(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +stdlib(secondary) = "%{ocaml-secondary-compiler:share}%/lib" +ocamlc(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlc" +ocamlopt(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlopt" +ocamlcp(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlcp" +ocamlmklib(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlmklib" +ocamlmktop(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamlmktop" +ocamldoc(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamldoc" +ocamldep(secondary) = "%{ocaml-secondary-compiler:share}%/bin/ocamldep" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/opam new file mode 100644 index 000000000..acdb57645 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind-secondary.1.8.1/opam @@ -0,0 +1,32 @@ +opam-version: "2.0" +maintainer: "David Allsopp " +homepage: "https://github.com/ocaml/opam-repository" +bug-reports: "https://github.com/ocaml/opam-repository/issues" +build: ["./configure" "-sitelib" "%{ocaml-secondary-compiler:share}%/lib" "-no-camlp4"] +install: [ + [make "install-meta"] + ["mkdir" "-p" "%{lib}%/findlib.conf.d/"] + ["cp" "ocaml-secondary-compiler.conf" "%{lib}%/findlib.conf.d/"] + ["mkdir" "-p" "%{ocaml-secondary-compiler:share}%/lib/ocaml"] + ["cp" "META" "%{ocaml-secondary-compiler:share}%/lib/ocaml"] +] +depends: [ + "ocaml-secondary-compiler" + "ocamlfind" {= "1.8.1"} +] +synopsis: "ocamlfind support for ocaml-secondary-compiler" +description: """ +Exposes the compiler built by the ocaml-secondary-compielr package via +-toolchain secondary. A virtual package called ocaml is also installed to +locate the binary directory via `ocamlfind -toolchain secondary query ocaml`.""" +authors: ["Gerd Stolpmann " "David Allsopp "] +substs: ["META" "ocaml-secondary-compiler.conf"] +extra-files: [ + ["META.in" "md5=8c6ea8a0158a33ed87e6c38a7d686d49"] + ["ocaml-secondary-compiler.conf.in" "md5=367a7bb68e2e1e65a31356421ddc809c"] +] +url { + src: "http://download.camlcity.org/download/findlib-1.8.1.tar.gz" + checksum: "md5=18ca650982c15536616dea0e422cbd8c" + mirrors: "http://download2.camlcity.org/download/findlib-1.8.1.tar.gz" +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub new file mode 100644 index 000000000..e5ad9907e --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub @@ -0,0 +1,4 @@ +#!/bin/sh + +BINDIR=$(dirname "$(command -v ocamlc)") +"$BINDIR/ocaml" -I "$OCAML_TOPLEVEL_PATH" "$@" diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install new file mode 100644 index 000000000..295c62545 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install @@ -0,0 +1,6 @@ +bin: [ + "src/findlib/ocamlfind" {"ocamlfind"} + "?src/findlib/ocamlfind_opt" {"ocamlfind"} + "?tools/safe_camlp4" +] +toplevel: ["src/findlib/topfind"] diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/opam new file mode 100644 index 000000000..d757d669c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ocamlfind.1.8.1/opam @@ -0,0 +1,50 @@ +opam-version: "2.0" +synopsis: "A library manager for OCaml" +maintainer: "Thomas Gazagnaire " +authors: "Gerd Stolpmann " +homepage: "http://projects.camlcity.org/projects/findlib.html" +bug-reports: "https://gitlab.camlcity.org/gerd/lib-findlib/issues" +dev-repo: "git+https://gitlab.camlcity.org/gerd/lib-findlib.git" +description: """ +Findlib is a library manager for OCaml. It provides a convention how +to store libraries, and a file format ("META") to describe the +properties of libraries. There is also a tool (ocamlfind) for +interpreting the META files, so that it is very easy to use libraries +in programs and scripts. +""" +build: [ + [ + "./configure" + "-bindir" + bin + "-sitelib" + lib + "-mandir" + man + "-config" + "%{lib}%/findlib.conf" + "-no-custom" + "-no-camlp4" {!ocaml:preinstalled & ocaml:version >= "4.02.0"} + "-no-topfind" {ocaml:preinstalled} + ] + [make "all"] + [make "opt"] {ocaml:native} +] +install: [ + [make "install"] + ["install" "-m" "0755" "ocaml-stub" "%{bin}%/ocaml"] {ocaml:preinstalled} +] +depends: [ + "ocaml" {>= "4.00.0"} + "conf-m4" {build} +] +extra-files: [ + ["ocamlfind.install" "md5=06f2c282ab52d93aa6adeeadd82a2543"] + ["ocaml-stub" "md5=181f259c9e0bad9ef523e7d4abfdf87a"] +] +url { + src: "http://download.camlcity.org/download/findlib-1.8.1.tar.gz" + checksum: "md5=18ca650982c15536616dea0e422cbd8c" + mirrors: "http://download2.camlcity.org/download/findlib-1.8.1.tar.gz" +} +depopts: ["graphics"] diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ppx_derivers.1.2.1/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ppx_derivers.1.2.1/opam new file mode 100644 index 000000000..3d10814e0 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/ppx_derivers.1.2.1/opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +maintainer: "jeremie@dimino.org" +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-ppx/ppx_derivers" +bug-reports: "https://github.com/ocaml-ppx/ppx_derivers/issues" +dev-repo: "git://github.com/ocaml-ppx/ppx_derivers.git" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" + "dune" +] +synopsis: "Shared [@@deriving] plugin registry" +description: """ +Ppx_derivers is a tiny package whose sole purpose is to allow +ppx_deriving and ppx_type_conv to inter-operate gracefully when linked +as part of the same ocaml-migrate-parsetree driver.""" +url { + src: "https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz" + checksum: "md5=5dc2bf130c1db3c731fe0fffc5648b41" +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/result.1.5/opam b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/result.1.5/opam new file mode 100644 index 000000000..671af042a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/opam/result.1.5/opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +maintainer: "opensource@janestreet.com" +authors: ["Jane Street Group, LLC "] +homepage: "https://github.com/janestreet/result" +dev-repo: "git+https://github.com/janestreet/result.git" +bug-reports: "https://github.com/janestreet/result/issues" +license: "BSD-3-Clause" +build: [["dune" "build" "-p" name "-j" jobs]] +depends: [ + "ocaml" + "dune" {>= "1.0"} +] +synopsis: "Compatibility Result module" +description: """ +Projects that want to use the new result type defined in OCaml >= 4.03 +while staying compatible with older version of OCaml should use the +Result module defined in this library.""" +url { + src: + "https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz" + checksum: "md5=1b82dec78849680b49ae9a8a365b831b" +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json new file mode 100644 index 000000000..f2b2e9f48 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__dune_opam__c__2.6.2_opam_override/package.json @@ -0,0 +1,34 @@ +{ + "buildsInSource": true, + "build": [ + [ + "ocaml", + "configure.ml", + "--libdir", + "#{self.lib}" + ], + [ + "env", + "-u", + "OCAMLLIB", + "ocaml", + "bootstrap.ml" + ], + [ + "./dune.exe", + "build", + "-p", + "dune", + "--profile", + "dune-bootstrap" + ] + ], + "install": "esy-installer dune.install", + "buildEnv": { + "OCAMLFIND_CONF": "$OCAMLFIND_SECONDARY_PREFIX/lib/findlib.conf.d/ocaml-secondary-compiler.conf", + "OCAMLPATH": "#{ $OCAMLFIND_SECONDARY_PREFIX / 'lib' : ocaml.lib : $OCAML_SECONDARY_COMPILER_PREFIX / 'share' / 'ocaml-secondary-compiler' / 'lib' }" + }, + "dependencies": { + "ocaml": "*" + } +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll new file mode 100644 index 000000000..26301ddd3 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/clone-flexdll @@ -0,0 +1,16 @@ +#! /bin/sh + +# clone-flexdll +# +# Brings in flexdll, if necessary + +if [ -d "flexdll" ] && [ -f "flexdll/flexdll.c" ]; then + echo "[Flexdll] Already present, no need to clone." +else + echo "[Flexdll] Cloning..." + git clone https://github.com/esy-ocaml/flexdll.git + cd flexdll + git checkout f84baaeae463f96f9582883a9cfb7dd1096757ff + cd .. + echo "[Flexdll] Clone successful!" +fi \ No newline at end of file diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows new file mode 100644 index 000000000..4040b49ea --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/configure-windows @@ -0,0 +1,22 @@ +#! /bin/sh + +# configure-windows +# +# Creates a native Windows MingW build, based on: +# https://github.com/ocaml/ocaml/blob/trunk/README.win32.adoc + + +export prefix=C:/ocamlmgw64 +while : ; do + case "$1" in + "") break;; + -prefix|--prefix) + prefix=$2; shift;; + esac + shift +done + +echo "[configure-windows] Setting up flexdll" +./clone-flexdll +./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32 --prefix=$prefix +make flexdll diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build new file mode 100644 index 000000000..b95356a53 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-build @@ -0,0 +1,24 @@ +#! /usr/bin/env bash + +# esy-build +# +# Wrapper to execute appropriate build strategy, based on platform + +set -u +set -e +set -o pipefail + +case "$(uname -s)" in + CYGWIN*|MINGW32*|MSYS*) + echo "[esy-build] Detected windows environment..." + make -j4 world.opt + make flexlink.opt + ;; + *) + echo "[esy-build] Detected OSX / Linux environment" + make -j4 world.opt + ;; +esac + +# Common build steps +make install \ No newline at end of file diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure new file mode 100644 index 000000000..fd196c517 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/files/esy-configure @@ -0,0 +1,29 @@ +#! /usr/bin/env bash + +# esy-configure +# +# Wrapper to delegate to configuration to the +# appropriate `configure` strategy based on the active platform. +# +# Today, OCaml has separate build strategies: +# - Linux, OSX, Cygwin (gcc) - https://github.com/ocaml/ocaml/blob/trunk/INSTALL.adoc +# - Windows, Cygin (mingw) - https://github.com/ocaml/ocaml/blob/trunk/README.win32.adoc +# +# We want `esy` to work cross-platform, so this is a shim script that will delegate to the +# appropriate script depending on the platform. We assume that if the platform is `CYGWIN` +# that the `mingw` (native executable) strategy is desired. + +set -u +set -e +set -o pipefail + +case "$(uname -s)" in + CYGWIN*|MINGW32*|MSYS*) + echo "[esy-configure] Detected windows environment..." + ./configure-windows "$@" + ;; + *) + echo "[esy-configure] Detected OSX / Linux environment" + ./configure "$@" + ;; +esac \ No newline at end of file diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json new file mode 100644 index 000000000..948455caf --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocaml_secondary_compiler_opam__c__4.08.1_1_opam_override/package.json @@ -0,0 +1,28 @@ +{ + "buildEnv": { + "PATH": "/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin" + }, + "build": [ + [ + "env", + "-u", + "OCAMLLIB", + "bash", "./esy-configure", + "--disable-cfi", + "--prefix", "$cur__install/share/ocaml-secondary-compiler", + "--libdir", "$cur__install/share/ocaml-secondary-compiler/lib", + "--disable-debugger", + "--disable-installing-bytecode-programs", + "--disable-debug-runtime", + "--disable-instrumented-runtime", + "--disable-graph-lib" + ], + [ + "env", + "-u", + "OCAMLLIB", + "bash", "./esy-build" + ] + ], + "buildsInSource": true +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch new file mode 100644 index 000000000..3e3ee5a24 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch @@ -0,0 +1,471 @@ +--- ./Makefile ++++ ./Makefile +@@ -57,16 +57,16 @@ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ +- echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ ++ echo 'ocamlc="ocamlc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamlopt; then \ +- echo 'ocamlopt="ocamlopt.opt"' >>findlib.conf; \ ++ echo 'ocamlopt="ocamlopt.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldep; then \ +- echo 'ocamldep="ocamldep.opt"' >>findlib.conf; \ ++ echo 'ocamldep="ocamldep.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldoc; then \ +- echo 'ocamldoc="ocamldoc.opt"' >>findlib.conf; \ ++ echo 'ocamldoc="ocamldoc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + + .PHONY: install-doc +--- ./src/findlib/findlib_config.mlp ++++ ./src/findlib/findlib_config.mlp +@@ -24,3 +24,5 @@ + | "MacOS" -> "" (* don't know *) + | _ -> failwith "Unknown Sys.os_type" + ;; ++ ++let exec_suffix = "@EXEC_SUFFIX@";; +--- ./src/findlib/findlib.ml ++++ ./src/findlib/findlib.ml +@@ -28,15 +28,20 @@ + let conf_ldconf = ref "";; + let conf_ignore_dups_in = ref ([] : string list);; + +-let ocamlc_default = "ocamlc";; +-let ocamlopt_default = "ocamlopt";; +-let ocamlcp_default = "ocamlcp";; +-let ocamloptp_default = "ocamloptp";; +-let ocamlmklib_default = "ocamlmklib";; +-let ocamlmktop_default = "ocamlmktop";; +-let ocamldep_default = "ocamldep";; +-let ocamlbrowser_default = "ocamlbrowser";; +-let ocamldoc_default = "ocamldoc";; ++let add_exec str = ++ match Findlib_config.exec_suffix with ++ | "" -> str ++ | a -> str ^ a ;; ++let ocamlc_default = add_exec "ocamlc";; ++let ocamlopt_default = add_exec "ocamlopt";; ++let ocamlcp_default = add_exec "ocamlcp";; ++let ocamloptp_default = add_exec "ocamloptp";; ++let ocamlmklib_default = add_exec "ocamlmklib";; ++let ocamlmktop_default = add_exec "ocamlmktop";; ++let ocamldep_default = add_exec "ocamldep";; ++let ocamlbrowser_default = add_exec "ocamlbrowser";; ++let ocamldoc_default = add_exec "ocamldoc";; ++ + + + let init_manually +--- ./src/findlib/fl_package_base.ml ++++ ./src/findlib/fl_package_base.ml +@@ -133,7 +133,15 @@ + List.find (fun def -> def.def_var = "exists_if") p.package_defs in + let files = Fl_split.in_words def.def_value in + List.exists +- (fun file -> Sys.file_exists (Filename.concat d' file)) ++ (fun file -> ++ let fln = Filename.concat d' file in ++ let e = Sys.file_exists fln in ++ (* necessary for ppx executables *) ++ if e || Sys.os_type <> "Win32" || Filename.check_suffix fln ".exe" then ++ e ++ else ++ Sys.file_exists (fln ^ ".exe") ++ ) + files + with Not_found -> true in + +--- ./src/findlib/fl_split.ml ++++ ./src/findlib/fl_split.ml +@@ -126,10 +126,17 @@ + | '/' | '\\' -> true + | _ -> false in + let norm_dir_win() = +- if l >= 1 && s.[0] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[0]; +- if l >= 2 && s.[1] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[1]; ++ if l >= 1 then ( ++ if s.[0] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[0] ; ++ if l >= 2 then ++ if s.[1] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[1]; ++ ); + for k = 2 to l - 1 do + let c = s.[k] in + if is_slash c then ( +--- ./src/findlib/frontend.ml ++++ ./src/findlib/frontend.ml +@@ -31,10 +31,18 @@ + else + Sys_error (arg ^ ": " ^ Unix.error_message code) + ++let is_win = Sys.os_type = "Win32" ++ ++let () = ++ match Findlib_config.system with ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> ++ (try set_binary_mode_out stdout true with _ -> ()); ++ (try set_binary_mode_out stderr true with _ -> ()); ++ | _ -> () + + let slashify s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> + let b = Buffer.create 80 in + String.iter + (function +@@ -49,7 +57,7 @@ + + let out_path ?(prefix="") s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "mingw64" | "cygwin" -> + let u = slashify s in + prefix ^ + (if String.contains u ' ' then +@@ -273,11 +281,9 @@ + + + let identify_dir d = +- match Sys.os_type with +- | "Win32" -> +- failwith "identify_dir" (* not available *) +- | _ -> +- let s = Unix.stat d in ++ if is_win then ++ failwith "identify_dir"; (* not available *) ++ let s = Unix.stat d in + (s.Unix.st_dev, s.Unix.st_ino) + ;; + +@@ -459,6 +465,96 @@ + ) + packages + ++let rewrite_cmd s = ++ if s = "" || not is_win then ++ s ++ else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_cmd s = ++ if s = "" || not is_win then s else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_pp cmd = ++ if not is_win then cmd else ++ let module T = struct exception Keep end in ++ let is_whitespace = function ++ | ' ' | '\011' | '\012' | '\n' | '\r' | '\t' -> true ++ | _ -> false in ++ (* characters that triggers special behaviour (cmd.exe, not unix shell) *) ++ let is_unsafe_char = function ++ | '(' | ')' | '%' | '!' | '^' | '<' | '>' | '&' -> true ++ | _ -> false in ++ let len = String.length cmd in ++ let buf = Buffer.create (len + 4) in ++ let buf_cmd = Buffer.create len in ++ let rec iter_ws i = ++ if i >= len then () else ++ let cur = cmd.[i] in ++ if is_whitespace cur then ( ++ Buffer.add_char buf cur; ++ iter_ws (succ i) ++ ) ++ else ++ iter_cmd i ++ and iter_cmd i = ++ if i >= len then add_buf_cmd () else ++ let cur = cmd.[i] in ++ if is_unsafe_char cur || cur = '"' || cur = '\'' then ++ raise T.Keep; ++ if is_whitespace cur then ( ++ add_buf_cmd (); ++ Buffer.add_substring buf cmd i (len - i) ++ ) ++ else ( ++ Buffer.add_char buf_cmd cur; ++ iter_cmd (succ i) ++ ) ++ and add_buf_cmd () = ++ if Buffer.length buf_cmd > 0 then ++ Buffer.add_string buf (rewrite_cmd (Buffer.contents buf_cmd)) ++ in ++ try ++ iter_ws 0; ++ Buffer.contents buf ++ with ++ | T.Keep -> cmd + + let process_pp_spec syntax_preds packages pp_opts = + (* Returns: pp_command *) +@@ -549,7 +645,7 @@ + None -> [] + | Some cmd -> + ["-pp"; +- cmd ^ " " ^ ++ (rewrite_cmd cmd) ^ " " ^ + String.concat " " (List.map Filename.quote pp_i_options) ^ " " ^ + String.concat " " (List.map Filename.quote pp_archives) ^ " " ^ + String.concat " " (List.map Filename.quote pp_opts)] +@@ -625,9 +721,11 @@ + in + try + let preprocessor = ++ rewrite_cmd ( + resolve_path + ~base ~explicit:true +- (package_property predicates pname "ppx") in ++ (package_property predicates pname "ppx") ) ++ in + ["-ppx"; String.concat " " (preprocessor :: options)] + with Not_found -> [] + ) +@@ -895,6 +993,14 @@ + switch (e.g. -L instead of -L ) + *) + ++(* We may need to remove files on which we do not have complete control. ++ On Windows, removing a read-only file fails so try to change the ++ mode of the file first. *) ++let remove_file fname = ++ try Sys.remove fname ++ with Sys_error _ when is_win -> ++ (try Unix.chmod fname 0o666 with Unix.Unix_error _ -> ()); ++ Sys.remove fname + + let ocamlc which () = + +@@ -1022,9 +1128,12 @@ + + "-intf", + Arg.String (fun s -> pass_files := !pass_files @ [ Intf(slashify s) ]); +- ++ + "-pp", +- Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" s); ++ Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" (rewrite_pp s)); ++ ++ "-ppx", ++ Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); + + "-thread", + Arg.Unit (fun _ -> threads := threads_default); +@@ -1237,7 +1346,7 @@ + with + any -> + close_out initl; +- Sys.remove initl_file_name; ++ remove_file initl_file_name; + raise any + end; + +@@ -1245,9 +1354,9 @@ + at_exit + (fun () -> + let tr f x = try f x with _ -> () in +- tr Sys.remove initl_file_name; +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmi"); +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmo"); ++ tr remove_file initl_file_name; ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmi"); ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmo"); + ); + + let exclude_list = [ stdlibdir; threads_dir; vmthreads_dir ] in +@@ -1493,7 +1602,9 @@ + [ "-v", Arg.Unit (fun () -> verbose := Verbose); + "-pp", Arg.String (fun s -> + pp_specified := true; +- options := !options @ ["-pp"; s]); ++ options := !options @ ["-pp"; rewrite_pp s]); ++ "-ppx", Arg.String (fun s -> ++ options := !options @ ["-ppx"; rewrite_pp s]); + ] + ) + ) +@@ -1672,7 +1783,9 @@ + Arg.String (fun s -> add_spec_fn "-I" (slashify (resolve_path s))); + + "-pp", Arg.String (fun s -> pp_specified := true; +- add_spec_fn "-pp" s); ++ add_spec_fn "-pp" (rewrite_pp s)); ++ "-ppx", Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); ++ + ] + ) + ) +@@ -1830,7 +1943,10 @@ + output_string ch_out append; + close_out ch_out; + close_in ch_in; +- Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime; ++ (try Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime ++ with Unix.Unix_error(e,_,_) -> ++ prerr_endline("Warning: setting utimes for " ^ outpath ++ ^ ": " ^ Unix.error_message e)); + + prerr_endline("Installed " ^ outpath); + with +@@ -1882,6 +1998,8 @@ + Unix.openfile (Filename.concat dir owner_file) [Unix.O_RDONLY] 0 in + let f = + Unix.in_channel_of_descr fd in ++ if is_win then ++ set_binary_mode_in f false; + try + let line = input_line f in + let is_my_file = (line = pkg) in +@@ -2208,7 +2326,7 @@ + let lines = read_ldconf !ldconf in + let dlldir_norm = Fl_split.norm_dir dlldir in + let dlldir_norm_lc = string_lowercase_ascii dlldir_norm in +- let ci_filesys = (Sys.os_type = "Win32") in ++ let ci_filesys = is_win in + let check_dir d = + let d' = Fl_split.norm_dir d in + (d' = dlldir_norm) || +@@ -2356,7 +2474,7 @@ + List.iter + (fun file -> + let absfile = Filename.concat dlldir file in +- Sys.remove absfile; ++ remove_file absfile; + prerr_endline ("Removed " ^ absfile) + ) + dll_files +@@ -2365,7 +2483,7 @@ + (* Remove the files from the package directory: *) + if Sys.file_exists pkgdir then begin + let files = Sys.readdir pkgdir in +- Array.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files; ++ Array.iter (fun f -> remove_file (Filename.concat pkgdir f)) files; + Unix.rmdir pkgdir; + prerr_endline ("Removed " ^ pkgdir) + end +@@ -2415,7 +2533,9 @@ + + + let print_configuration() = ++ let sl = slashify in + let dir s = ++ let s = sl s in + if Sys.file_exists s then + s + else +@@ -2453,27 +2573,27 @@ + if md = "" then "the corresponding package directories" else dir md + ); + Printf.printf "The standard library is assumed to reside in:\n %s\n" +- (Findlib.ocaml_stdlib()); ++ (sl (Findlib.ocaml_stdlib())); + Printf.printf "The ld.conf file can be found here:\n %s\n" +- (Findlib.ocaml_ldconf()); ++ (sl (Findlib.ocaml_ldconf())); + flush stdout + | Some "conf" -> +- print_endline (Findlib.config_file()) ++ print_endline (sl (Findlib.config_file())) + | Some "path" -> +- List.iter print_endline (Findlib.search_path()) ++ List.iter ( fun x -> print_endline (sl x)) (Findlib.search_path()) + | Some "destdir" -> +- print_endline (Findlib.default_location()) ++ print_endline ( sl (Findlib.default_location())) + | Some "metadir" -> +- print_endline (Findlib.meta_directory()) ++ print_endline ( sl (Findlib.meta_directory())) + | Some "metapath" -> + let mdir = Findlib.meta_directory() in + let ddir = Findlib.default_location() in +- print_endline +- (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META") ++ print_endline ( sl ++ (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META")) + | Some "stdlib" -> +- print_endline (Findlib.ocaml_stdlib()) ++ print_endline ( sl (Findlib.ocaml_stdlib())) + | Some "ldconf" -> +- print_endline (Findlib.ocaml_ldconf()) ++ print_endline ( sl (Findlib.ocaml_ldconf())) + | _ -> + assert false + ;; +@@ -2481,7 +2601,7 @@ + + let ocamlcall pkg cmd = + let dir = package_directory pkg in +- let path = Filename.concat dir cmd in ++ let path = rewrite_cmd (Filename.concat dir cmd) in + begin + try Unix.access path [ Unix.X_OK ] + with +@@ -2647,6 +2767,10 @@ + | Sys_error f -> + prerr_endline ("ocamlfind: " ^ f); + exit 2 ++ | Unix.Unix_error (e, fn, f) -> ++ prerr_endline ("ocamlfind: " ^ fn ^ " " ^ f ++ ^ ": " ^ Unix.error_message e); ++ exit 2 + | Findlib.No_such_package(pkg,info) -> + prerr_endline ("ocamlfind: Package `" ^ pkg ^ "' not found" ^ + (if info <> "" then " - " ^ info else "")); +--- ./src/findlib/Makefile ++++ ./src/findlib/Makefile +@@ -90,6 +90,7 @@ + cat findlib_config.mlp | \ + $(SH) $(TOP)/tools/patch '@CONFIGFILE@' '$(OCAMLFIND_CONF)' | \ + $(SH) $(TOP)/tools/patch '@STDLIB@' '$(OCAML_CORE_STDLIB)' | \ ++ $(SH) $(TOP)/tools/patch '@EXEC_SUFFIX@' '$(EXEC_SUFFIX)' | \ + sed -e 's;@AUTOLINK@;$(OCAML_AUTOLINK);g' \ + -e 's;@SYSTEM@;$(SYSTEM);g' \ + >findlib_config.ml diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json new file mode 100644 index 000000000..9314f8708 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json @@ -0,0 +1,61 @@ +{ + "build": [ + [ + "bash", + "-c", + "#{os == 'windows' ? 'patch -p1 < findlib-1.8.1.patch' : 'true'}" + ], + [ + "./configure", + "-bindir", + "#{self.bin}", + "-sitelib", + "#{self.lib}", + "-mandir", + "#{self.man}", + "-config", + "#{self.lib}/findlib.conf", + "-no-custom", + "-no-topfind" + ], + [ + "make", + "all" + ], + [ + "make", + "opt" + ] + ], + "install": [ + [ + "make", + "install" + ], + [ + "install", + "-m", + "0755", + "ocaml-stub", + "#{self.bin}/ocaml" + ], + [ + "mkdir", + "-p", + "#{self.toplevel}" + ], + [ + "install", + "-m", + "0644", + "src/findlib/topfind", + "#{self.toplevel}/topfind" + ] + ], + "exportedEnv": { + "OCAML_TOPLEVEL_PATH": { + "val": "#{self.toplevel}", + "scope": "global" + } + } +} diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch new file mode 100644 index 000000000..3e3ee5a24 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch @@ -0,0 +1,471 @@ +--- ./Makefile ++++ ./Makefile +@@ -57,16 +57,16 @@ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ +- echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ ++ echo 'ocamlc="ocamlc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamlopt; then \ +- echo 'ocamlopt="ocamlopt.opt"' >>findlib.conf; \ ++ echo 'ocamlopt="ocamlopt.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldep; then \ +- echo 'ocamldep="ocamldep.opt"' >>findlib.conf; \ ++ echo 'ocamldep="ocamldep.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + if ./tools/cmd_from_same_dir ocamldoc; then \ +- echo 'ocamldoc="ocamldoc.opt"' >>findlib.conf; \ ++ echo 'ocamldoc="ocamldoc.opt$(EXEC_SUFFIX)"' >>findlib.conf; \ + fi + + .PHONY: install-doc +--- ./src/findlib/findlib_config.mlp ++++ ./src/findlib/findlib_config.mlp +@@ -24,3 +24,5 @@ + | "MacOS" -> "" (* don't know *) + | _ -> failwith "Unknown Sys.os_type" + ;; ++ ++let exec_suffix = "@EXEC_SUFFIX@";; +--- ./src/findlib/findlib.ml ++++ ./src/findlib/findlib.ml +@@ -28,15 +28,20 @@ + let conf_ldconf = ref "";; + let conf_ignore_dups_in = ref ([] : string list);; + +-let ocamlc_default = "ocamlc";; +-let ocamlopt_default = "ocamlopt";; +-let ocamlcp_default = "ocamlcp";; +-let ocamloptp_default = "ocamloptp";; +-let ocamlmklib_default = "ocamlmklib";; +-let ocamlmktop_default = "ocamlmktop";; +-let ocamldep_default = "ocamldep";; +-let ocamlbrowser_default = "ocamlbrowser";; +-let ocamldoc_default = "ocamldoc";; ++let add_exec str = ++ match Findlib_config.exec_suffix with ++ | "" -> str ++ | a -> str ^ a ;; ++let ocamlc_default = add_exec "ocamlc";; ++let ocamlopt_default = add_exec "ocamlopt";; ++let ocamlcp_default = add_exec "ocamlcp";; ++let ocamloptp_default = add_exec "ocamloptp";; ++let ocamlmklib_default = add_exec "ocamlmklib";; ++let ocamlmktop_default = add_exec "ocamlmktop";; ++let ocamldep_default = add_exec "ocamldep";; ++let ocamlbrowser_default = add_exec "ocamlbrowser";; ++let ocamldoc_default = add_exec "ocamldoc";; ++ + + + let init_manually +--- ./src/findlib/fl_package_base.ml ++++ ./src/findlib/fl_package_base.ml +@@ -133,7 +133,15 @@ + List.find (fun def -> def.def_var = "exists_if") p.package_defs in + let files = Fl_split.in_words def.def_value in + List.exists +- (fun file -> Sys.file_exists (Filename.concat d' file)) ++ (fun file -> ++ let fln = Filename.concat d' file in ++ let e = Sys.file_exists fln in ++ (* necessary for ppx executables *) ++ if e || Sys.os_type <> "Win32" || Filename.check_suffix fln ".exe" then ++ e ++ else ++ Sys.file_exists (fln ^ ".exe") ++ ) + files + with Not_found -> true in + +--- ./src/findlib/fl_split.ml ++++ ./src/findlib/fl_split.ml +@@ -126,10 +126,17 @@ + | '/' | '\\' -> true + | _ -> false in + let norm_dir_win() = +- if l >= 1 && s.[0] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[0]; +- if l >= 2 && s.[1] = '/' then +- Buffer.add_char b '\\' else Buffer.add_char b s.[1]; ++ if l >= 1 then ( ++ if s.[0] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[0] ; ++ if l >= 2 then ++ if s.[1] = '/' then ++ Buffer.add_char b '\\' ++ else ++ Buffer.add_char b s.[1]; ++ ); + for k = 2 to l - 1 do + let c = s.[k] in + if is_slash c then ( +--- ./src/findlib/frontend.ml ++++ ./src/findlib/frontend.ml +@@ -31,10 +31,18 @@ + else + Sys_error (arg ^ ": " ^ Unix.error_message code) + ++let is_win = Sys.os_type = "Win32" ++ ++let () = ++ match Findlib_config.system with ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> ++ (try set_binary_mode_out stdout true with _ -> ()); ++ (try set_binary_mode_out stderr true with _ -> ()); ++ | _ -> () + + let slashify s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "cygwin" | "mingw64" | "cygwin64" -> + let b = Buffer.create 80 in + String.iter + (function +@@ -49,7 +57,7 @@ + + let out_path ?(prefix="") s = + match Findlib_config.system with +- | "mingw" | "mingw64" | "cygwin" -> ++ | "win32" | "win64" | "mingw" | "mingw64" | "cygwin" -> + let u = slashify s in + prefix ^ + (if String.contains u ' ' then +@@ -273,11 +281,9 @@ + + + let identify_dir d = +- match Sys.os_type with +- | "Win32" -> +- failwith "identify_dir" (* not available *) +- | _ -> +- let s = Unix.stat d in ++ if is_win then ++ failwith "identify_dir"; (* not available *) ++ let s = Unix.stat d in + (s.Unix.st_dev, s.Unix.st_ino) + ;; + +@@ -459,6 +465,96 @@ + ) + packages + ++let rewrite_cmd s = ++ if s = "" || not is_win then ++ s ++ else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_cmd s = ++ if s = "" || not is_win then s else ++ let s = ++ let l = String.length s in ++ let b = Buffer.create l in ++ for i = 0 to pred l do ++ match s.[i] with ++ | '/' -> Buffer.add_char b '\\' ++ | x -> Buffer.add_char b x ++ done; ++ Buffer.contents b ++ in ++ if (Filename.is_implicit s && String.contains s '\\' = false) || ++ Filename.check_suffix (String.lowercase s) ".exe" then ++ s ++ else ++ let s' = s ^ ".exe" in ++ if Sys.file_exists s' then ++ s' ++ else ++ s ++ ++let rewrite_pp cmd = ++ if not is_win then cmd else ++ let module T = struct exception Keep end in ++ let is_whitespace = function ++ | ' ' | '\011' | '\012' | '\n' | '\r' | '\t' -> true ++ | _ -> false in ++ (* characters that triggers special behaviour (cmd.exe, not unix shell) *) ++ let is_unsafe_char = function ++ | '(' | ')' | '%' | '!' | '^' | '<' | '>' | '&' -> true ++ | _ -> false in ++ let len = String.length cmd in ++ let buf = Buffer.create (len + 4) in ++ let buf_cmd = Buffer.create len in ++ let rec iter_ws i = ++ if i >= len then () else ++ let cur = cmd.[i] in ++ if is_whitespace cur then ( ++ Buffer.add_char buf cur; ++ iter_ws (succ i) ++ ) ++ else ++ iter_cmd i ++ and iter_cmd i = ++ if i >= len then add_buf_cmd () else ++ let cur = cmd.[i] in ++ if is_unsafe_char cur || cur = '"' || cur = '\'' then ++ raise T.Keep; ++ if is_whitespace cur then ( ++ add_buf_cmd (); ++ Buffer.add_substring buf cmd i (len - i) ++ ) ++ else ( ++ Buffer.add_char buf_cmd cur; ++ iter_cmd (succ i) ++ ) ++ and add_buf_cmd () = ++ if Buffer.length buf_cmd > 0 then ++ Buffer.add_string buf (rewrite_cmd (Buffer.contents buf_cmd)) ++ in ++ try ++ iter_ws 0; ++ Buffer.contents buf ++ with ++ | T.Keep -> cmd + + let process_pp_spec syntax_preds packages pp_opts = + (* Returns: pp_command *) +@@ -549,7 +645,7 @@ + None -> [] + | Some cmd -> + ["-pp"; +- cmd ^ " " ^ ++ (rewrite_cmd cmd) ^ " " ^ + String.concat " " (List.map Filename.quote pp_i_options) ^ " " ^ + String.concat " " (List.map Filename.quote pp_archives) ^ " " ^ + String.concat " " (List.map Filename.quote pp_opts)] +@@ -625,9 +721,11 @@ + in + try + let preprocessor = ++ rewrite_cmd ( + resolve_path + ~base ~explicit:true +- (package_property predicates pname "ppx") in ++ (package_property predicates pname "ppx") ) ++ in + ["-ppx"; String.concat " " (preprocessor :: options)] + with Not_found -> [] + ) +@@ -895,6 +993,14 @@ + switch (e.g. -L instead of -L ) + *) + ++(* We may need to remove files on which we do not have complete control. ++ On Windows, removing a read-only file fails so try to change the ++ mode of the file first. *) ++let remove_file fname = ++ try Sys.remove fname ++ with Sys_error _ when is_win -> ++ (try Unix.chmod fname 0o666 with Unix.Unix_error _ -> ()); ++ Sys.remove fname + + let ocamlc which () = + +@@ -1022,9 +1128,12 @@ + + "-intf", + Arg.String (fun s -> pass_files := !pass_files @ [ Intf(slashify s) ]); +- ++ + "-pp", +- Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" s); ++ Arg.String (fun s -> pp_specified := true; add_spec_fn "-pp" (rewrite_pp s)); ++ ++ "-ppx", ++ Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); + + "-thread", + Arg.Unit (fun _ -> threads := threads_default); +@@ -1237,7 +1346,7 @@ + with + any -> + close_out initl; +- Sys.remove initl_file_name; ++ remove_file initl_file_name; + raise any + end; + +@@ -1245,9 +1354,9 @@ + at_exit + (fun () -> + let tr f x = try f x with _ -> () in +- tr Sys.remove initl_file_name; +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmi"); +- tr Sys.remove (Filename.chop_extension initl_file_name ^ ".cmo"); ++ tr remove_file initl_file_name; ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmi"); ++ tr remove_file (Filename.chop_extension initl_file_name ^ ".cmo"); + ); + + let exclude_list = [ stdlibdir; threads_dir; vmthreads_dir ] in +@@ -1493,7 +1602,9 @@ + [ "-v", Arg.Unit (fun () -> verbose := Verbose); + "-pp", Arg.String (fun s -> + pp_specified := true; +- options := !options @ ["-pp"; s]); ++ options := !options @ ["-pp"; rewrite_pp s]); ++ "-ppx", Arg.String (fun s -> ++ options := !options @ ["-ppx"; rewrite_pp s]); + ] + ) + ) +@@ -1672,7 +1783,9 @@ + Arg.String (fun s -> add_spec_fn "-I" (slashify (resolve_path s))); + + "-pp", Arg.String (fun s -> pp_specified := true; +- add_spec_fn "-pp" s); ++ add_spec_fn "-pp" (rewrite_pp s)); ++ "-ppx", Arg.String (fun s -> add_spec_fn "-ppx" (rewrite_pp s)); ++ + ] + ) + ) +@@ -1830,7 +1943,10 @@ + output_string ch_out append; + close_out ch_out; + close_in ch_in; +- Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime; ++ (try Unix.utimes outpath s.Unix.st_mtime s.Unix.st_mtime ++ with Unix.Unix_error(e,_,_) -> ++ prerr_endline("Warning: setting utimes for " ^ outpath ++ ^ ": " ^ Unix.error_message e)); + + prerr_endline("Installed " ^ outpath); + with +@@ -1882,6 +1998,8 @@ + Unix.openfile (Filename.concat dir owner_file) [Unix.O_RDONLY] 0 in + let f = + Unix.in_channel_of_descr fd in ++ if is_win then ++ set_binary_mode_in f false; + try + let line = input_line f in + let is_my_file = (line = pkg) in +@@ -2208,7 +2326,7 @@ + let lines = read_ldconf !ldconf in + let dlldir_norm = Fl_split.norm_dir dlldir in + let dlldir_norm_lc = string_lowercase_ascii dlldir_norm in +- let ci_filesys = (Sys.os_type = "Win32") in ++ let ci_filesys = is_win in + let check_dir d = + let d' = Fl_split.norm_dir d in + (d' = dlldir_norm) || +@@ -2356,7 +2474,7 @@ + List.iter + (fun file -> + let absfile = Filename.concat dlldir file in +- Sys.remove absfile; ++ remove_file absfile; + prerr_endline ("Removed " ^ absfile) + ) + dll_files +@@ -2365,7 +2483,7 @@ + (* Remove the files from the package directory: *) + if Sys.file_exists pkgdir then begin + let files = Sys.readdir pkgdir in +- Array.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files; ++ Array.iter (fun f -> remove_file (Filename.concat pkgdir f)) files; + Unix.rmdir pkgdir; + prerr_endline ("Removed " ^ pkgdir) + end +@@ -2415,7 +2533,9 @@ + + + let print_configuration() = ++ let sl = slashify in + let dir s = ++ let s = sl s in + if Sys.file_exists s then + s + else +@@ -2453,27 +2573,27 @@ + if md = "" then "the corresponding package directories" else dir md + ); + Printf.printf "The standard library is assumed to reside in:\n %s\n" +- (Findlib.ocaml_stdlib()); ++ (sl (Findlib.ocaml_stdlib())); + Printf.printf "The ld.conf file can be found here:\n %s\n" +- (Findlib.ocaml_ldconf()); ++ (sl (Findlib.ocaml_ldconf())); + flush stdout + | Some "conf" -> +- print_endline (Findlib.config_file()) ++ print_endline (sl (Findlib.config_file())) + | Some "path" -> +- List.iter print_endline (Findlib.search_path()) ++ List.iter ( fun x -> print_endline (sl x)) (Findlib.search_path()) + | Some "destdir" -> +- print_endline (Findlib.default_location()) ++ print_endline ( sl (Findlib.default_location())) + | Some "metadir" -> +- print_endline (Findlib.meta_directory()) ++ print_endline ( sl (Findlib.meta_directory())) + | Some "metapath" -> + let mdir = Findlib.meta_directory() in + let ddir = Findlib.default_location() in +- print_endline +- (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META") ++ print_endline ( sl ++ (if mdir <> "" then mdir ^ "/META.%s" else ddir ^ "/%s/META")) + | Some "stdlib" -> +- print_endline (Findlib.ocaml_stdlib()) ++ print_endline ( sl (Findlib.ocaml_stdlib())) + | Some "ldconf" -> +- print_endline (Findlib.ocaml_ldconf()) ++ print_endline ( sl (Findlib.ocaml_ldconf())) + | _ -> + assert false + ;; +@@ -2481,7 +2601,7 @@ + + let ocamlcall pkg cmd = + let dir = package_directory pkg in +- let path = Filename.concat dir cmd in ++ let path = rewrite_cmd (Filename.concat dir cmd) in + begin + try Unix.access path [ Unix.X_OK ] + with +@@ -2647,6 +2767,10 @@ + | Sys_error f -> + prerr_endline ("ocamlfind: " ^ f); + exit 2 ++ | Unix.Unix_error (e, fn, f) -> ++ prerr_endline ("ocamlfind: " ^ fn ^ " " ^ f ++ ^ ": " ^ Unix.error_message e); ++ exit 2 + | Findlib.No_such_package(pkg,info) -> + prerr_endline ("ocamlfind: Package `" ^ pkg ^ "' not found" ^ + (if info <> "" then " - " ^ info else "")); +--- ./src/findlib/Makefile ++++ ./src/findlib/Makefile +@@ -90,6 +90,7 @@ + cat findlib_config.mlp | \ + $(SH) $(TOP)/tools/patch '@CONFIGFILE@' '$(OCAMLFIND_CONF)' | \ + $(SH) $(TOP)/tools/patch '@STDLIB@' '$(OCAML_CORE_STDLIB)' | \ ++ $(SH) $(TOP)/tools/patch '@EXEC_SUFFIX@' '$(EXEC_SUFFIX)' | \ + sed -e 's;@AUTOLINK@;$(OCAML_AUTOLINK);g' \ + -e 's;@SYSTEM@;$(SYSTEM);g' \ + >findlib_config.ml diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh new file mode 100644 index 000000000..c923ef49e --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/ocaml-migrate-parsetree.esy.lock/overrides/opam__s__ocamlfind_secondary_opam__c__1.8.1_opam_override/files/gen-findlib-conf.sh @@ -0,0 +1,14 @@ +OCAML_SECONDARY_COMPILER=$1 + +cat >ocaml-secondary-compiler.conf <META < T2 (label = "") + ~l:T1 -> T2 (label = "l") + ?l:T1 -> T2 (label = "?l") + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of (string * attributes * core_type) list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string list * core_type + (* 'a1 ... 'an. T + + Can only appear in the following context: + + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of label * expression option * pattern * expression + (* fun P -> E1 (lab = "", None) + fun ~l:P -> E1 (lab = "l", None) + fun ?l:P -> E1 (lab = "?l", None) + fun ?l:(P = E0) -> E1 (lab = "?l", Some E0) + + Notes: + - If E0 is provided, lab must start with '?'. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * string + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of string loc * expression + (* x <- 2 *) + | Pexp_override of (string loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string loc * module_expr * expression + (* let module M = ME 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* let open M in E + let! open M in E + *) + | Pexp_extension of extension + (* [%id] *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + + Note: when used under Pstr_primitive, prim cannot be empty + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty 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 [@id1] [@id2] : T *) + } + + (* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_args: core_type list; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) + } + (* + | C of T1 * ... * Tn (res = None) + | C: T0 (args = [], res = Some T0) + | C: T1 * ... * Tn -> T0 (res = Some T0) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 [@id1] [@id2] of ... *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of core_type list * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {2 Class language} *) + + (* 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 label * core_type * class_type + (* T -> CT (label = "") + ~l:T -> CT (label = "l") + ?l:T -> CT (label = "?l") + *) + | Pcty_extension of extension + (* [%id] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (* object('selfpat) ... end + object ... end (self = 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 (string * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (string * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of label * expression option * pattern * class_expr + (* fun P -> CE (lab = "", None) + fun ~l:P -> CE (lab = "l", None) + fun ?l:P -> CE (lab = "?l", None) + fun ?l:(P = E0) -> CE (lab = "?l", Some E0) + *) + | Pcl_apply of class_expr * (label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (string loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (string loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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 + + (** {2 Module language} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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 type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Psig_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_typesubst of type_declaration + (* with type t := ... *) + | Pwith_modsubst of string loc * Longident.t loc + (* with module X := Z *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = Recursive) + *) + | Pstr_primitive of value_description + (* external x: T = "s1" ... "sn" *) + | Pstr_type of type_declaration list + (* type t1 = ... and ... and tn = ... *) + | Pstr_typext of type_extension + (* type t1 += ... *) + | Pstr_exception of extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {2 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of int + | Pdir_ident of Longident.t + | Pdir_bool of bool +end + +module Docstrings : sig + (** {3 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {3 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Asttypes in + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Asttypes in + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + (** Helpers to produce Parsetree fragments *) + + open Parsetree + open Asttypes + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {2 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {2 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> + (string * attributes * core_type) list -> closed_flag -> + core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern + -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:core_type list -> ?res:core_type -> str -> constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:core_type list -> ?res:core_type -> str -> extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {2 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (* Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (* Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {2 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc a = mk ?loc (Psig_type a) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc a = mk ?loc (Pstr_type a) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) ?(args = []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {2 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {2 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(List.map (sub.typ sub) ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type l -> type_ ~loc (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type l -> type_ ~loc (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(List.map (this.typ this) pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Asttypes.Const_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Asttypes.Const_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_name of out_ident * out_type list + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of string * out_type * string list + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status*) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M016" + let ast_intf_magic_number = "Caml1999N015" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_403.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_403.ml new file mode 100644 index 000000000..800c36187 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_403.ml @@ -0,0 +1,2950 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Location = Location +module Longident = Longident + +module Asttypes = struct + (* Auxiliary a.s.t. types used by parsetree and typedtree. *) + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + (** Abstract syntax tree produced by parsing *) + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {2 Extension points} *) + + type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {2 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Otional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of (string * attributes * core_type) list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string list * core_type + (* 'a1 ... 'an. T + + Can only appear in the following context: + + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * string + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of string loc * expression + (* x <- 2 *) + | Pexp_override of (string loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string loc * module_expr * expression + (* let module M = ME 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* let open M in E + let! open M in E + *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty 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 [@id1] [@id2] : T *) + } + + (* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) + } + + and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + + (* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 [@id1] [@id2] of ... *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {2 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (* object('selfpat) ... end + object ... end (self = 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 (string * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (string * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (string loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (string loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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 + + (** {2 Module language} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_typesubst of type_declaration + (* with type t := ... *) + | Pwith_modsubst of string loc * Longident.t loc + (* with module X := Z *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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 extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {2 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool +end + +module Docstrings : sig + (** {3 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {3 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Docstrings + open Parsetree + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {2 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {2 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {2 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> + (string * attributes * core_type) list -> closed_flag -> + core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {2 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (* Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (* Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {2 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + string option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {2 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {2 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_name of out_ident * out_type list + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M019" + let ast_intf_magic_number = "Caml1999N018" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_404.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_404.ml new file mode 100644 index 000000000..21874d11b --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_404.ml @@ -0,0 +1,2968 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Location = Location +module Longident = Longident + +module Asttypes = struct + (** Auxiliary AST types used by parsetree and typedtree. *) + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + (** Abstract syntax tree produced by parsing *) + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {2 Extension points} *) + + type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {2 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Otional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of (string * attributes * core_type) list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) + *) + | Ptyp_poly of string list * core_type + (* 'a1 ... 'an. T + + Can only appear in the following context: + + - As the core_type of a Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * string + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of string loc * expression + (* x <- 2 *) + | Pexp_override of (string loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* let open M in E + let! open M in E + *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty 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 [@id1] [@id2] : T *) + } + + (* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) + } + + and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + + (* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 [@id1] [@id2] of ... *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {2 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (* object('selfpat) ... end + object ... end (self = 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 (string * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (string * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 option + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (string loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (string loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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 + + (** {2 Module language} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_typesubst of type_declaration + (* with type t := ... *) + | Pwith_modsubst of string loc * Longident.t loc + (* with module X := Z *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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 extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {2 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool +end + +module Docstrings : sig + (** {3 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {3 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Docstrings + open Parsetree + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {2 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {2 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {2 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> + (string * attributes * core_type) list -> closed_flag -> + core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {2 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {2 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + string option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {2 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {2 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_name of out_ident * out_type list + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M020" + let ast_intf_magic_number = "Caml1999N018" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_405.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_405.ml new file mode 100644 index 000000000..de350f163 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_405.ml @@ -0,0 +1,3041 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Location = Location +module Longident = Longident + +module Asttypes = struct + (** Auxiliary AST types used by parsetree and typedtree. *) + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + (** Abstract syntax tree produced by parsing *) + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {2 Extension points} *) + + type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {2 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Otional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of (string loc * attributes * core_type) list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | Pexp_send of expression * string loc + (* E # m *) + | Pexp_new of Longident.t loc + (* new M.c *) + | Pexp_setinstvar of string loc * expression + (* x <- 2 *) + | Pexp_override of (string loc * expression) list + (* {< x1 = E1; ...; Xn = En >} *) + | Pexp_letmodule of string 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty 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 [@id1] [@id2] : T *) + } + + (* { ...; l: T; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + pcd_args: constructor_arguments; + pcd_res: core_type option; + pcd_loc: Location.t; + pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) + } + + and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = + | Pcstr_tuple of core_type list + | Pcstr_record of label_declaration list + + (* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 [@id1] [@id2] of ... *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {2 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + + and class_signature (*IF_CURRENT = Parsetree.class_signature *) = + { + pcsig_self: core_type; + pcsig_fields: class_type_field list; + } + (* object('selfpat) ... end + object ... end (self = 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 (string loc * mutable_flag * virtual_flag * core_type) + (* val x: T *) + | Pctf_method of (string loc * private_flag * virtual_flag * core_type) + (* method x: T + + Note: T can be a 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (string loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (string loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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 + + (** {2 Module language} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_typesubst of type_declaration + (* with type t := ... *) + | Pwith_modsubst of string loc * Longident.t loc + (* with module X := Z *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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 extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {2 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + +end + +module Docstrings : sig + (** {3 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {3 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Docstrings + open Parsetree + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {2 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {2 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {2 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> + (str * attributes * core_type) list -> closed_flag -> + core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {2 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {2 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s; _ }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object + (List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field = + function + | Rtag(label,attrs,flag,lst) -> + Rtag(label,attrs,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {2 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {2 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = + (map_loc sub s, sub.attributes sub a, sub.typ sub t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M020" + let ast_intf_magic_number = "Caml1999N018" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_406.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_406.ml new file mode 100644 index 000000000..245808474 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_406.ml @@ -0,0 +1,3083 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* Ast ported on Mon Oct 2 11:25:57 CEST 2017 + OCaml trunk was: + commit 65940a2c6be43c42f75c6c6b255974f7e6de03ca (HEAD -> 4.06, origin/4.06) + Author: Christophe Raffalli + Date: Sun Oct 1 18:27:07 2017 +0200 + + fixed position of last optional last semicolumn in sequence (#1387) +*) + +module Location = Location +module Longident = Longident + +module Asttypes = struct + (** Auxiliary AST types used by parsetree and typedtree. *) + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + (** Abstract syntax tree produced by parsing *) + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {2 Extension points} *) + + type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {2 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label loc * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + and object_field (*IF_CURRENT = Parsetree.object_field *) = + | Otag of label loc * attributes * core_type + | Oinherit of core_type + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + and type_kind (*IF_CURRENT = Parsetree.type_kind *) = + | Ptype_abstract + | Ptype_variant of constructor_declaration list + (* Invariant: non-empty 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + + (* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {2 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + | Pcty_open of override_flag * Longident.t loc * 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + | Pcl_open of override_flag * Longident.t loc * class_expr + (* let open M in CE *) + + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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 + + (** {2 Module language} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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 extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {2 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + +end + +module Docstrings : sig + (** {3 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {3 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {3 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Docstrings + open Parsetree + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {2 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {2 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {2 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {2 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {2 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s; _ }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field = + function + | Rtag(label,attrs,flag,lst) -> + Rtag(label,attrs,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + and loop_object_field = + function + | Otag(label, attrs, t) -> + Otag(label, attrs, loop t) + | Oinherit t -> + Oinherit (loop t) + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {2 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {2 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (map_loc sub l, sub.attributes sub attrs, + b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let object_field sub = function + | Otag (l, attrs, t) -> + Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (ovf, lid, ct) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (ovf, lid, ce) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M022" + let ast_intf_magic_number = "Caml1999N022" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_407.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_407.ml new file mode 100644 index 000000000..d906f7acc --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_407.ml @@ -0,0 +1,3099 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour, Facebook *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* Ast ported on Wed Apr 18 10:33:29 BST 2018 + OCaml trunk was: + commit c0bd6a27e138911560f43dc75d5fde2ade4d6cfe (HEAD, tag: 4.07.0+beta2) + Author: Damien Doligez + Date: Tue Apr 10 14:50:48 2018 +0200 + + change VERSION for 4.07.0+beta2 +*) + +module Location = Location +module Longident = Longident + + +module Asttypes = struct + (** Auxiliary AST types used by parsetree and typedtree. *) + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + (** Abstract syntax tree produced by parsing *) + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {1 Extension points} *) + + type attribute = string loc * payload + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {1 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (module S with type t1 = T1 and ... and tn = Tn) + *) + + and row_field (*IF_CURRENT = Parsetree.row_field *) = + | Rtag of label loc * attributes * bool * core_type list + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) + + - The 2nd 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) + + - TODO: switch to a record representation, and keep location + *) + | Rinherit of core_type + (* [ T ] *) + + and object_field (*IF_CURRENT = Parsetree.object_field *) = + | Otag of label loc * attributes * core_type + | Oinherit of core_type + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of override_flag * Longident.t loc * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + (* 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; + } + + (* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + + (* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + + (* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* + 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 extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {1 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT Optional l + *) + | Pcty_extension of extension + (* [%id] *) + | Pcty_open of override_flag * Longident.t loc * 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) + *) + | Pcl_constraint of class_expr * class_type + (* (CE : CT) *) + | Pcl_extension of extension + (* [%id] *) + | Pcl_open of override_flag * Longident.t loc * class_expr + (* let open M in CE *) + + + and class_structure (*IF_CURRENT = Parsetree.class_structure *) = + { + pcstr_self: pattern; + pcstr_fields: class_field list; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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_typext of type_extension + (* type t1 += ... *) + | Psig_exception of extension_constructor + (* exception C of T *) + | Psig_module of module_declaration + (* module X : MT *) + | Psig_recmodule of module_declaration list + (* module rec X1 : MT1 and ... and Xn : MTn *) + | Psig_modtype of module_type_declaration + (* module type S = MT + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* S : MT *) + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = None) + *) + + and open_description (*IF_CURRENT = Parsetree.open_description *) = + { + popen_lid: Longident.t loc; + popen_override: override_flag; + popen_loc: Location.t; + popen_attributes: attributes; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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 extension_constructor + (* 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_description + (* 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {1 Toplevel} *) + + (* Toplevel phrases *) + + type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = + | Ptop_def of structure + | Ptop_dir of string * directive_argument + (* #use, #load ... *) + + and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = + | Pdir_none + | Pdir_string of string + | Pdir_int of string * char option + | Pdir_ident of Longident.t + | Pdir_bool of bool + +end + +module Docstrings : sig + (** {2 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + val empty_text_lazy : text Lazy.t + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + +end = struct + open Location + + (* Docstrings *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + } + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + } + in + ds + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (doc_loc, PStr [item]) + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + let empty_text_lazy = lazy [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + (text_loc, PStr [item]) + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + +end + +module Ast_helper : sig + + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Docstrings + open Parsetree + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + (** {1 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {1 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {1 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression + -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {1 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> extension_constructor -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> extension_constructor -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_description -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> lid -> open_description + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {1 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + +end = struct + (**************************************************************************) + (* *) + (* OCaml *) + (* *) + (* Alain Frisch, LexiFi *) + (* *) + (* Copyright 2012 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. *) + (* *) + (**************************************************************************) + + (** Helpers to produce Parsetree fragments *) + + open Asttypes + open Parsetree + open Docstrings + + type lid = Longident.t loc + type str = string loc + type loc = Location.t + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + let old = !default_loc in + default_loc := l; + try let r = f () in default_loc := old; r + with exn -> default_loc := old; raise exn + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (string_of_int i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s; _ }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field = + function + | Rtag(label,attrs,flag,lst) -> + Rtag(label,attrs,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + and loop_object_field = + function + | Otag(label, attrs, t) -> + Otag(label, attrs, loop t) + | Oinherit t -> + Oinherit (loop t) + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) lid = + { + popen_lid = lid; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + +end + +module Ast_mapper : sig + (** The interface of a -ppx rewriter + + A -ppx rewriter is a program that accepts a serialized abstract syntax + tree and outputs another, possibly modified, abstract syntax tree. + This module encapsulates the interface between the compiler and + the -ppx rewriters, handling such details as the serialization format, + forwarding of command-line flags, and storing state. + + {!mapper} allows to implement AST rewriting using open recursion. + A typical mapper would be based on {!default_mapper}, a deep + identity mapper, and will fall back on it for handling the syntax it + does not modify. For example: + + {[ + open Asttypes + open Parsetree + open Ast_mapper + + let test_mapper argv = + { default_mapper with + expr = fun mapper expr -> + match expr with + | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> + Ast_helper.Exp.constant (Const_int 42) + | other -> default_mapper.expr mapper other; } + + let () = + register "ppx_test" test_mapper]} + + This -ppx rewriter, which replaces [[%test]] in expressions with + the constant [42], can be compiled using + [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. + + *) + + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {1 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + +end = struct + (* A generic Parsetree mapping class *) + + (* + [@@@ocaml.warning "+9"] + (* Ensure that record patterns don't miss any field. *) + *) + + + open Parsetree + open Ast_helper + open Location + + type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (map_loc sub l, sub.attributes sub attrs, + b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + + let object_field sub = function + | Otag (l, attrs, t) -> + Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + ~loc:(sub.location sub ptype_loc) + ~attrs:(sub.attributes sub ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub.attributes sub ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub.location sub pext_loc) + ~attrs:(sub.attributes sub pext_attributes) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (ovf, lid, ct) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_description sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (ovf, lid, ce) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub.location sub pci_loc) + ~attrs:(sub.attributes sub pci_attributes) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_description = + (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(function + | x :: l -> PStr (x :: x :: l) + | l -> PStr l) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + { loc; txt = "ocaml.ppwarning" }, + PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) + + include Locations.Helpers_impl + +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of string + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of string * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) + +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M023" + let ast_intf_magic_number = "Caml1999N023" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408.ml new file mode 100644 index 000000000..719d59eda --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408.ml @@ -0,0 +1,4156 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour, Facebook *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* Ast ported on Thu Mar 21 09:50:42 GMT 2019 + OCaml was: + commit 55c9ba466362f303eb4d5ed511f6fda142879137 (HEAD -> 4.08, origin/4.08) + Author: Nicolás Ojeda Bär + Date: Tue Mar 19 08:11:02 2019 +0100 + + Merge pull request #8521 from nojb/fix_unix_tests_408 + + Actually run all lib-unix tests [4.08] +*) + +open Stdlib0 +open Ast_408_helper + +module Location = Location +module Longident = Longident + +module Asttypes = struct + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant + +end + +module Parsetree = struct + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {1 Extension points} *) + + type attribute (*IF_CURRENT = Parsetree.attribute *) = { + attr_name : string loc; + attr_payload : payload; + attr_loc : Location.t; + } + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {1 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_loc_stack: Location.t list; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and typ = core_type + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (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 + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [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 + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_loc_stack: Location.t list; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pat = pattern + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_loc_stack: Location.t list; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expr = expression + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of cases + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * cases + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * cases + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of open_declaration * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_letop of letop + (* let* P = E in E + let* P = E and* P = E in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + and cases = case list + + 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; + } + + (* 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; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + 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] *) + } + + (* exception E *) + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor: extension_constructor; + ptyexn_loc: Location.t; + ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {1 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = 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; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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 + 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 + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* 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; + } + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = 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; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + and open_description = Longident.t loc open_infos + (* open M.N + open M(N).O *) + + and open_declaration = module_expr open_infos + (* 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {1 Toplevel} *) + + (* 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 Docstrings : sig + (** (Re)Initialise all docstring state *) + val init : unit -> unit + + (** Emit warnings for unattached and ambiguous docstrings *) + val warn_bad_docstrings : unit -> unit + + (** {2 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Register a docstring *) + val register : docstring -> unit + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + + (** Docstrings immediately preceding a token *) + val set_pre_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following a token *) + val set_post_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings not immediately adjacent to a token *) + val set_floating_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following the token which precedes this one *) + val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately preceding the token which follows this one *) + val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + + (** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : unit -> docs + val symbol_docs_lazy : unit -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : int -> int -> docs + val rhs_docs_lazy : int -> int -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : unit -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : int -> int -> unit + + (** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the field info for the current symbol. *) + val symbol_info : unit -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : int -> info + + (** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + val empty_text_lazy : text Lazy.t + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the text preceding the current symbol. *) + val symbol_text : unit -> text + val symbol_text_lazy : unit -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : int -> text + val rhs_text_lazy : int -> text Lazy.t + + (** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : unit -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : unit -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : int -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : int -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : int -> text + + module WithMenhir: sig + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : Lexing.position * Lexing.position -> docs + val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : Lexing.position -> Lexing.position -> docs + val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : Lexing.position * Lexing.position -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : Lexing.position -> Lexing.position -> unit + + (** Fetch the field info for the current symbol. *) + val symbol_info : Lexing.position -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : Lexing.position -> info + + (** Fetch the text preceding the current symbol. *) + val symbol_text : Lexing.position -> text + val symbol_text_lazy : Lexing.position -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : Lexing.position -> text + val rhs_text_lazy : Lexing.position -> text Lazy.t + + (** {3 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : Lexing.position -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : Lexing.position -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : Lexing.position -> text + + end +end = struct + open Location + + (* Docstrings *) + + (* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) + type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + + (* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) + type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + + (* List of docstrings *) + + let docstrings : docstring list ref = ref [] + + (* Warn for unused and ambiguous docstrings *) + + let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) + end + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + + let register ds = + docstrings := ds :: !docstrings + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = doc_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + let empty_text_lazy = lazy [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = text_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + + (* Find the first non-info docstring in a list, attach it and return it *) + let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + + (* Find all the non-info docstrings in a list, attach them and return them *) + let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + + (* "Associate" all the docstrings in a list *) + let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + + (* Map from positions to pre docstrings *) + + let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + + let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + + (* Map from positions to post docstrings *) + + let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + + let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + + let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + + (* Map from positions to floating docstrings *) + + let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + + let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + + let get_post_text pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Maps from positions to extra docstrings *) + + let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + + let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + + let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Docstrings from parser actions *) + module WithParsing = struct + let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + + let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + + let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + + let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + + let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + + let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + + let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + + let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + + let rhs_post_text pos = + get_post_text (Parsing.rhs_end_pos pos) + + let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + + let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + + let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + + let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + + let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + end + + include WithParsing + + module WithMenhir = struct + let symbol_docs (startpos, endpos) = + { docs_pre = get_pre_docs startpos; + docs_post = get_post_docs endpos; } + + let symbol_docs_lazy (p1, p2) = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs pos1; + docs_post = get_post_docs pos2; } + + let rhs_docs_lazy p1 p2 = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs (startpos, endpos) = + mark_pre_docs startpos; + mark_post_docs endpos; + () + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs pos1; + mark_post_docs pos2; + () + + let symbol_info endpos = + get_info endpos + + let rhs_info endpos = + get_info endpos + + let symbol_text startpos = + get_text startpos + + let symbol_text_lazy startpos = + lazy (get_text startpos) + + let rhs_text pos = + get_text pos + + let rhs_post_text pos = + get_post_text pos + + let rhs_text_lazy pos = + lazy (get_text pos) + + let symbol_pre_extra_text startpos = + get_pre_extra_text startpos + + let symbol_post_extra_text endpos = + get_post_extra_text endpos + + let rhs_pre_extra_text pos = + get_pre_extra_text pos + + let rhs_post_extra_text pos = + get_post_extra_text pos + end + + (* (Re)Initialise all comment state *) + + let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table +end + +module Ast_helper : sig + open Asttypes + open Docstrings + open Parsetree + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type attrs = attribute list + + (** {1 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {1 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {1 Attributes} *) + module Attr : sig + val mk: ?loc:loc -> str -> payload -> attribute + end + + (** {1 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> cases -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> cases + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression + -> expression + val letop: ?loc:loc -> ?attrs:attrs -> binding_op + -> binding_op list -> expression -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + val binding_op: str -> pattern -> expression -> loc -> binding_op + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + extension_constructor -> type_exception + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {1 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_subst: ?loc:loc -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> type_exception -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val mod_subst: ?loc:loc -> module_substitution -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> type_exception -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_declaration -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module substitutions *) + module Ms: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> lid -> module_substitution + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> 'a -> 'a open_infos + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {1 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + + (** Row fields *) + module Rf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> bool -> core_type list -> row_field + val inherit_: ?loc:loc -> core_type -> row_field + end + + (** Object fields *) + module Of: + sig + val mk: ?loc:loc -> ?attrs:attrs -> + object_field_desc -> object_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> core_type -> object_field + val inherit_: ?loc:loc -> core_type -> object_field + end +end = struct + open Asttypes + open Parsetree + open Docstrings + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + Misc.protect_refs [Misc.R (default_loc, l)] f + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (Int.to_string i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Attr = struct + let mk ?(loc= !default_loc) name payload = + { attr_name = name; + attr_payload = payload; + attr_loc = loc } + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; + ptyp_loc = loc; + ptyp_loc_stack = []; + ptyp_attributes = attrs} + + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s; _ }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field field = + let prf_desc = match field.prf_desc with + | Rtag(label,flag,lst) -> + Rtag(label,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + in + { field with prf_desc; } + and loop_object_field field = + let pof_desc = match field.pof_desc with + | Otag(label, t) -> + Otag(label, loop t) + | Oinherit t -> + Oinherit (loop t) + in + { field with pof_desc; } + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; + ppat_loc = loc; + ppat_loc_stack = []; + ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) + let letop ?loc ?attrs let_ ands body = + mk ?loc ?attrs (Pexp_letop {let_; ands; body}) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + + let binding_op op pat exp loc = + { + pbop_op = op; + pbop_pat = pat; + pbop_exp = exp; + pbop_loc = loc; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_subst ?loc a = mk ?loc (Psig_typesubst a) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let mod_subst ?loc a = mk ?loc (Psig_modsubst a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Ms = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name syn = + { + pms_name = name; + pms_manifest = syn; + pms_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pms_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) expr = + { + popen_expr = expr; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_loc = loc; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + constructor = + { + ptyexn_constructor = constructor; + ptyexn_loc = loc; + ptyexn_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + + (** Row fields *) + module Rf = struct + let mk ?(loc = !default_loc) ?(attrs = []) desc = { + prf_desc = desc; + prf_loc = loc; + prf_attributes = attrs; + } + let tag ?loc ?attrs label const tys = + mk ?loc ?attrs (Rtag (label, const, tys)) + let inherit_?loc ty = + mk ?loc (Rinherit ty) + end + + (** Object fields *) + module Of = struct + let mk ?(loc = !default_loc) ?(attrs=[]) desc = { + pof_desc = desc; + pof_loc = loc; + pof_attributes = attrs; + } + let tag ?loc ?attrs label ty = + mk ?loc ?attrs (Otag (label, ty)) + let inherit_ ?loc ty = + mk ?loc (Oinherit ty) + end +end + +module Ast_mapper : sig + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> cases -> cases; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {1 Apply mappers to compilation units} *) + + val tool_name: unit -> string + (** Can be used within a ppx preprocessor to know which tool is + calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], + ["ocaml"], ... Some global variables that reflect command-line + options are automatically synchronized between the calling tool + and the ppx preprocessor: {!Clflags.include_dirs}, + {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, + {!Clflags.debug}. *) + + + val apply: source:string -> target:string -> mapper -> unit + (** Apply a mapper (parametrized by the unit name) to a dumped + parsetree found in the [source] file and put the result in the + [target] file. The [structure] or [signature] field of the mapper + is applied to the implementation or interface. *) + + val run_main: (string list -> mapper) -> unit + (** Entry point to call to implement a standalone -ppx rewriter from a + mapper, parametrized by the command line arguments. The current + unit name can be obtained from {!Location.input_name}. This + function implements proper error reporting for uncaught + exceptions. *) + + (** {1 Registration API} *) + + val register_function: (string -> (string list -> mapper) -> unit) ref + + val register: string -> (string list -> mapper) -> unit + (** Apply the [register_function]. The default behavior is to run the + mapper immediately, taking arguments from the process command + line. This is to support a scenario where a mapper is linked as a + stand-alone executable. + + It is possible to overwrite the [register_function] to define + "-ppx drivers", which combine several mappers in a single process. + Typically, a driver starts by defining [register_function] to a + custom implementation, then lets ppx rewriters (linked statically + or dynamically) register themselves, and then run all or some of + them. It is also possible to have -ppx drivers apply rewriters to + only specific parts of an AST. + + The first argument to [register] is a symbolic name to be used by + the ppx driver. *) + + + (** {1 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + + (** {1 Helper functions to call external mappers} *) + + val add_ppx_context_str: + tool_name:string -> Parsetree.structure -> Parsetree.structure + (** Extract information from the current environment and encode it + into an attribute which is prepended to the list of structure + items in order to pass the information to an external + processor. *) + + val add_ppx_context_sig: + tool_name:string -> Parsetree.signature -> Parsetree.signature + (** Same as [add_ppx_context_str], but for signatures. *) + + val drop_ppx_context_str: + restore:bool -> Parsetree.structure -> Parsetree.structure + (** Drop the ocaml.ppx.context attribute from a structure. If + [restore] is true, also restore the associated data in the current + process. *) + + val drop_ppx_context_sig: + restore:bool -> Parsetree.signature -> Parsetree.signature + (** Same as [drop_ppx_context_str], but for signatures. *) + + (** {1 Cookies} *) + + (** Cookies are used to pass information from a ppx processor to + a further invocation of itself, when called from the OCaml + toplevel (or other tools that support cookies). *) + + val set_cookie: string -> Parsetree.expression -> unit + val get_cookie: string -> Parsetree.expression option +end = struct + open Parsetree + open Ast_helper + open Location + + module String = Misc.Stdlib.String + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> cases -> cases; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub { + prf_desc; + prf_loc; + prf_attributes; + } = + let loc = sub.location sub prf_loc in + let attrs = sub.attributes sub prf_attributes in + let desc = match prf_desc with + | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + in + Rf.mk ~loc ~attrs desc + + let object_field sub { + pof_desc; + pof_loc; + pof_attributes; + } = + let loc = sub.location sub pof_loc in + let attrs = sub.attributes sub pof_attributes in + let desc = match pof_desc with + | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + in + Of.mk ~loc ~attrs desc + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs; ptyp_loc_stack = _ } = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + let loc = sub.location sub ptype_loc in + let attrs = sub.attributes sub ptype_attributes in + Type.mk ~loc ~attrs (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes} = + let loc = sub.location sub ptyext_loc in + let attrs = sub.attributes sub ptyext_attributes in + Te.mk ~loc ~attrs + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + + let map_type_exception sub + {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = + let loc = sub.location sub ptyexn_loc in + let attrs = sub.attributes sub ptyexn_attributes in + Te.mk_exception ~loc ~attrs + (sub.extension_constructor sub ptyexn_constructor) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + let loc = sub.location sub pext_loc in + let attrs = sub.attributes sub pext_attributes in + Te.constructor ~loc ~attrs + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (o, ct) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> + type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typesubst l -> + type_subst ~loc (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + let attrs = sub.attributes sub attrs in + eval ~loc ~attrs (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs; pexp_loc_stack = _ } = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (o, e) -> + open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) + | Pexp_letop {let_; ands; body} -> + letop ~loc ~attrs (sub.binding_op sub let_) + (List.map (sub.binding_op sub) ands) (sub.expr sub body) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + + let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = + let open Exp in + let op = map_loc sub pbop_op in + let pat = sub.pat sub pbop_pat in + let exp = sub.expr sub pbop_exp in + let loc = sub.location sub pbop_loc in + binding_op op pat exp loc + + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs; ppat_loc_stack = _ } = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (o, ce) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + let loc = sub.location sub pci_loc in + let attrs = sub.attributes sub pci_attributes in + Ci.mk ~loc ~attrs + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + type_exception = T.map_type_exception; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + binding_op = E.map_binding_op; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_substitution = + (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> + Ms.mk + (map_loc this pms_name) + (map_loc this pms_manifest) + ~attrs:(this.attributes this pms_attributes) + ~loc:(this.location this pms_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_declaration = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (this.module_expr this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + open_description = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this a -> + { + attr_name = map_loc this a.attr_name; + attr_payload = this.payload this a.attr_payload; + attr_loc = this.location this a.attr_loc + } + ); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(fun x -> PStr x) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + Attr.mk + {loc; txt = "ocaml.ppwarning" } + (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) + + include Locations.Helpers_impl + + let cookies = ref String.Map.empty + + let get_cookie k = + try Some (String.Map.find k !cookies) + with Not_found -> None + + let set_cookie k v = + cookies := String.Map.add k v !cookies + + let tool_name_ref = ref "_none_" + + let tool_name () = !tool_name_ref + + + module PpxContext = struct + open Longident + open Asttypes + open Ast_helper + + let lid name = { txt = Lident name; loc = Location.none } + + let make_string x = Exp.constant (Pconst_string (x, None)) + + let make_bool x = + if x + then Exp.construct (lid "true") None + else Exp.construct (lid "false") None + + let rec make_list f lst = + match lst with + | x :: rest -> + Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) + | [] -> + Exp.construct (lid "[]") None + + let make_pair f1 f2 (x1, x2) = + Exp.tuple [f1 x1; f2 x2] + + let make_option f opt = + match opt with + | Some x -> Exp.construct (lid "Some") (Some (f x)) + | None -> Exp.construct (lid "None") None + + let get_cookies () = + lid "cookies", + make_list (make_pair make_string (fun x -> x)) + (String.Map.bindings !cookies) + + let mk fields = + { + attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; + attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; + attr_loc = Location.none + } + + let make ~tool_name () = + let fields = + [ + lid "tool_name", make_string tool_name; + lid "include_dirs", make_list make_string !Clflags.include_dirs; + lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); + lid "open_modules", make_list make_string !Clflags.open_modules; + lid "for_package", make_option make_string !Clflags.for_package; + lid "debug", make_bool !Clflags.debug; + lid "use_threads", make_bool !Clflags.use_threads; + lid "recursive_types", make_bool !Clflags.recursive_types; + lid "principal", make_bool !Clflags.principal; + lid "transparent_modules", make_bool !Clflags.transparent_modules; + lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); + lid "unsafe_string", make_bool !Clflags.unsafe_string; + get_cookies () + ] + in + mk fields + + let get_fields = function + | PStr [{pstr_desc = Pstr_eval + ({ pexp_desc = Pexp_record (fields, None); _ }, []); _}] -> + fields + | _ -> + raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" + + let restore fields = + let field name payload = + let rec get_string = function + | { pexp_desc = Pexp_constant (Pconst_string (str, None)); _ } -> str + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] string syntax" name + and get_bool pexp = + match pexp with + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"; _}, + None); _} -> + true + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"; _}, + None); _} -> + false + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] bool syntax" name + and get_list elem = function + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "::"; _}, + Some {pexp_desc = Pexp_tuple [exp; rest]; _}); _ } -> + elem exp :: get_list elem rest + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "[]"; _}, None); _ } -> + [] + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] list syntax" name + and get_pair f1 f2 = function + | {pexp_desc = Pexp_tuple [e1; e2]; _} -> + (f1 e1, f2 e2) + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] pair syntax" name + and get_option elem = function + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "Some"; _ }, Some exp); _ } -> + Some (elem exp) + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "None"; _ }, None); _ } -> + None + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] option syntax" name + in + match name with + | "tool_name" -> + tool_name_ref := get_string payload + | "include_dirs" -> + Clflags.include_dirs := get_list get_string payload + | "load_path" -> + Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) + | "open_modules" -> + Clflags.open_modules := get_list get_string payload + | "for_package" -> + Clflags.for_package := get_option get_string payload + | "debug" -> + Clflags.debug := get_bool payload + | "use_threads" -> + Clflags.use_threads := get_bool payload + | "recursive_types" -> + Clflags.recursive_types := get_bool payload + | "principal" -> + Clflags.principal := get_bool payload + | "transparent_modules" -> + Clflags.transparent_modules := get_bool payload + | "unboxed_types" -> + Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) + | "unsafe_string" -> + Clflags.unsafe_string := get_bool payload + | "cookies" -> + let l = get_list (get_pair get_string (fun x -> x)) payload in + cookies := + List.fold_left + (fun s (k, v) -> String.Map.add k v s) String.Map.empty + l + | _ -> + () + in + List.iter (function ({txt=Lident name; _}, x) -> field name x | _ -> ()) fields + + let update_cookies fields = + let fields = + List.filter + (function ({txt=Lident "cookies"; _}, _) -> false | _ -> true) + fields + in + fields @ [get_cookies ()] + end + + let ppx_context = PpxContext.make + + let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) + + let apply_lazy ~source ~target mapper = + let implem ast = + let fields, ast = + match ast with + | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; + attr_payload = x; _}); _} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.structure mapper ast + with exn -> + [{pstr_desc = Pstr_extension (extension_of_exn exn, []); + pstr_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Str.attribute (PpxContext.mk fields) :: ast + in + let iface ast = + let fields, ast = + match ast with + | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; + attr_payload = x; + attr_loc = _}); _} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.signature mapper ast + with exn -> + [{psig_desc = Psig_extension (extension_of_exn exn, []); + psig_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Sig.attribute (PpxContext.mk fields) :: ast + in + + let ic = open_in_bin source in + let magic = + really_input_string ic (String.length Config.ast_impl_magic_number) + in + + let rewrite transform = + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + let ast = transform ast in + let oc = open_out_bin target in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc + and fail () = + close_in ic; + failwith "Ast_mapper: OCaml version mismatch or malformed input"; + in + + if magic = Config.ast_impl_magic_number then + rewrite (implem : structure -> structure) + else if magic = Config.ast_intf_magic_number then + rewrite (iface : signature -> signature) + else fail () + + let drop_ppx_context_str ~restore = function + | {pstr_desc = Pstr_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"; _}; + attr_payload = a; + attr_loc = _}; _ } + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let drop_ppx_context_sig ~restore = function + | {psig_desc = Psig_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"; _}; + attr_payload = a; + attr_loc = _}; _ } + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let add_ppx_context_str ~tool_name ast = + Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast + + let add_ppx_context_sig ~tool_name ast = + Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast + + + let apply ~source ~target mapper = + apply_lazy ~source ~target (fun () -> mapper) + + let run_main mapper = + try + let a = Sys.argv in + let n = Array.length a in + if n > 2 then + let mapper () = + try mapper (Array.to_list (Array.sub a 1 (n - 3))) + with exn -> + (* PR#6463 *) + let f _ _ = raise exn in + {default_mapper with structure = f; signature = f} + in + apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper + else begin + Printf.eprintf "Usage: %s [extra_args] \n%!" + Sys.executable_name; + exit 2 + end + with exn -> + prerr_endline (Printexc.to_string exn); + exit 2 + + let register_function = ref (fun _name f -> run_main f) + let register name f = !register_function name f +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + (** An [out_name] is a string representation of an identifier which can be + rewritten on the fly to avoid name collisions *) + type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of out_name + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M025" + let ast_intf_magic_number = "Caml1999N025" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + binding_op = id; + module_substitution = id; + open_declaration = id; + type_exception = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + binding_op = fail; + module_substitution = fail; + open_declaration = fail; + type_exception = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408_helper.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408_helper.ml new file mode 100644 index 000000000..02763de78 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_408_helper.ml @@ -0,0 +1,24 @@ +module Misc = struct + + let find_in_path = Misc.find_in_path + let find_in_path_uncap = Misc.find_in_path_uncap + + type ref_and_value = R : 'a ref * 'a -> ref_and_value + let protect_refs = + let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in + fun refs f -> + let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in + set_refs refs; + match f () with + | x -> set_refs backup; x + | exception e -> set_refs backup; raise e + + let may_map = Stdlib0.Option.map + + module Stdlib = struct + module String = struct + include String + module Map = Map.Make (String) + end + end +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409.ml new file mode 100644 index 000000000..c1da634ce --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409.ml @@ -0,0 +1,4145 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour, Facebook *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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 Stdlib0 +open Ast_409_helper + +module Location = Location +module Longident = Longident + +module Asttypes = struct + + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant + +end + +module Parsetree = struct + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 1.4e-4 + + Suffixes [g-z][G-Z] are accepted by the parser. + Suffixes are rejected by the typechecker. + *) + + (** {1 Extension points} *) + + type attribute (*IF_CURRENT = Parsetree.attribute *) = { + attr_name : string loc; + attr_payload : payload; + attr_loc : Location.t; + } + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {1 Core language} *) + + (* Type expressions *) + + and core_type (*IF_CURRENT = Parsetree.core_type *) = + { + ptyp_desc: core_type_desc; + ptyp_loc: Location.t; + ptyp_loc_stack: Location.t list; + ptyp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and typ = core_type + + and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = + | Ptyp_any + (* _ *) + | Ptyp_var of string + (* 'a *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (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 + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [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 + + (* Patterns *) + + and pattern (*IF_CURRENT = Parsetree.pattern *) = + { + ppat_desc: pattern_desc; + ppat_loc: Location.t; + ppat_loc_stack: Location.t list; + ppat_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and pat = pattern + + and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = + | Ppat_any + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string loc + (* (module P) + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* Value expressions *) + + and expression (*IF_CURRENT = Parsetree.expression *) = + { + pexp_desc: expression_desc; + pexp_loc: Location.t; + pexp_loc_stack: Location.t list; + pexp_attributes: attributes; (* ... [@id1] [@id2] *) + } + + and expr = expression + + and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = + | Pexp_ident of Longident.t loc + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of cases + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * cases + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * cases + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of open_declaration * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_letop of letop + (* let* P = E in E + let* P = E and* P = E in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + and cases = case list + + 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; + } + + (* 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; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) + *) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) + *) + + 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) + *) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + 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] *) + } + + (* exception E *) + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor: extension_constructor; + ptyexn_loc: Location.t; + ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {1 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = 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; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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} *) + + (* 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 + (* S *) + | Pmty_signature of signature + (* sig ... end *) + | Pmty_functor of string loc * module_type option * 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 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 + 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 + 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 loc; + pmd_type: module_type; + pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) + pmd_loc: Location.t; + } + (* 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; + } + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = 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; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + and open_description = Longident.t loc open_infos + (* open M.N + open M(N).O *) + + and open_declaration = module_expr open_infos + (* 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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 string loc * module_type option * module_expr + (* functor(X : MT1) -> ME *) + | Pmod_apply of module_expr * module_expr + (* ME1(ME2) *) + | 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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {1 Toplevel} *) + + (* 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 Docstrings : sig + (** (Re)Initialise all docstring state *) + val init : unit -> unit + + (** Emit warnings for unattached and ambiguous docstrings *) + val warn_bad_docstrings : unit -> unit + + (** {2 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Register a docstring *) + val register : docstring -> unit + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + + (** Docstrings immediately preceding a token *) + val set_pre_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following a token *) + val set_post_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings not immediately adjacent to a token *) + val set_floating_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following the token which precedes this one *) + val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately preceding the token which follows this one *) + val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + + (** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : unit -> docs + val symbol_docs_lazy : unit -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : int -> int -> docs + val rhs_docs_lazy : int -> int -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : unit -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : int -> int -> unit + + (** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the field info for the current symbol. *) + val symbol_info : unit -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : int -> info + + (** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + val empty_text_lazy : text Lazy.t + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the text preceding the current symbol. *) + val symbol_text : unit -> text + val symbol_text_lazy : unit -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : int -> text + val rhs_text_lazy : int -> text Lazy.t + + (** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : unit -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : unit -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : int -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : int -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : int -> text + + module WithMenhir: sig + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : Lexing.position * Lexing.position -> docs + val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : Lexing.position -> Lexing.position -> docs + val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : Lexing.position * Lexing.position -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : Lexing.position -> Lexing.position -> unit + + (** Fetch the field info for the current symbol. *) + val symbol_info : Lexing.position -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : Lexing.position -> info + + (** Fetch the text preceding the current symbol. *) + val symbol_text : Lexing.position -> text + val symbol_text_lazy : Lexing.position -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : Lexing.position -> text + val rhs_text_lazy : Lexing.position -> text Lazy.t + + (** {3 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : Lexing.position -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : Lexing.position -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : Lexing.position -> text + + end +end = struct + open Location + + (* Docstrings *) + + (* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) + type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + + (* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) + type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + + (* List of docstrings *) + + let docstrings : docstring list ref = ref [] + + (* Warn for unused and ambiguous docstrings *) + + let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) + end + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + + let register ds = + docstrings := ds :: !docstrings + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = doc_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + let empty_text_lazy = lazy [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = text_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + + (* Find the first non-info docstring in a list, attach it and return it *) + let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + + (* Find all the non-info docstrings in a list, attach them and return them *) + let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + + (* "Associate" all the docstrings in a list *) + let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + + (* Map from positions to pre docstrings *) + + let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + + let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + + (* Map from positions to post docstrings *) + + let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + + let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + + let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + + (* Map from positions to floating docstrings *) + + let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + + let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + + let get_post_text pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Maps from positions to extra docstrings *) + + let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + + let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + + let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Docstrings from parser actions *) + module WithParsing = struct + let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + + let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + + let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + + let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + + let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + + let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + + let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + + let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + + let rhs_post_text pos = + get_post_text (Parsing.rhs_end_pos pos) + + let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + + let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + + let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + + let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + + let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + end + + include WithParsing + + module WithMenhir = struct + let symbol_docs (startpos, endpos) = + { docs_pre = get_pre_docs startpos; + docs_post = get_post_docs endpos; } + + let symbol_docs_lazy (p1, p2) = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs pos1; + docs_post = get_post_docs pos2; } + + let rhs_docs_lazy p1 p2 = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs (startpos, endpos) = + mark_pre_docs startpos; + mark_post_docs endpos; + () + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs pos1; + mark_post_docs pos2; + () + + let symbol_info endpos = + get_info endpos + + let rhs_info endpos = + get_info endpos + + let symbol_text startpos = + get_text startpos + + let symbol_text_lazy startpos = + lazy (get_text startpos) + + let rhs_text pos = + get_text pos + + let rhs_post_text pos = + get_post_text pos + + let rhs_text_lazy pos = + lazy (get_text pos) + + let symbol_pre_extra_text startpos = + get_pre_extra_text startpos + + let symbol_post_extra_text endpos = + get_post_extra_text endpos + + let rhs_pre_extra_text pos = + get_pre_extra_text pos + + let rhs_post_extra_text pos = + get_post_extra_text pos + end + + (* (Re)Initialise all comment state *) + + let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table +end + +module Ast_helper : sig + open Asttypes + open Docstrings + open Parsetree + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type attrs = attribute list + + (** {1 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {1 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {1 Attributes} *) + module Attr : sig + val mk: ?loc:loc -> str -> payload -> attribute + end + + (** {1 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> cases -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> cases + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression + -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression + -> expression + val letop: ?loc:loc -> ?attrs:attrs -> binding_op + -> binding_op list -> expression -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + val binding_op: str -> pattern -> expression -> loc -> binding_op + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + extension_constructor -> type_exception + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {1 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + str -> module_type option -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_subst: ?loc:loc -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> type_exception -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val mod_subst: ?loc:loc -> module_substitution -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> type_exception -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_declaration -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_type -> module_declaration + end + + (** Module substitutions *) + module Ms: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> lid -> module_substitution + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> 'a -> 'a open_infos + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {1 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + + (** Row fields *) + module Rf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> bool -> core_type list -> row_field + val inherit_: ?loc:loc -> core_type -> row_field + end + + (** Object fields *) + module Of: + sig + val mk: ?loc:loc -> ?attrs:attrs -> + object_field_desc -> object_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> core_type -> object_field + val inherit_: ?loc:loc -> core_type -> object_field + end +end = struct + open Asttypes + open Parsetree + open Docstrings + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + Misc.protect_refs [Misc.R (default_loc, l)] f + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (Int.to_string i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Attr = struct + let mk ?(loc= !default_loc) name payload = + { attr_name = name; + attr_payload = payload; + attr_loc = loc } + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; + ptyp_loc = loc; + ptyp_loc_stack = []; + ptyp_attributes = attrs} + + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s; _ }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field field = + let prf_desc = match field.prf_desc with + | Rtag(label,flag,lst) -> + Rtag(label,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + in + { field with prf_desc; } + and loop_object_field field = + let pof_desc = match field.pof_desc with + | Otag(label, t) -> + Otag(label, loop t) + | Oinherit t -> + Oinherit (loop t) + in + { field with pof_desc; } + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; + ppat_loc = loc; + ppat_loc_stack = []; + ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) + let letop ?loc ?attrs let_ ands body = + mk ?loc ?attrs (Pexp_letop {let_; ands; body}) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + + let binding_op op pat exp loc = + { + pbop_op = op; + pbop_pat = pat; + pbop_exp = exp; + pbop_loc = loc; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg arg_ty body = + mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_subst ?loc a = mk ?loc (Psig_typesubst a) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let mod_subst ?loc a = mk ?loc (Psig_modsubst a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Ms = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name syn = + { + pms_name = name; + pms_manifest = syn; + pms_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pms_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) expr = + { + popen_expr = expr; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_loc = loc; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + constructor = + { + ptyexn_constructor = constructor; + ptyexn_loc = loc; + ptyexn_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + + (** Row fields *) + module Rf = struct + let mk ?(loc = !default_loc) ?(attrs = []) desc = { + prf_desc = desc; + prf_loc = loc; + prf_attributes = attrs; + } + let tag ?loc ?attrs label const tys = + mk ?loc ?attrs (Rtag (label, const, tys)) + let inherit_?loc ty = + mk ?loc (Rinherit ty) + end + + (** Object fields *) + module Of = struct + let mk ?(loc = !default_loc) ?(attrs=[]) desc = { + pof_desc = desc; + pof_loc = loc; + pof_attributes = attrs; + } + let tag ?loc ?attrs label ty = + mk ?loc ?attrs (Otag (label, ty)) + let inherit_ ?loc ty = + mk ?loc (Oinherit ty) + end +end + +module Ast_mapper : sig + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> cases -> cases; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {1 Apply mappers to compilation units} *) + + val tool_name: unit -> string + (** Can be used within a ppx preprocessor to know which tool is + calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], + ["ocaml"], ... Some global variables that reflect command-line + options are automatically synchronized between the calling tool + and the ppx preprocessor: {!Clflags.include_dirs}, + {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, + {!Clflags.debug}. *) + + + val apply: source:string -> target:string -> mapper -> unit + (** Apply a mapper (parametrized by the unit name) to a dumped + parsetree found in the [source] file and put the result in the + [target] file. The [structure] or [signature] field of the mapper + is applied to the implementation or interface. *) + + val run_main: (string list -> mapper) -> unit + (** Entry point to call to implement a standalone -ppx rewriter from a + mapper, parametrized by the command line arguments. The current + unit name can be obtained from {!Location.input_name}. This + function implements proper error reporting for uncaught + exceptions. *) + + (** {1 Registration API} *) + + val register_function: (string -> (string list -> mapper) -> unit) ref + + val register: string -> (string list -> mapper) -> unit + (** Apply the [register_function]. The default behavior is to run the + mapper immediately, taking arguments from the process command + line. This is to support a scenario where a mapper is linked as a + stand-alone executable. + + It is possible to overwrite the [register_function] to define + "-ppx drivers", which combine several mappers in a single process. + Typically, a driver starts by defining [register_function] to a + custom implementation, then lets ppx rewriters (linked statically + or dynamically) register themselves, and then run all or some of + them. It is also possible to have -ppx drivers apply rewriters to + only specific parts of an AST. + + The first argument to [register] is a symbolic name to be used by + the ppx driver. *) + + + (** {1 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + + (** {1 Helper functions to call external mappers} *) + + val add_ppx_context_str: + tool_name:string -> Parsetree.structure -> Parsetree.structure + (** Extract information from the current environment and encode it + into an attribute which is prepended to the list of structure + items in order to pass the information to an external + processor. *) + + val add_ppx_context_sig: + tool_name:string -> Parsetree.signature -> Parsetree.signature + (** Same as [add_ppx_context_str], but for signatures. *) + + val drop_ppx_context_str: + restore:bool -> Parsetree.structure -> Parsetree.structure + (** Drop the ocaml.ppx.context attribute from a structure. If + [restore] is true, also restore the associated data in the current + process. *) + + val drop_ppx_context_sig: + restore:bool -> Parsetree.signature -> Parsetree.signature + (** Same as [drop_ppx_context_str], but for signatures. *) + + (** {1 Cookies} *) + + (** Cookies are used to pass information from a ppx processor to + a further invocation of itself, when called from the OCaml + toplevel (or other tools that support cookies). *) + + val set_cookie: string -> Parsetree.expression -> unit + val get_cookie: string -> Parsetree.expression option +end = struct + open Parsetree + open Ast_helper + open Location + + module String = Misc.Stdlib.String + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> cases -> cases; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub { + prf_desc; + prf_loc; + prf_attributes; + } = + let loc = sub.location sub prf_loc in + let attrs = sub.attributes sub prf_attributes in + let desc = match prf_desc with + | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + in + Rf.mk ~loc ~attrs desc + + let object_field sub { + pof_desc; + pof_loc; + pof_attributes; + } = + let loc = sub.location sub pof_loc in + let attrs = sub.attributes sub pof_attributes in + let desc = match pof_desc with + | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + in + Of.mk ~loc ~attrs desc + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs; ptyp_loc_stack = _ } = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + let loc = sub.location sub ptype_loc in + let attrs = sub.attributes sub ptype_attributes in + Type.mk ~loc ~attrs (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes} = + let loc = sub.location sub ptyext_loc in + let attrs = sub.attributes sub ptyext_attributes in + Te.mk ~loc ~attrs + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + + let map_type_exception sub + {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = + let loc = sub.location sub ptyexn_loc in + let attrs = sub.attributes sub ptyexn_attributes in + Te.mk_exception ~loc ~attrs + (sub.extension_constructor sub ptyexn_constructor) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + let loc = sub.location sub pext_loc in + let attrs = sub.attributes sub pext_attributes in + Te.constructor ~loc ~attrs + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (o, ct) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) + (sub.module_type sub mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> + type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typesubst l -> + type_subst ~loc (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + let attrs = sub.attributes sub attrs in + eval ~loc ~attrs (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs; pexp_loc_stack = _ } = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (o, e) -> + open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) + | Pexp_letop {let_; ands; body} -> + letop ~loc ~attrs (sub.binding_op sub let_) + (List.map (sub.binding_op sub) ands) (sub.expr sub body) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + + let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = + let open Exp in + let op = map_loc sub pbop_op in + let pat = sub.pat sub pbop_pat in + let exp = sub.expr sub pbop_exp in + let loc = sub.location sub pbop_loc in + binding_op op pat exp loc + + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs; ppat_loc_stack = _ } = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (o, ce) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + let loc = sub.location sub pci_loc in + let attrs = sub.attributes sub pci_attributes in + Ci.mk ~loc ~attrs + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + type_exception = T.map_type_exception; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + binding_op = E.map_binding_op; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_substitution = + (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> + Ms.mk + (map_loc this pms_name) + (map_loc this pms_manifest) + ~attrs:(this.attributes this pms_attributes) + ~loc:(this.location this pms_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_declaration = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (this.module_expr this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + open_description = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this a -> + { + attr_name = map_loc this a.attr_name; + attr_payload = this.payload this a.attr_payload; + attr_loc = this.location this a.attr_loc + } + ); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(fun x -> PStr x) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + Attr.mk + {loc; txt = "ocaml.ppwarning" } + (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) + + include Locations.Helpers_impl + + let cookies = ref String.Map.empty + + let get_cookie k = + try Some (String.Map.find k !cookies) + with Not_found -> None + + let set_cookie k v = + cookies := String.Map.add k v !cookies + + let tool_name_ref = ref "_none_" + + let tool_name () = !tool_name_ref + + + module PpxContext = struct + open Longident + open Asttypes + open Ast_helper + + let lid name = { txt = Lident name; loc = Location.none } + + let make_string x = Exp.constant (Pconst_string (x, None)) + + let make_bool x = + if x + then Exp.construct (lid "true") None + else Exp.construct (lid "false") None + + let rec make_list f lst = + match lst with + | x :: rest -> + Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) + | [] -> + Exp.construct (lid "[]") None + + let make_pair f1 f2 (x1, x2) = + Exp.tuple [f1 x1; f2 x2] + + let make_option f opt = + match opt with + | Some x -> Exp.construct (lid "Some") (Some (f x)) + | None -> Exp.construct (lid "None") None + + let get_cookies () = + lid "cookies", + make_list (make_pair make_string (fun x -> x)) + (String.Map.bindings !cookies) + + let mk fields = + { + attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; + attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; + attr_loc = Location.none + } + + let make ~tool_name () = + let fields = + [ + lid "tool_name", make_string tool_name; + lid "include_dirs", make_list make_string !Clflags.include_dirs; + lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); + lid "open_modules", make_list make_string !Clflags.open_modules; + lid "for_package", make_option make_string !Clflags.for_package; + lid "debug", make_bool !Clflags.debug; + lid "use_threads", make_bool !Clflags.use_threads; + lid "recursive_types", make_bool !Clflags.recursive_types; + lid "principal", make_bool !Clflags.principal; + lid "transparent_modules", make_bool !Clflags.transparent_modules; + lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); + lid "unsafe_string", make_bool !Clflags.unsafe_string; + get_cookies () + ] + in + mk fields + + let get_fields = function + | PStr [{pstr_desc = Pstr_eval + ({ pexp_desc = Pexp_record (fields, None); _ }, []); _}] -> + fields + | _ -> + raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" + + let restore fields = + let field name payload = + let rec get_string = function + | { pexp_desc = Pexp_constant (Pconst_string (str, None)); _ } -> str + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] string syntax" name + and get_bool pexp = + match pexp with + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"; _}, + None); _} -> + true + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"; _}, + None); _} -> + false + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] bool syntax" name + and get_list elem = function + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "::"; _}, + Some {pexp_desc = Pexp_tuple [exp; rest]; _}); _ } -> + elem exp :: get_list elem rest + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "[]"; _}, None); _ } -> + [] + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] list syntax" name + and get_pair f1 f2 = function + | {pexp_desc = Pexp_tuple [e1; e2]; _} -> + (f1 e1, f2 e2) + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] pair syntax" name + and get_option elem = function + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "Some"; _ }, Some exp); _ } -> + Some (elem exp) + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "None"; _ }, None); _ } -> + None + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] option syntax" name + in + match name with + | "tool_name" -> + tool_name_ref := get_string payload + | "include_dirs" -> + Clflags.include_dirs := get_list get_string payload + | "load_path" -> + Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) + | "open_modules" -> + Clflags.open_modules := get_list get_string payload + | "for_package" -> + Clflags.for_package := get_option get_string payload + | "debug" -> + Clflags.debug := get_bool payload + | "use_threads" -> + Clflags.use_threads := get_bool payload + | "recursive_types" -> + Clflags.recursive_types := get_bool payload + | "principal" -> + Clflags.principal := get_bool payload + | "transparent_modules" -> + Clflags.transparent_modules := get_bool payload + | "unboxed_types" -> + Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) + | "unsafe_string" -> + Clflags.unsafe_string := get_bool payload + | "cookies" -> + let l = get_list (get_pair get_string (fun x -> x)) payload in + cookies := + List.fold_left + (fun s (k, v) -> String.Map.add k v s) String.Map.empty + l + | _ -> + () + in + List.iter (function ({txt=Lident name; _}, x) -> field name x | _ -> ()) fields + + let update_cookies fields = + let fields = + List.filter + (function ({txt=Lident "cookies"; _}, _) -> false | _ -> true) + fields + in + fields @ [get_cookies ()] + end + + let ppx_context = PpxContext.make + + let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) + + let apply_lazy ~source ~target mapper = + let implem ast = + let fields, ast = + match ast with + | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; + attr_payload = x; _}); _} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.structure mapper ast + with exn -> + [{pstr_desc = Pstr_extension (extension_of_exn exn, []); + pstr_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Str.attribute (PpxContext.mk fields) :: ast + in + let iface ast = + let fields, ast = + match ast with + | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; + attr_payload = x; + attr_loc = _}); _} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.signature mapper ast + with exn -> + [{psig_desc = Psig_extension (extension_of_exn exn, []); + psig_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Sig.attribute (PpxContext.mk fields) :: ast + in + + let ic = open_in_bin source in + let magic = + really_input_string ic (String.length Config.ast_impl_magic_number) + in + + let rewrite transform = + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + let ast = transform ast in + let oc = open_out_bin target in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc + and fail () = + close_in ic; + failwith "Ast_mapper: OCaml version mismatch or malformed input"; + in + + if magic = Config.ast_impl_magic_number then + rewrite (implem : structure -> structure) + else if magic = Config.ast_intf_magic_number then + rewrite (iface : signature -> signature) + else fail () + + let drop_ppx_context_str ~restore = function + | {pstr_desc = Pstr_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"; _}; + attr_payload = a; + attr_loc = _}; _ } + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let drop_ppx_context_sig ~restore = function + | {psig_desc = Psig_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"; _}; + attr_payload = a; + attr_loc = _}; _ } + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let add_ppx_context_str ~tool_name ast = + Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast + + let add_ppx_context_sig ~tool_name ast = + Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast + + + let apply ~source ~target mapper = + apply_lazy ~source ~target (fun () -> mapper) + + let run_main mapper = + try + let a = Sys.argv in + let n = Array.length a in + if n > 2 then + let mapper () = + try mapper (Array.to_list (Array.sub a 1 (n - 3))) + with exn -> + (* PR#6463 *) + let f _ _ = raise exn in + {default_mapper with structure = f; signature = f} + in + apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper + else begin + Printf.eprintf "Usage: %s [extra_args] \n%!" + Sys.executable_name; + exit 2 + end + with exn -> + prerr_endline (Printexc.to_string exn); + exit 2 + + let register_function = ref (fun _name f -> run_main f) + let register name f = !register_function name f +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + (** An [out_name] is a string representation of an identifier which can be + rewritten on the fly to avoid name collisions *) + type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of out_name + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of string * out_module_type option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: bool; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M026" + let ast_intf_magic_number = "Caml1999N026" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + binding_op = id; + module_substitution = id; + open_declaration = id; + type_exception = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + binding_op = fail; + module_substitution = fail; + open_declaration = fail; + type_exception = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409_helper.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409_helper.ml new file mode 100644 index 000000000..02763de78 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_409_helper.ml @@ -0,0 +1,24 @@ +module Misc = struct + + let find_in_path = Misc.find_in_path + let find_in_path_uncap = Misc.find_in_path_uncap + + type ref_and_value = R : 'a ref * 'a -> ref_and_value + let protect_refs = + let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in + fun refs f -> + let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in + set_refs refs; + match f () with + | x -> set_refs backup; x + | exception e -> set_refs backup; raise e + + let may_map = Stdlib0.Option.map + + module Stdlib = struct + module String = struct + include String + module Map = Map.Make (String) + end + end +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_410.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_410.ml new file mode 100644 index 000000000..91b3fde62 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_410.ml @@ -0,0 +1,4166 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour, Facebook *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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 Stdlib0 +open Ast_409_helper + +module Location = Location +module Longident = Longident + +[@@@warning "-9"] + +module Asttypes = struct + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * 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 + | Invariant +end + +module Parsetree = struct + + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * string option + (* "constant" + {delim|other constant|delim} + *) + | Pconst_float of string * char option + (* 3.4 2e5 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; + } + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {1 Core language} *) + + (* 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 *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (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 + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [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 + + (* 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 + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string option loc + (* (module P) Some "P" + (module _) None + + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* 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 + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of open_declaration * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_letop of letop + (* let* P = E in E + let* P = E and* P = E in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + 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; + } + + (* 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; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) +*) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) +*) + + 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) +*) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + 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] *) + } + + (* exception E *) + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor: extension_constructor; + ptyexn_loc: Location.t; + ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {1 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = 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; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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} *) + + (* 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 + (* 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 + (* (X : MT) Some X, MT + (_ : MT) None, MT *) + + 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 + 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 + 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; + } + (* 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; + } + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = 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; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + and open_description = Longident.t loc open_infos + (* open M.N + open M(N).O *) + + and open_declaration = module_expr open_infos + (* 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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_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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string option loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {1 Toplevel} *) + + (* 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 Docstrings : sig + (** (Re)Initialise all docstring state *) + val init : unit -> unit + + (** Emit warnings for unattached and ambiguous docstrings *) + val warn_bad_docstrings : unit -> unit + + (** {2 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Register a docstring *) + val register : docstring -> unit + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + + (** Docstrings immediately preceding a token *) + val set_pre_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following a token *) + val set_post_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings not immediately adjacent to a token *) + val set_floating_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following the token which precedes this one *) + val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately preceding the token which follows this one *) + val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + + (** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : unit -> docs + val symbol_docs_lazy : unit -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : int -> int -> docs + val rhs_docs_lazy : int -> int -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : unit -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : int -> int -> unit + + (** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the field info for the current symbol. *) + val symbol_info : unit -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : int -> info + + (** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + val empty_text_lazy : text Lazy.t + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the text preceding the current symbol. *) + val symbol_text : unit -> text + val symbol_text_lazy : unit -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : int -> text + val rhs_text_lazy : int -> text Lazy.t + + (** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : unit -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : unit -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : int -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : int -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : int -> text + + module WithMenhir: sig + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : Lexing.position * Lexing.position -> docs + val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : Lexing.position -> Lexing.position -> docs + val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : Lexing.position * Lexing.position -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : Lexing.position -> Lexing.position -> unit + + (** Fetch the field info for the current symbol. *) + val symbol_info : Lexing.position -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : Lexing.position -> info + + (** Fetch the text preceding the current symbol. *) + val symbol_text : Lexing.position -> text + val symbol_text_lazy : Lexing.position -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : Lexing.position -> text + val rhs_text_lazy : Lexing.position -> text Lazy.t + + (** {3 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : Lexing.position -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : Lexing.position -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : Lexing.position -> text + + end +end = struct + open Location + + (* Docstrings *) + + (* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) + type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + + (* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) + type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + + (* List of docstrings *) + + let docstrings : docstring list ref = ref [] + + (* Warn for unused and ambiguous docstrings *) + + let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) + end + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + + let register ds = + docstrings := ds :: !docstrings + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = doc_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + let empty_text_lazy = lazy [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = text_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + + (* Find the first non-info docstring in a list, attach it and return it *) + let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + + (* Find all the non-info docstrings in a list, attach them and return them *) + let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + + (* "Associate" all the docstrings in a list *) + let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + + (* Map from positions to pre docstrings *) + + let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + + let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + + (* Map from positions to post docstrings *) + + let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + + let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + + let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + + (* Map from positions to floating docstrings *) + + let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + + let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + + let get_post_text pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Maps from positions to extra docstrings *) + + let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + + let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + + let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Docstrings from parser actions *) + module WithParsing = struct + let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + + let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + + let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + + let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + + let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + + let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + + let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + + let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + + let rhs_post_text pos = + get_post_text (Parsing.rhs_end_pos pos) + + let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + + let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + + let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + + let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + + let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + end + + include WithParsing + + module WithMenhir = struct + let symbol_docs (startpos, endpos) = + { docs_pre = get_pre_docs startpos; + docs_post = get_post_docs endpos; } + + let symbol_docs_lazy (p1, p2) = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs pos1; + docs_post = get_post_docs pos2; } + + let rhs_docs_lazy p1 p2 = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs (startpos, endpos) = + mark_pre_docs startpos; + mark_post_docs endpos; + () + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs pos1; + mark_post_docs pos2; + () + + let symbol_info endpos = + get_info endpos + + let rhs_info endpos = + get_info endpos + + let symbol_text startpos = + get_text startpos + + let symbol_text_lazy startpos = + lazy (get_text startpos) + + let rhs_text pos = + get_text pos + + let rhs_post_text pos = + get_post_text pos + + let rhs_text_lazy pos = + lazy (get_text pos) + + let symbol_pre_extra_text startpos = + get_pre_extra_text startpos + + let symbol_post_extra_text endpos = + get_post_extra_text endpos + + let rhs_pre_extra_text pos = + get_pre_extra_text pos + + let rhs_post_extra_text pos = + get_post_extra_text pos + end + + (* (Re)Initialise all comment state *) + + let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table +end + +module Ast_helper : sig + open Asttypes + open Docstrings + open Parsetree + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type str_opt = string option with_loc + type attrs = attribute list + + (** {1 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {1 Constants} *) + + module Const : sig + val char : char -> constant + val string : ?quotation_delimiter:string -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {1 Attributes} *) + module Attr : sig + val mk: ?loc:loc -> str -> payload -> attribute + end + + (** {1 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr + -> expression -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression + -> expression + val letop: ?loc:loc -> ?attrs:attrs -> binding_op + -> binding_op list -> expression -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + val binding_op: str -> pattern -> expression -> loc -> binding_op + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + extension_constructor -> type_exception + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {1 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + functor_parameter -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + functor_parameter -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_subst: ?loc:loc -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> type_exception -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val mod_subst: ?loc:loc -> module_substitution -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> type_exception -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_declaration -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str_opt -> module_type -> module_declaration + end + + (** Module substitutions *) + module Ms: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> lid -> module_substitution + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str_opt -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> 'a -> 'a open_infos + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {1 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + + (** Row fields *) + module Rf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> bool -> core_type list -> row_field + val inherit_: ?loc:loc -> core_type -> row_field + end + + (** Object fields *) + module Of: + sig + val mk: ?loc:loc -> ?attrs:attrs -> + object_field_desc -> object_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> core_type -> object_field + val inherit_: ?loc:loc -> core_type -> object_field + end + +end = struct + open Asttypes + open Parsetree + open Docstrings + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type str_opt = string option with_loc + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + Misc.protect_refs [Misc.R (default_loc, l)] f + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (Int.to_string i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) + end + + module Attr = struct + let mk ?(loc= !default_loc) name payload = + { attr_name = name; + attr_payload = payload; + attr_loc = loc } + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; + ptyp_loc = loc; + ptyp_loc_stack = []; + ptyp_attributes = attrs} + + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field field = + let prf_desc = match field.prf_desc with + | Rtag(label,flag,lst) -> + Rtag(label,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + in + { field with prf_desc; } + and loop_object_field field = + let pof_desc = match field.pof_desc with + | Otag(label, t) -> + Otag(label, loop t) + | Oinherit t -> + Oinherit (loop t) + in + { field with pof_desc; } + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; + ppat_loc = loc; + ppat_loc_stack = []; + ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) + let letop ?loc ?attrs let_ ands body = + mk ?loc ?attrs (Pexp_letop {let_; ands; body}) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + + let binding_op op pat exp loc = + { + pbop_op = op; + pbop_pat = pat; + pbop_exp = exp; + pbop_loc = loc; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg body = + mk ?loc ?attrs (Pmod_functor (arg, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_subst ?loc a = mk ?loc (Psig_typesubst a) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let mod_subst ?loc a = mk ?loc (Psig_modsubst a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Ms = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name syn = + { + pms_name = name; + pms_manifest = syn; + pms_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pms_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) expr = + { + popen_expr = expr; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_loc = loc; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + constructor = + { + ptyexn_constructor = constructor; + ptyexn_loc = loc; + ptyexn_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + + (** Row fields *) + module Rf = struct + let mk ?(loc = !default_loc) ?(attrs = []) desc = { + prf_desc = desc; + prf_loc = loc; + prf_attributes = attrs; + } + let tag ?loc ?attrs label const tys = + mk ?loc ?attrs (Rtag (label, const, tys)) + let inherit_?loc ty = + mk ?loc (Rinherit ty) + end + + (** Object fields *) + module Of = struct + let mk ?(loc = !default_loc) ?(attrs=[]) desc = { + pof_desc = desc; + pof_loc = loc; + pof_attributes = attrs; + } + let tag ?loc ?attrs label ty = + mk ?loc ?attrs (Otag (label, ty)) + let inherit_ ?loc ty = + mk ?loc (Oinherit ty) + end +end + +module Ast_mapper : sig + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {1 Apply mappers to compilation units} *) + + val tool_name: unit -> string + (** Can be used within a ppx preprocessor to know which tool is + calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], + ["ocaml"], ... Some global variables that reflect command-line + options are automatically synchronized between the calling tool + and the ppx preprocessor: {!Clflags.include_dirs}, + {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, + {!Clflags.debug}. *) + + + val apply: source:string -> target:string -> mapper -> unit + (** Apply a mapper (parametrized by the unit name) to a dumped + parsetree found in the [source] file and put the result in the + [target] file. The [structure] or [signature] field of the mapper + is applied to the implementation or interface. *) + + val run_main: (string list -> mapper) -> unit + (** Entry point to call to implement a standalone -ppx rewriter from a + mapper, parametrized by the command line arguments. The current + unit name can be obtained from {!Location.input_name}. This + function implements proper error reporting for uncaught + exceptions. *) + + (** {1 Registration API} *) + + val register_function: (string -> (string list -> mapper) -> unit) ref + + val register: string -> (string list -> mapper) -> unit + (** Apply the [register_function]. The default behavior is to run the + mapper immediately, taking arguments from the process command + line. This is to support a scenario where a mapper is linked as a + stand-alone executable. + + It is possible to overwrite the [register_function] to define + "-ppx drivers", which combine several mappers in a single process. + Typically, a driver starts by defining [register_function] to a + custom implementation, then lets ppx rewriters (linked statically + or dynamically) register themselves, and then run all or some of + them. It is also possible to have -ppx drivers apply rewriters to + only specific parts of an AST. + + The first argument to [register] is a symbolic name to be used by + the ppx driver. *) + + + (** {1 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + + (** {1 Helper functions to call external mappers} *) + + val add_ppx_context_str: + tool_name:string -> Parsetree.structure -> Parsetree.structure + (** Extract information from the current environment and encode it + into an attribute which is prepended to the list of structure + items in order to pass the information to an external + processor. *) + + val add_ppx_context_sig: + tool_name:string -> Parsetree.signature -> Parsetree.signature + (** Same as [add_ppx_context_str], but for signatures. *) + + val drop_ppx_context_str: + restore:bool -> Parsetree.structure -> Parsetree.structure + (** Drop the ocaml.ppx.context attribute from a structure. If + [restore] is true, also restore the associated data in the current + process. *) + + val drop_ppx_context_sig: + restore:bool -> Parsetree.signature -> Parsetree.signature + (** Same as [drop_ppx_context_str], but for signatures. *) + + (** {1 Cookies} *) + + (** Cookies are used to pass information from a ppx processor to + a further invocation of itself, when called from the OCaml + toplevel (or other tools that support cookies). *) + + val set_cookie: string -> Parsetree.expression -> unit + val get_cookie: string -> Parsetree.expression option +end = struct + open Parsetree + open Ast_helper + open Location + + module String = Misc.Stdlib.String + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module T = struct + (* Type expressions for the core language *) + + let row_field sub { + prf_desc; + prf_loc; + prf_attributes; + } = + let loc = sub.location sub prf_loc in + let attrs = sub.attributes sub prf_attributes in + let desc = match prf_desc with + | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + in + Rf.mk ~loc ~attrs desc + + let object_field sub { + pof_desc; + pof_loc; + pof_attributes; + } = + let loc = sub.location sub pof_loc in + let attrs = sub.attributes sub pof_attributes in + let desc = match pof_desc with + | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + in + Of.mk ~loc ~attrs desc + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + let loc = sub.location sub ptype_loc in + let attrs = sub.attributes sub ptype_attributes in + Type.mk ~loc ~attrs (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes} = + let loc = sub.location sub ptyext_loc in + let attrs = sub.attributes sub ptyext_attributes in + Te.mk ~loc ~attrs + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + + let map_type_exception sub + {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = + let loc = sub.location sub ptyexn_loc in + let attrs = sub.attributes sub ptyexn_attributes in + Te.mk_exception ~loc ~attrs + (sub.extension_constructor sub ptyexn_constructor) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + let loc = sub.location sub pext_loc in + let attrs = sub.attributes sub pext_attributes in + Te.constructor ~loc ~attrs + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (o, ct) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + let map_functor_param sub = function + | Unit -> Unit + | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt) + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (param, mt) -> + functor_ ~loc ~attrs + (map_functor_param sub param) + (sub.module_type sub mt) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> + type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typesubst l -> + type_subst ~loc (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (param, body) -> + functor_ ~loc ~attrs + (map_functor_param sub param) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + let attrs = sub.attributes sub attrs in + eval ~loc ~attrs (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (o, e) -> + open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) + | Pexp_letop {let_; ands; body} -> + letop ~loc ~attrs (sub.binding_op sub let_) + (List.map (sub.binding_op sub) ands) (sub.expr sub body) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + + let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = + let open Exp in + let op = map_loc sub pbop_op in + let pat = sub.pat sub pbop_pat in + let exp = sub.expr sub pbop_exp in + let loc = sub.location sub pbop_loc in + binding_op op pat exp loc + + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (o, ce) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + let loc = sub.location sub pci_loc in + let attrs = sub.attributes sub pci_attributes in + Ci.mk ~loc ~attrs + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + type_exception = T.map_type_exception; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + binding_op = E.map_binding_op; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_substitution = + (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> + Ms.mk + (map_loc this pms_name) + (map_loc this pms_manifest) + ~attrs:(this.attributes this pms_attributes) + ~loc:(this.location this pms_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_declaration = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (this.module_expr this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + open_description = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this a -> + { + attr_name = map_loc this a.attr_name; + attr_payload = this.payload this a.attr_payload; + attr_loc = this.location this a.attr_loc + } + ); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(fun x -> PStr x) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) + error + + let attribute_of_warning loc s = + Attr.mk + {loc; txt = "ocaml.ppwarning" } + (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) + + include Locations.Helpers_impl + + let cookies = ref String.Map.empty + + let get_cookie k = + try Some (String.Map.find k !cookies) + with Not_found -> None + + let set_cookie k v = + cookies := String.Map.add k v !cookies + + let tool_name_ref = ref "_none_" + + let tool_name () = !tool_name_ref + + + module PpxContext = struct + open Longident + open Asttypes + open Ast_helper + + let lid name = { txt = Lident name; loc = Location.none } + + let make_string x = Exp.constant (Pconst_string (x, None)) + + let make_bool x = + if x + then Exp.construct (lid "true") None + else Exp.construct (lid "false") None + + let rec make_list f lst = + match lst with + | x :: rest -> + Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) + | [] -> + Exp.construct (lid "[]") None + + let make_pair f1 f2 (x1, x2) = + Exp.tuple [f1 x1; f2 x2] + + let make_option f opt = + match opt with + | Some x -> Exp.construct (lid "Some") (Some (f x)) + | None -> Exp.construct (lid "None") None + + let get_cookies () = + lid "cookies", + make_list (make_pair make_string (fun x -> x)) + (String.Map.bindings !cookies) + + let mk fields = + { + attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; + attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; + attr_loc = Location.none + } + + let make ~tool_name () = + let fields = + [ + lid "tool_name", make_string tool_name; + lid "include_dirs", make_list make_string !Clflags.include_dirs; + lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); + lid "open_modules", make_list make_string !Clflags.open_modules; + lid "for_package", make_option make_string !Clflags.for_package; + lid "debug", make_bool !Clflags.debug; + lid "use_threads", make_bool !Clflags.use_threads; + lid "use_vmthreads", make_bool false; + lid "recursive_types", make_bool !Clflags.recursive_types; + lid "principal", make_bool !Clflags.principal; + lid "transparent_modules", make_bool !Clflags.transparent_modules; + lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); + lid "unsafe_string", make_bool !Clflags.unsafe_string; + get_cookies () + ] + in + mk fields + + let get_fields = function + | PStr [{pstr_desc = Pstr_eval + ({ pexp_desc = Pexp_record (fields, None) }, [])}] -> + fields + | _ -> + raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" + + let restore fields = + let field name payload = + let rec get_string = function + | { pexp_desc = Pexp_constant (Pconst_string (str, None)) } -> str + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] string syntax" name + and get_bool pexp = + match pexp with + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, + None)} -> + true + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, + None)} -> + false + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] bool syntax" name + and get_list elem = function + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "::"}, + Some {pexp_desc = Pexp_tuple [exp; rest]}) } -> + elem exp :: get_list elem rest + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> + [] + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] list syntax" name + and get_pair f1 f2 = function + | {pexp_desc = Pexp_tuple [e1; e2]} -> + (f1 e1, f2 e2) + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] pair syntax" name + and get_option elem = function + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } -> + Some (elem exp) + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "None" }, None) } -> + None + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] option syntax" name + in + match name with + | "tool_name" -> + tool_name_ref := get_string payload + | "include_dirs" -> + Clflags.include_dirs := get_list get_string payload + | "load_path" -> + Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) + | "open_modules" -> + Clflags.open_modules := get_list get_string payload + | "for_package" -> + Clflags.for_package := get_option get_string payload + | "debug" -> + Clflags.debug := get_bool payload + | "use_threads" -> + Clflags.use_threads := get_bool payload + | "use_vmthreads" -> + if get_bool payload then + raise_errorf "Internal error: vmthreads not supported after 4.09.0" + | "recursive_types" -> + Clflags.recursive_types := get_bool payload + | "principal" -> + Clflags.principal := get_bool payload + | "transparent_modules" -> + Clflags.transparent_modules := get_bool payload + | "unboxed_types" -> + Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) + | "unsafe_string" -> + Clflags.unsafe_string := get_bool payload + | "cookies" -> + let l = get_list (get_pair get_string (fun x -> x)) payload in + cookies := + List.fold_left + (fun s (k, v) -> String.Map.add k v s) String.Map.empty + l + | _ -> + () + in + List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields + + let update_cookies fields = + let fields = + List.filter + (function ({txt=Lident "cookies"}, _) -> false | _ -> true) + fields + in + fields @ [get_cookies ()] + end + + let ppx_context = PpxContext.make + + let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) + + let apply_lazy ~source ~target mapper = + let implem ast = + let fields, ast = + match ast with + | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"}; + attr_payload = x})} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.structure mapper ast + with exn -> + [{pstr_desc = Pstr_extension (extension_of_exn exn, []); + pstr_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Str.attribute (PpxContext.mk fields) :: ast + in + let iface ast = + let fields, ast = + match ast with + | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"}; + attr_payload = x; + attr_loc = _})} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.signature mapper ast + with exn -> + [{psig_desc = Psig_extension (extension_of_exn exn, []); + psig_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Sig.attribute (PpxContext.mk fields) :: ast + in + + let ic = open_in_bin source in + let magic = + really_input_string ic (String.length Config.ast_impl_magic_number) + in + + let rewrite transform = + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + let ast = transform ast in + let oc = open_out_bin target in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc + and fail () = + close_in ic; + failwith "Ast_mapper: OCaml version mismatch or malformed input"; + in + + if magic = Config.ast_impl_magic_number then + rewrite (implem : structure -> structure) + else if magic = Config.ast_intf_magic_number then + rewrite (iface : signature -> signature) + else fail () + + let drop_ppx_context_str ~restore = function + | {pstr_desc = Pstr_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"}; + attr_payload = a; + attr_loc = _}} + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let drop_ppx_context_sig ~restore = function + | {psig_desc = Psig_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"}; + attr_payload = a; + attr_loc = _}} + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let add_ppx_context_str ~tool_name ast = + Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast + + let add_ppx_context_sig ~tool_name ast = + Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast + + + let apply ~source ~target mapper = + apply_lazy ~source ~target (fun () -> mapper) + + let run_main mapper = + try + let a = Sys.argv in + let n = Array.length a in + if n > 2 then + let mapper () = + try mapper (Array.to_list (Array.sub a 1 (n - 3))) + with exn -> + (* PR#6463 *) + let f _ _ = raise exn in + {default_mapper with structure = f; signature = f} + in + apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper + else begin + Printf.eprintf "Usage: %s [extra_args] \n%!" + Sys.executable_name; + exit 2 + end + with exn -> + prerr_endline (Printexc.to_string exn); + exit 2 + + let register_function = ref (fun _name f -> run_main f) + let register name f = !register_function name f +end + +module Type_immediacy = struct + type t (*IF_CURRENT = Type_immediacy.t *) = + | Unknown + | Always + | Always_on_64bits +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + (** An [out_name] is a string representation of an identifier which can be + rewritten on the fly to avoid name collisions *) + type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of out_name + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of (string option * out_module_type) option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: Type_immediacy.t; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M027" + let ast_intf_magic_number = "Caml1999N027" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + binding_op = id; + module_substitution = id; + open_declaration = id; + type_exception = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + binding_op = fail; + module_substitution = fail; + open_declaration = fail; + type_exception = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_411.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_411.ml new file mode 100644 index 000000000..b9a61380d --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/ast_411.ml @@ -0,0 +1,4185 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour, Facebook *) +(* Jérémie Dimino and Leo White, Jane Street Europe *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Alain Frisch, LexiFi *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2018 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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 Stdlib0 +open Ast_409_helper + +module Location = Location +module Longident = Longident + +[@@@warning "-9"] + +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 + | Invariant +end + +module Parsetree = struct + open Asttypes + + type constant (*IF_CURRENT = Parsetree.constant *) = + Pconst_integer of string * char option + (* 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 + (* 'c' *) + | Pconst_string of string * Location.t * string option + (* "constant" + {delim|other constant|delim} + + The location span the content of the string, without the delimiters. + *) + | Pconst_float of string * char option + (* 3.4 2e5 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; + } + (* [@id ARG] + [@@id ARG] + + Metadata containers passed around within the AST. + The compiler ignores unknown attributes. + *) + + and extension = string loc * payload + (* [%id ARG] + [%%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 *) + | PTyp of core_type (* : T *) + | PPat of pattern * expression option (* ? P or ? P when E *) + + (** {1 Core language} *) + + (* 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 *) + | Ptyp_arrow of arg_label * core_type * core_type + (* T1 -> T2 Simple + ~l:T1 -> T2 Labelled + ?l:T1 -> T2 Optional + *) + | Ptyp_tuple of core_type list + (* T1 * ... * Tn + + Invariant: n >= 2 + *) + | Ptyp_constr of Longident.t loc * core_type list + (* tconstr + T tconstr + (T1, ..., Tn) tconstr + *) + | Ptyp_object of object_field list * closed_flag + (* < l1:T1; ...; ln:Tn > (flag = Closed) + < l1:T1; ...; ln:Tn; .. > (flag = Open) + *) + | Ptyp_class of Longident.t loc * core_type list + (* #tconstr + T #tconstr + (T1, ..., Tn) #tconstr + *) + | Ptyp_alias of core_type * string + (* T as 'a *) + | Ptyp_variant of row_field list * closed_flag * label list option + (* [ `A|`B ] (flag = Closed; labels = None) + [> `A|`B ] (flag = Open; labels = None) + [< `A|`B ] (flag = Closed; labels = Some []) + [< `A|`B > `X `Y ](flag = Closed; labels = 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 Ppat_constraint node corresponding + to a constraint on a let-binding: let x : 'a1 ... 'an. T + = e ... + + - Under Cfk_virtual for methods (not values). + + - As the core_type of a Pctf_method node. + + - As the core_type of a Pexp_poly node. + + - As the pld_type field of a label_declaration. + + - As a core_type of a Ptyp_object node. + *) + + | Ptyp_package of package_type + (* (module S) *) + | Ptyp_extension of extension + (* [%id] *) + + and package_type = Longident.t loc * (Longident.t loc * core_type) list + (* + (module S) + (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 + (* [`A] ( true, [] ) + [`A of T] ( false, [T] ) + [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) + [`A of & T1 & .. & Tn] ( true, [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 + + (* 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 + (* _ *) + | Ppat_var of string loc + (* x *) + | Ppat_alias of pattern * string loc + (* P as 'a *) + | Ppat_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Ppat_interval of constant * constant + (* 'a'..'z' + + Other forms of interval are recognized by the parser + but rejected by the type-checker. *) + | Ppat_tuple of pattern list + (* (P1, ..., Pn) + + Invariant: n >= 2 + *) + | Ppat_construct of Longident.t loc * pattern option + (* C None + C P Some P + C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) + *) + | Ppat_variant of label * pattern option + (* `A (None) + `A P (Some P) + *) + | Ppat_record of (Longident.t loc * pattern) list * closed_flag + (* { l1=P1; ...; ln=Pn } (flag = Closed) + { l1=P1; ...; ln=Pn; _} (flag = Open) + + Invariant: n > 0 + *) + | Ppat_array of pattern list + (* [| P1; ...; Pn |] *) + | Ppat_or of pattern * pattern + (* P1 | P2 *) + | Ppat_constraint of pattern * core_type + (* (P : T) *) + | Ppat_type of Longident.t loc + (* #tconst *) + | Ppat_lazy of pattern + (* lazy P *) + | Ppat_unpack of string option loc + (* (module P) Some "P" + (module _) None + + Note: (module P : S) is represented as + Ppat_constraint(Ppat_unpack, Ptyp_package) + *) + | Ppat_exception of pattern + (* exception P *) + | Ppat_extension of extension + (* [%id] *) + | Ppat_open of Longident.t loc * pattern + (* M.(P) *) + + (* 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 + (* x + M.x + *) + | Pexp_constant of constant + (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) + | Pexp_let of rec_flag * value_binding list * expression + (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) + *) + | Pexp_function of case list + (* function P1 -> E1 | ... | Pn -> En *) + | Pexp_fun of arg_label * expression option * pattern * expression + (* fun P -> E1 (Simple, None) + fun ~l:P -> E1 (Labelled l, None) + fun ?l:P -> E1 (Optional l, None) + fun ?l:(P = E0) -> E1 (Optional l, Some E0) + + Notes: + - If E0 is provided, only Optional is allowed. + - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. + - "let f P = E" is represented using Pexp_fun. + *) + | Pexp_apply of expression * (arg_label * expression) list + (* E0 ~l1:E1 ... ~ln:En + li can be empty (non labeled argument) or start with '?' + (optional argument). + + Invariant: n > 0 + *) + | Pexp_match of expression * case list + (* match E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_try of expression * case list + (* try E0 with P1 -> E1 | ... | Pn -> En *) + | Pexp_tuple of expression list + (* (E1, ..., En) + + Invariant: n >= 2 + *) + | Pexp_construct of Longident.t loc * expression option + (* C None + C E Some E + C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) + *) + | Pexp_variant of label * expression option + (* `A (None) + `A E (Some E) + *) + | Pexp_record of (Longident.t loc * expression) list * expression option + (* { l1=P1; ...; ln=Pn } (None) + { E0 with l1=P1; ...; ln=Pn } (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 + (* for i = E1 to E2 do E3 done (flag = Upto) + for i = E1 downto E2 do E3 done (flag = Downto) + *) + | Pexp_constraint of expression * core_type + (* (E : T) *) + | Pexp_coerce of expression * core_type option * core_type + (* (E :> T) (None, T) + (E : T0 :> T) (Some T0, T) + *) + | 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 Cfk_concrete + for methods (not values). *) + | Pexp_object of class_structure + (* object ... end *) + | Pexp_newtype of string loc * expression + (* fun (type t) -> E *) + | Pexp_pack of module_expr + (* (module ME) + + (module ME : S) is represented as + Pexp_constraint(Pexp_pack, Ptyp_package S) *) + | Pexp_open of open_declaration * expression + (* M.(E) + let open M in E + let! open M in E *) + | Pexp_letop of letop + (* let* P = E in E + let* P = E and* P = E in E *) + | Pexp_extension of extension + (* [%id] *) + | Pexp_unreachable + (* . *) + + and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) + { + pc_lhs: pattern; + pc_guard: expression option; + pc_rhs: expression; + } + + 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; + } + + (* 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; + } + +(* + val x: T (prim = []) + external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) +*) + + (* Type declarations *) + + and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = + { + ptype_name: string loc; + ptype_params: (core_type * variance) list; + (* ('a1,...'an) t; None represents _*) + ptype_cstrs: (core_type * core_type * Location.t) list; + (* ... constraint T1=T1' ... constraint Tn=Tn' *) + ptype_kind: type_kind; + ptype_private: private_flag; (* = private ... *) + ptype_manifest: core_type option; (* = T *) + ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) + ptype_loc: Location.t; + } + +(* + type t (abstract, no manifest) + type t = T0 (abstract, manifest=T0) + type t = C of T | ... (variant, no manifest) + type t = T0 = C of T | ... (variant, manifest=T0) + type t = {l: T; ...} (record, no manifest) + type t = T0 = {l : T; ...} (record, manifest=T0) + type t = .. (open, no manifest) +*) + + 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; ... } (mutable=Immutable) + { ...; mutable l: T; ... } (mutable=Mutable) + + Note: T can be a Ptyp_poly. + *) + + and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = + { + pcd_name: string loc; + 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 + +(* + | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) + | C: T0 (res = Some T0, args = []) + | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) + | C of {...} (res = None, args = Pcstr_record) + | C: {...} -> T0 (res = Some T0, args = Pcstr_record) + | C of {...} as t (res = None, args = Pcstr_record) +*) + + and type_extension (*IF_CURRENT = Parsetree.type_extension *) = + { + ptyext_path: Longident.t loc; + ptyext_params: (core_type * variance) list; + ptyext_constructors: extension_constructor list; + ptyext_private: private_flag; + ptyext_loc: Location.t; + ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) + } +(* + 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] *) + } + + (* exception E *) + and type_exception (*IF_CURRENT = Parsetree.type_exception *) = + { + ptyexn_constructor: extension_constructor; + ptyexn_loc: Location.t; + ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + + and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = + Pext_decl of constructor_arguments * core_type option + (* + | C of T1 * ... * Tn ([T1; ...; Tn], None) + | C: T0 ([], Some T0) + | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) + *) + | Pext_rebind of Longident.t loc + (* + | C = D + *) + + (** {1 Class language} *) + + (* 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 + (* T -> CT Simple + ~l:T -> CT Labelled l + ?l:T -> CT 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; + } + (* object('selfpat) ... end + object ... end (self = 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 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) list; + pci_name: string loc; + pci_expr: 'a; + pci_loc: Location.t; + pci_attributes: attributes; (* ... [@@id1] [@@id2] *) + } + (* class c = ... + class ['a1,...,'an] c = ... + class virtual c = ... + + Also used for "class type" declaration. + *) + + and class_description = class_type class_infos + + and class_type_declaration = class_type class_infos + + (* 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 + ['a1, ..., 'an] c *) + | Pcl_structure of class_structure + (* object ... end *) + | Pcl_fun of arg_label * expression option * pattern * class_expr + (* fun P -> CE (Simple, None) + fun ~l:P -> CE (Labelled l, None) + fun ?l:P -> CE (Optional l, None) + fun ?l:(P = E0) -> CE (Optional l, Some E0) + *) + | Pcl_apply of class_expr * (arg_label * expression) list + (* 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 + (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN in CE (flag = 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; + } + (* object(selfpat) ... end + object ... end (self = 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 + (* inherit CE + inherit CE as x + inherit! CE + inherit! CE as x + *) + | Pcf_val of (label loc * mutable_flag * class_field_kind) + (* val x = E + val virtual x: T + *) + | Pcf_method of (label loc * private_flag * class_field_kind) + (* method x = E (E can be a Pexp_poly) + method virtual x: T (T can be a 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} *) + + (* 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 + (* 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 + (* (X : MT) Some X, MT + (_ : MT) None, MT *) + + 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 + 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 + 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; + } + (* 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; + } + + 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; + } + (* S = MT + S (abstract module type declaration, pmtd_type = 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; + } + (* open! X - popen_override = Override (silences the 'used identifier + shadowing' warning) + open X - popen_override = Fresh + *) + + and open_description = Longident.t loc open_infos + (* open M.N + open M(N).O *) + + and open_declaration = module_expr open_infos + (* 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 + (* include MT *) + + and include_declaration = module_expr include_infos + (* 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_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 *) + + (* 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_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 + (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) + let rec P1 = E1 and ... and Pn = EN (flag = 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_binding (*IF_CURRENT = Parsetree.value_binding *) = + { + pvb_pat: pattern; + pvb_expr: expression; + pvb_attributes: attributes; + pvb_loc: Location.t; + } + + and module_binding (*IF_CURRENT = Parsetree.module_binding *) = + { + pmb_name: string option loc; + pmb_expr: module_expr; + pmb_attributes: attributes; + pmb_loc: Location.t; + } + (* X = ME *) + + (** {1 Toplevel} *) + + (* 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 Docstrings : sig + (** (Re)Initialise all docstring state *) + val init : unit -> unit + + (** Emit warnings for unattached and ambiguous docstrings *) + val warn_bad_docstrings : unit -> unit + + (** {2 Docstrings} *) + + (** Documentation comments *) + type docstring + + (** Create a docstring *) + val docstring : string -> Location.t -> docstring + + (** Register a docstring *) + val register : docstring -> unit + + (** Get the text of a docstring *) + val docstring_body : docstring -> string + + (** Get the location of a docstring *) + val docstring_loc : docstring -> Location.t + + (** {2 Set functions} + + These functions are used by the lexer to associate docstrings to + the locations of tokens. *) + + (** Docstrings immediately preceding a token *) + val set_pre_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following a token *) + val set_post_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings not immediately adjacent to a token *) + val set_floating_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately following the token which precedes this one *) + val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit + + (** Docstrings immediately preceding the token which follows this one *) + val set_post_extra_docstrings : Lexing.position -> docstring list -> unit + + (** {2 Items} + + The {!docs} type represents documentation attached to an item. *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + val empty_docs : docs + + val docs_attr : docstring -> Parsetree.attribute + + (** Convert item documentation to attributes and add them to an + attribute list *) + val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : unit -> docs + val symbol_docs_lazy : unit -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : int -> int -> docs + val rhs_docs_lazy : int -> int -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : unit -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : int -> int -> unit + + (** {2 Fields and constructors} + + The {!info} type represents documentation attached to a field or + constructor. *) + + type info = docstring option + + val empty_info : info + + val info_attr : docstring -> Parsetree.attribute + + (** Convert field info to attributes and add them to an + attribute list *) + val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the field info for the current symbol. *) + val symbol_info : unit -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : int -> info + + (** {2 Unattached comments} + + The {!text} type represents documentation which is not attached to + anything. *) + + type text = docstring list + + val empty_text : text + val empty_text_lazy : text Lazy.t + + val text_attr : docstring -> Parsetree.attribute + + (** Convert text to attributes and add them to an attribute list *) + val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes + + (** Fetch the text preceding the current symbol. *) + val symbol_text : unit -> text + val symbol_text_lazy : unit -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : int -> text + val rhs_text_lazy : int -> text Lazy.t + + (** {2 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : unit -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : unit -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : int -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : int -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : int -> text + + module WithMenhir: sig + (** Fetch the item documentation for the current symbol. This also + marks this documentation (for ambiguity warnings). *) + val symbol_docs : Lexing.position * Lexing.position -> docs + val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t + + (** Fetch the item documentation for the symbols between two + positions. This also marks this documentation (for ambiguity + warnings). *) + val rhs_docs : Lexing.position -> Lexing.position -> docs + val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t + + (** Mark the item documentation for the current symbol (for ambiguity + warnings). *) + val mark_symbol_docs : Lexing.position * Lexing.position -> unit + + (** Mark as associated the item documentation for the symbols between + two positions (for ambiguity warnings) *) + val mark_rhs_docs : Lexing.position -> Lexing.position -> unit + + (** Fetch the field info for the current symbol. *) + val symbol_info : Lexing.position -> info + + (** Fetch the field info following the symbol at a given position. *) + val rhs_info : Lexing.position -> info + + (** Fetch the text preceding the current symbol. *) + val symbol_text : Lexing.position -> text + val symbol_text_lazy : Lexing.position -> text Lazy.t + + (** Fetch the text preceding the symbol at the given position. *) + val rhs_text : Lexing.position -> text + val rhs_text_lazy : Lexing.position -> text Lazy.t + + (** {3 Extra text} + + There may be additional text attached to the delimiters of a block + (e.g. [struct] and [end]). This is fetched by the following + functions, which are applied to the contents of the block rather + than the delimiters. *) + + (** Fetch additional text preceding the current symbol *) + val symbol_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the current symbol *) + val symbol_post_extra_text : Lexing.position -> text + + (** Fetch additional text preceding the symbol at the given position *) + val rhs_pre_extra_text : Lexing.position -> text + + (** Fetch additional text following the symbol at the given position *) + val rhs_post_extra_text : Lexing.position -> text + + (** Fetch text following the symbol at the given position *) + val rhs_post_text : Lexing.position -> text + + end +end = struct + open Location + + (* Docstrings *) + + (* A docstring is "attached" if it has been inserted in the AST. This + is used for generating unexpected docstring warnings. *) + type ds_attached = + | Unattached (* Not yet attached anything.*) + | Info (* Attached to a field or constructor. *) + | Docs (* Attached to an item or as floating text. *) + + (* A docstring is "associated" with an item if there are no blank lines between + them. This is used for generating docstring ambiguity warnings. *) + type ds_associated = + | Zero (* Not associated with an item *) + | One (* Associated with one item *) + | Many (* Associated with multiple items (ambiguity) *) + + type docstring = + { ds_body: string; + ds_loc: Location.t; + mutable ds_attached: ds_attached; + mutable ds_associated: ds_associated; } + + (* List of docstrings *) + + let docstrings : docstring list ref = ref [] + + (* Warn for unused and ambiguous docstrings *) + + let warn_bad_docstrings () = + if Warnings.is_active (Warnings.Bad_docstring true) then begin + List.iter + (fun ds -> + match ds.ds_attached with + | Info -> () + | Unattached -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring true) + | Docs -> + match ds.ds_associated with + | Zero | One -> () + | Many -> + prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) + (List.rev !docstrings) + end + + (* Docstring constructors and destructors *) + + let docstring body loc = + let ds = + { ds_body = body; + ds_loc = loc; + ds_attached = Unattached; + ds_associated = Zero; } + in + ds + + let register ds = + docstrings := ds :: !docstrings + + let docstring_body ds = ds.ds_body + + let docstring_loc ds = ds.ds_loc + + (* Docstrings attached to items *) + + type docs = + { docs_pre: docstring option; + docs_post: docstring option; } + + let empty_docs = { docs_pre = None; docs_post = None } + + let doc_loc = {txt = "ocaml.doc"; loc = Location.none} + + let docs_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, ds.ds_loc, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = doc_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_docs_attrs docs attrs = + let attrs = + match docs.docs_pre with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> docs_attr ds :: attrs + in + let attrs = + match docs.docs_post with + | None | Some { ds_body=""; _ } -> attrs + | Some ds -> attrs @ [docs_attr ds] + in + attrs + + (* Docstrings attached to constructors or fields *) + + type info = docstring option + + let empty_info = None + + let info_attr = docs_attr + + let add_info_attrs info attrs = + match info with + | None | Some {ds_body=""; _} -> attrs + | Some ds -> attrs @ [info_attr ds] + + (* Docstrings not attached to a specific item *) + + type text = docstring list + + let empty_text = [] + let empty_text_lazy = lazy [] + + let text_loc = {txt = "ocaml.text"; loc = Location.none} + + let text_attr ds = + let open Parsetree in + let exp = + { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, ds.ds_loc, None)); + pexp_loc = ds.ds_loc; + pexp_loc_stack = []; + pexp_attributes = []; } + in + let item = + { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + in + { attr_name = text_loc; + attr_payload = PStr [item]; + attr_loc = Location.none } + + let add_text_attrs dsl attrs = + let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in + (List.map text_attr fdsl) @ attrs + + (* Find the first non-info docstring in a list, attach it and return it *) + let get_docstring ~info dsl = + let rec loop = function + | [] -> None + | {ds_attached = Info; _} :: rest -> loop rest + | ds :: _ -> + ds.ds_attached <- if info then Info else Docs; + Some ds + in + loop dsl + + (* Find all the non-info docstrings in a list, attach them and return them *) + let get_docstrings dsl = + let rec loop acc = function + | [] -> List.rev acc + | {ds_attached = Info; _} :: rest -> loop acc rest + | ds :: rest -> + ds.ds_attached <- Docs; + loop (ds :: acc) rest + in + loop [] dsl + + (* "Associate" all the docstrings in a list *) + let associate_docstrings dsl = + List.iter + (fun ds -> + match ds.ds_associated with + | Zero -> ds.ds_associated <- One + | (One | Many) -> ds.ds_associated <- Many) + dsl + + (* Map from positions to pre docstrings *) + + let pre_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_table pos dsl + + let get_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_pre_docs pos = + try + let dsl = Hashtbl.find pre_table pos in + associate_docstrings dsl + with Not_found -> () + + (* Map from positions to post docstrings *) + + let post_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_table pos dsl + + let get_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl; + get_docstring ~info:false dsl + with Not_found -> None + + let mark_post_docs pos = + try + let dsl = Hashtbl.find post_table pos in + associate_docstrings dsl + with Not_found -> () + + let get_info pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstring ~info:true dsl + with Not_found -> None + + (* Map from positions to floating docstrings *) + + let floating_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_floating_docstrings pos dsl = + if dsl <> [] then Hashtbl.add floating_table pos dsl + + let get_text pos = + try + let dsl = Hashtbl.find floating_table pos in + get_docstrings dsl + with Not_found -> [] + + let get_post_text pos = + try + let dsl = Hashtbl.find post_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Maps from positions to extra docstrings *) + + let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_pre_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add pre_extra_table pos dsl + + let get_pre_extra_text pos = + try + let dsl = Hashtbl.find pre_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = + Hashtbl.create 50 + + let set_post_extra_docstrings pos dsl = + if dsl <> [] then Hashtbl.add post_extra_table pos dsl + + let get_post_extra_text pos = + try + let dsl = Hashtbl.find post_extra_table pos in + get_docstrings dsl + with Not_found -> [] + + (* Docstrings from parser actions *) + module WithParsing = struct + let symbol_docs () = + { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); + docs_post = get_post_docs (Parsing.symbol_end_pos ()); } + + let symbol_docs_lazy () = + let p1 = Parsing.symbol_start_pos () in + let p2 = Parsing.symbol_end_pos () in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); + docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } + + let rhs_docs_lazy pos1 pos2 = + let p1 = Parsing.rhs_start_pos pos1 in + let p2 = Parsing.rhs_end_pos pos2 in + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs () = + mark_pre_docs (Parsing.symbol_start_pos ()); + mark_post_docs (Parsing.symbol_end_pos ()) + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs (Parsing.rhs_start_pos pos1); + mark_post_docs (Parsing.rhs_end_pos pos2) + + let symbol_info () = + get_info (Parsing.symbol_end_pos ()) + + let rhs_info pos = + get_info (Parsing.rhs_end_pos pos) + + let symbol_text () = + get_text (Parsing.symbol_start_pos ()) + + let symbol_text_lazy () = + let pos = Parsing.symbol_start_pos () in + lazy (get_text pos) + + let rhs_text pos = + get_text (Parsing.rhs_start_pos pos) + + let rhs_post_text pos = + get_post_text (Parsing.rhs_end_pos pos) + + let rhs_text_lazy pos = + let pos = Parsing.rhs_start_pos pos in + lazy (get_text pos) + + let symbol_pre_extra_text () = + get_pre_extra_text (Parsing.symbol_start_pos ()) + + let symbol_post_extra_text () = + get_post_extra_text (Parsing.symbol_end_pos ()) + + let rhs_pre_extra_text pos = + get_pre_extra_text (Parsing.rhs_start_pos pos) + + let rhs_post_extra_text pos = + get_post_extra_text (Parsing.rhs_end_pos pos) + end + + include WithParsing + + module WithMenhir = struct + let symbol_docs (startpos, endpos) = + { docs_pre = get_pre_docs startpos; + docs_post = get_post_docs endpos; } + + let symbol_docs_lazy (p1, p2) = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let rhs_docs pos1 pos2 = + { docs_pre = get_pre_docs pos1; + docs_post = get_post_docs pos2; } + + let rhs_docs_lazy p1 p2 = + lazy { docs_pre = get_pre_docs p1; + docs_post = get_post_docs p2; } + + let mark_symbol_docs (startpos, endpos) = + mark_pre_docs startpos; + mark_post_docs endpos; + () + + let mark_rhs_docs pos1 pos2 = + mark_pre_docs pos1; + mark_post_docs pos2; + () + + let symbol_info endpos = + get_info endpos + + let rhs_info endpos = + get_info endpos + + let symbol_text startpos = + get_text startpos + + let symbol_text_lazy startpos = + lazy (get_text startpos) + + let rhs_text pos = + get_text pos + + let rhs_post_text pos = + get_post_text pos + + let rhs_text_lazy pos = + lazy (get_text pos) + + let symbol_pre_extra_text startpos = + get_pre_extra_text startpos + + let symbol_post_extra_text endpos = + get_post_extra_text endpos + + let rhs_pre_extra_text pos = + get_pre_extra_text pos + + let rhs_post_extra_text pos = + get_post_extra_text pos + end + + (* (Re)Initialise all comment state *) + + let init () = + docstrings := []; + Hashtbl.reset pre_table; + Hashtbl.reset post_table; + Hashtbl.reset floating_table; + Hashtbl.reset pre_extra_table; + Hashtbl.reset post_extra_table +end + +module Ast_helper : sig + open Asttypes + open Docstrings + open Parsetree + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type str_opt = string option with_loc + type attrs = attribute list + + (** {1 Default locations} *) + + val default_loc: loc ref + (** Default value for all optional location arguments. *) + + val with_default_loc: loc -> (unit -> 'a) -> 'a + (** Set the [default_loc] within the scope of the execution + of the provided function. *) + + (** {1 Constants} *) + + module Const : sig + val char : char -> constant + val string : + ?quotation_delimiter:string -> ?loc:Location.t -> string -> constant + val integer : ?suffix:char -> string -> constant + val int : ?suffix:char -> int -> constant + val int32 : ?suffix:char -> int32 -> constant + val int64 : ?suffix:char -> int64 -> constant + val nativeint : ?suffix:char -> nativeint -> constant + val float : ?suffix:char -> string -> constant + end + + (** {1 Attributes} *) + module Attr : sig + val mk: ?loc:loc -> str -> payload -> attribute + end + + (** {1 Core language} *) + + (** Type expressions *) + module Typ : + sig + val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type + val attr: core_type -> attribute -> core_type + + val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type + val var: ?loc:loc -> ?attrs:attrs -> string -> core_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type + -> core_type + val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val object_: ?loc:loc -> ?attrs:attrs -> object_field list + -> closed_flag -> core_type + val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type + val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type + val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag + -> label list option -> core_type + val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type + val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list + -> core_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type + + val force_poly: core_type -> core_type + + val varify_constructors: str list -> core_type -> core_type + (** [varify_constructors newtypes te] is type expression [te], of which + any of nullary type constructor [tc] is replaced by type variable of + the same name, if [tc]'s name appears in [newtypes]. + Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] + appears in [newtypes]. + @since 4.05 + *) + end + + (** Patterns *) + module Pat: + sig + val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern + val attr:pattern -> attribute -> pattern + + val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern + val var: ?loc:loc -> ?attrs:attrs -> str -> pattern + val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern + val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern + val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern + val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern + val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern + val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag + -> pattern + val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern + val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern + val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern + val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern + val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern + val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern + val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern + end + + (** Expressions *) + module Exp: + sig + val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression + val attr: expression -> attribute -> expression + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression + val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list + -> expression -> expression + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option + -> pattern -> expression -> expression + val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression + val apply: ?loc:loc -> ?attrs:attrs -> expression + -> (arg_label * expression) list -> expression + val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list + -> expression + val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression + val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option + -> expression + val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option + -> expression + val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list + -> expression option -> expression + val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression + -> expression + val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression + val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression option -> expression + val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression + -> expression + val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression + -> direction_flag -> expression -> expression + val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> core_type -> expression + val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type + -> expression + val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression + val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression + val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list + -> expression + val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr + -> expression -> expression + val letexception: + ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression + -> expression + val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression + val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option + -> expression + val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression + val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression + val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression + val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression + -> expression + val letop: ?loc:loc -> ?attrs:attrs -> binding_op + -> binding_op list -> expression -> expression + val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression + val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression + + val case: pattern -> ?guard:expression -> expression -> case + val binding_op: str -> pattern -> expression -> loc -> binding_op + end + + (** Value declarations *) + module Val: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?prim:string list -> str -> core_type -> value_description + end + + (** Type declarations *) + module Type: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?params:(core_type * variance) list -> + ?cstrs:(core_type * core_type * loc) list -> + ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> + type_declaration + + val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + constructor_declaration + val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> + ?mut:mutable_flag -> str -> core_type -> label_declaration + end + + (** Type extensions *) + module Te: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + ?params:(core_type * variance) list -> ?priv:private_flag -> + lid -> extension_constructor list -> type_extension + + val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + extension_constructor -> type_exception + + val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> extension_constructor_kind -> extension_constructor + + val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + ?args:constructor_arguments -> ?res:core_type -> str -> + extension_constructor + val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> + str -> lid -> extension_constructor + end + + (** {1 Module language} *) + + (** Module type expressions *) + module Mty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type + val attr: module_type -> attribute -> module_type + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type + val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type + val functor_: ?loc:loc -> ?attrs:attrs -> + functor_parameter -> module_type -> module_type + val with_: ?loc:loc -> ?attrs:attrs -> module_type -> + with_constraint list -> module_type + val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type + end + + (** Module expressions *) + module Mod: + sig + val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr + val attr: module_expr -> attribute -> module_expr + + val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr + val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr + val functor_: ?loc:loc -> ?attrs:attrs -> + functor_parameter -> module_expr -> module_expr + val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> + module_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> + module_expr + val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr + end + + (** Signature items *) + module Sig: + sig + val mk: ?loc:loc -> signature_item_desc -> signature_item + + val value: ?loc:loc -> value_description -> signature_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item + val type_subst: ?loc:loc -> type_declaration list -> signature_item + val type_extension: ?loc:loc -> type_extension -> signature_item + val exception_: ?loc:loc -> type_exception -> signature_item + val module_: ?loc:loc -> module_declaration -> signature_item + val mod_subst: ?loc:loc -> module_substitution -> signature_item + val rec_module: ?loc:loc -> module_declaration list -> signature_item + val modtype: ?loc:loc -> module_type_declaration -> signature_item + val open_: ?loc:loc -> open_description -> signature_item + val include_: ?loc:loc -> include_description -> signature_item + val class_: ?loc:loc -> class_description list -> signature_item + val class_type: ?loc:loc -> class_type_declaration list -> signature_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item + val attribute: ?loc:loc -> attribute -> signature_item + val text: text -> signature_item list + end + + (** Structure items *) + module Str: + sig + val mk: ?loc:loc -> structure_item_desc -> structure_item + + val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item + val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item + val primitive: ?loc:loc -> value_description -> structure_item + val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item + val type_extension: ?loc:loc -> type_extension -> structure_item + val exception_: ?loc:loc -> type_exception -> structure_item + val module_: ?loc:loc -> module_binding -> structure_item + val rec_module: ?loc:loc -> module_binding list -> structure_item + val modtype: ?loc:loc -> module_type_declaration -> structure_item + val open_: ?loc:loc -> open_declaration -> structure_item + val class_: ?loc:loc -> class_declaration list -> structure_item + val class_type: ?loc:loc -> class_type_declaration list -> structure_item + val include_: ?loc:loc -> include_declaration -> structure_item + val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item + val attribute: ?loc:loc -> attribute -> structure_item + val text: text -> structure_item list + end + + (** Module declarations *) + module Md: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str_opt -> module_type -> module_declaration + end + + (** Module substitutions *) + module Ms: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str -> lid -> module_substitution + end + + (** Module type declarations *) + module Mtd: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?typ:module_type -> str -> module_type_declaration + end + + (** Module bindings *) + module Mb: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + str_opt -> module_expr -> module_binding + end + + (** Opens *) + module Opn: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> + ?override:override_flag -> 'a -> 'a open_infos + end + + (** Includes *) + module Incl: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos + end + + (** Value bindings *) + module Vb: + sig + val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + pattern -> expression -> value_binding + end + + + (** {1 Class language} *) + + (** Class type expressions *) + module Cty: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type + val attr: class_type -> attribute -> class_type + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type + val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type + val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> + class_type -> class_type + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type + -> class_type + end + + (** Class type fields *) + module Ctf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> + class_type_field_desc -> class_type_field + val attr: class_type_field -> attribute -> class_type_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + virtual_flag -> core_type -> class_type_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + virtual_flag -> core_type -> class_type_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_type_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field + val attribute: ?loc:loc -> attribute -> class_type_field + val text: text -> class_type_field list + end + + (** Class expressions *) + module Cl: + sig + val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr + val attr: class_expr -> attribute -> class_expr + + val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr + val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr + val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> + pattern -> class_expr -> class_expr + val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> + (arg_label * expression) list -> class_expr + val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> + class_expr -> class_expr + val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> + class_expr + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr + val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr + -> class_expr + end + + (** Class fields *) + module Cf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> + class_field + val attr: class_field -> attribute -> class_field + + val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> + str option -> class_field + val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> + class_field_kind -> class_field + val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> + class_field_kind -> class_field + val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> + class_field + val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field + val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field + val attribute: ?loc:loc -> attribute -> class_field + val text: text -> class_field list + + val virtual_: core_type -> class_field_kind + val concrete: override_flag -> expression -> class_field_kind + + end + + (** Classes *) + module Ci: + sig + val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> + ?virt:virtual_flag -> ?params:(core_type * variance) list -> + str -> 'a -> 'a class_infos + end + + (** Class signatures *) + module Csig: + sig + val mk: core_type -> class_type_field list -> class_signature + end + + (** Class structures *) + module Cstr: + sig + val mk: pattern -> class_field list -> class_structure + end + + (** Row fields *) + module Rf: + sig + val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> bool -> core_type list -> row_field + val inherit_: ?loc:loc -> core_type -> row_field + end + + (** Object fields *) + module Of: + sig + val mk: ?loc:loc -> ?attrs:attrs -> + object_field_desc -> object_field + val tag: ?loc:loc -> ?attrs:attrs -> + label with_loc -> core_type -> object_field + val inherit_: ?loc:loc -> core_type -> object_field + end +end = struct + open Asttypes + open Parsetree + open Docstrings + + type 'a with_loc = 'a Location.loc + type loc = Location.t + + type lid = Longident.t with_loc + type str = string with_loc + type str_opt = string option with_loc + type attrs = attribute list + + let default_loc = ref Location.none + + let with_default_loc l f = + Misc.protect_refs [Misc.R (default_loc, l)] f + + module Const = struct + let integer ?suffix i = Pconst_integer (i, suffix) + let int ?suffix i = integer ?suffix (Int.to_string i) + let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) + let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) + let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) + let float ?suffix f = Pconst_float (f, suffix) + let char c = Pconst_char c + let string ?quotation_delimiter ?(loc= !default_loc) s = + Pconst_string (s, loc, quotation_delimiter) + end + + module Attr = struct + let mk ?(loc= !default_loc) name payload = + { attr_name = name; + attr_payload = payload; + attr_loc = loc } + end + + module Typ = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ptyp_desc = d; + ptyp_loc = loc; + ptyp_loc_stack = []; + ptyp_attributes = attrs} + + let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) + let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) + let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) + let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) + let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) + let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) + + let force_poly t = + match t.ptyp_desc with + | Ptyp_poly _ -> t + | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) + + let varify_constructors var_names t = + let check_variable vl loc v = + if List.mem v vl then + raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in + let var_names = List.map (fun v -> v.txt) var_names in + let rec loop t = + let desc = + match t.ptyp_desc with + | Ptyp_any -> Ptyp_any + | Ptyp_var x -> + check_variable var_names t.ptyp_loc x; + Ptyp_var x + | Ptyp_arrow (label,core_type,core_type') -> + Ptyp_arrow(label, loop core_type, loop core_type') + | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) + | Ptyp_constr( { txt = Longident.Lident s }, []) + when List.mem s var_names -> + Ptyp_var s + | Ptyp_constr(longident, lst) -> + Ptyp_constr(longident, List.map loop lst) + | Ptyp_object (lst, o) -> + Ptyp_object (List.map loop_object_field lst, o) + | Ptyp_class (longident, lst) -> + Ptyp_class (longident, List.map loop lst) + | Ptyp_alias(core_type, string) -> + check_variable var_names t.ptyp_loc string; + Ptyp_alias(loop core_type, string) + | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> + Ptyp_variant(List.map loop_row_field row_field_list, + flag, lbl_lst_option) + | Ptyp_poly(string_lst, core_type) -> + List.iter (fun v -> + check_variable var_names t.ptyp_loc v.txt) string_lst; + Ptyp_poly(string_lst, loop core_type) + | Ptyp_package(longident,lst) -> + Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) + | Ptyp_extension (s, arg) -> + Ptyp_extension (s, arg) + in + {t with ptyp_desc = desc} + and loop_row_field field = + let prf_desc = match field.prf_desc with + | Rtag(label,flag,lst) -> + Rtag(label,flag,List.map loop lst) + | Rinherit t -> + Rinherit (loop t) + in + { field with prf_desc; } + and loop_object_field field = + let pof_desc = match field.pof_desc with + | Otag(label, t) -> + Otag(label, loop t) + | Oinherit t -> + Oinherit (loop t) + in + { field with pof_desc; } + in + loop t + + end + + module Pat = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {ppat_desc = d; + ppat_loc = loc; + ppat_loc_stack = []; + ppat_attributes = attrs} + let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} + + let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any + let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) + let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) + let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) + let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) + let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) + let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) + let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) + let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) + let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) + end + + module Exp = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pexp_desc = d; + pexp_loc = loc; + pexp_loc_stack = []; + pexp_attributes = attrs} + let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) + let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) + let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) + let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) + let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) + let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) + let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) + let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) + let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) + let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) + let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) + let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) + let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) + let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) + let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) + let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) + let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) + let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) + let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) + let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) + let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) + let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) + let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) + let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) + let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) + let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) + let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) + let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) + let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) + let letop ?loc ?attrs let_ ands body = + mk ?loc ?attrs (Pexp_letop {let_; ands; body}) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) + let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable + + let case lhs ?guard rhs = + { + pc_lhs = lhs; + pc_guard = guard; + pc_rhs = rhs; + } + + let binding_op op pat exp loc = + { + pbop_op = op; + pbop_pat = pat; + pbop_exp = exp; + pbop_loc = loc; + } + end + + module Mty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} + let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} + + let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) + let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) + let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b)) + let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) + let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) + end + + module Mod = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} + let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} + + let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) + let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) + let functor_ ?loc ?attrs arg body = + mk ?loc ?attrs (Pmod_functor (arg, body)) + let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) + let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) + let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) + end + + module Sig = struct + let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} + + let value ?loc a = mk ?loc (Psig_value a) + let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) + let type_subst ?loc a = mk ?loc (Psig_typesubst a) + let type_extension ?loc a = mk ?loc (Psig_typext a) + let exception_ ?loc a = mk ?loc (Psig_exception a) + let module_ ?loc a = mk ?loc (Psig_module a) + let mod_subst ?loc a = mk ?loc (Psig_modsubst a) + let rec_module ?loc a = mk ?loc (Psig_recmodule a) + let modtype ?loc a = mk ?loc (Psig_modtype a) + let open_ ?loc a = mk ?loc (Psig_open a) + let include_ ?loc a = mk ?loc (Psig_include a) + let class_ ?loc a = mk ?loc (Psig_class a) + let class_type ?loc a = mk ?loc (Psig_class_type a) + let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Psig_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Str = struct + let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} + + let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) + let value ?loc a b = mk ?loc (Pstr_value (a, b)) + let primitive ?loc a = mk ?loc (Pstr_primitive a) + let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) + let type_extension ?loc a = mk ?loc (Pstr_typext a) + let exception_ ?loc a = mk ?loc (Pstr_exception a) + let module_ ?loc a = mk ?loc (Pstr_module a) + let rec_module ?loc a = mk ?loc (Pstr_recmodule a) + let modtype ?loc a = mk ?loc (Pstr_modtype a) + let open_ ?loc a = mk ?loc (Pstr_open a) + let class_ ?loc a = mk ?loc (Pstr_class a) + let class_type ?loc a = mk ?loc (Pstr_class_type a) + let include_ ?loc a = mk ?loc (Pstr_include a) + let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) + let attribute ?loc a = mk ?loc (Pstr_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + end + + module Cl = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcl_desc = d; + pcl_loc = loc; + pcl_attributes = attrs; + } + let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) + let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) + let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) + let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) + let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) + end + + module Cty = struct + let mk ?(loc = !default_loc) ?(attrs = []) d = + { + pcty_desc = d; + pcty_loc = loc; + pcty_attributes = attrs; + } + let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} + + let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) + let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) + let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) + let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) + end + + module Ctf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pctf_desc = d; + pctf_loc = loc; + pctf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) + let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) + let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) + let attribute ?loc a = mk ?loc (Pctf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} + + end + + module Cf = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) d = + { + pcf_desc = d; + pcf_loc = loc; + pcf_attributes = add_docs_attrs docs attrs; + } + + let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) + let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) + let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) + let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) + let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) + let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) + let attribute ?loc a = mk ?loc (Pcf_attribute a) + let text txt = + let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in + List.map + (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) + f_txt + + let virtual_ ct = Cfk_virtual ct + let concrete o e = Cfk_concrete (o, e) + + let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} + + end + + module Val = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(prim = []) name typ = + { + pval_name = name; + pval_type = typ; + pval_attributes = add_docs_attrs docs attrs; + pval_loc = loc; + pval_prim = prim; + } + end + + module Md = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name typ = + { + pmd_name = name; + pmd_type = typ; + pmd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmd_loc = loc; + } + end + + module Ms = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name syn = + { + pms_name = name; + pms_manifest = syn; + pms_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pms_loc = loc; + } + end + + module Mtd = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) ?typ name = + { + pmtd_name = name; + pmtd_type = typ; + pmtd_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmtd_loc = loc; + } + end + + module Mb = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) name expr = + { + pmb_name = name; + pmb_expr = expr; + pmb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pmb_loc = loc; + } + end + + module Opn = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(override = Fresh) expr = + { + popen_expr = expr; + popen_override = override; + popen_loc = loc; + popen_attributes = add_docs_attrs docs attrs; + } + end + + module Incl = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = + { + pincl_mod = mexpr; + pincl_loc = loc; + pincl_attributes = add_docs_attrs docs attrs; + } + + end + + module Vb = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(text = []) pat expr = + { + pvb_pat = pat; + pvb_expr = expr; + pvb_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pvb_loc = loc; + } + end + + module Ci = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(virt = Concrete) ?(params = []) name expr = + { + pci_virt = virt; + pci_params = params; + pci_name = name; + pci_expr = expr; + pci_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + pci_loc = loc; + } + end + + module Type = struct + let mk ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(text = []) + ?(params = []) + ?(cstrs = []) + ?(kind = Ptype_abstract) + ?(priv = Public) + ?manifest + name = + { + ptype_name = name; + ptype_params = params; + ptype_cstrs = cstrs; + ptype_kind = kind; + ptype_private = priv; + ptype_manifest = manifest; + ptype_attributes = + add_text_attrs text (add_docs_attrs docs attrs); + ptype_loc = loc; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(args = Pcstr_tuple []) ?res name = + { + pcd_name = name; + pcd_args = args; + pcd_res = res; + pcd_loc = loc; + pcd_attributes = add_info_attrs info attrs; + } + + let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) + ?(mut = Immutable) name typ = + { + pld_name = name; + pld_mutable = mut; + pld_type = typ; + pld_loc = loc; + pld_attributes = add_info_attrs info attrs; + } + + end + + (** Type extensions *) + module Te = struct + let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(params = []) ?(priv = Public) path constructors = + { + ptyext_path = path; + ptyext_params = params; + ptyext_constructors = constructors; + ptyext_private = priv; + ptyext_loc = loc; + ptyext_attributes = add_docs_attrs docs attrs; + } + + let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + constructor = + { + ptyexn_constructor = constructor; + ptyexn_loc = loc; + ptyexn_attributes = add_docs_attrs docs attrs; + } + + let constructor ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name kind = + { + pext_name = name; + pext_kind = kind; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) + ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = + { + pext_name = name; + pext_kind = Pext_decl(args, res); + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + let rebind ?(loc = !default_loc) ?(attrs = []) + ?(docs = empty_docs) ?(info = empty_info) name lid = + { + pext_name = name; + pext_kind = Pext_rebind lid; + pext_loc = loc; + pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); + } + + end + + module Csig = struct + let mk self fields = + { + pcsig_self = self; + pcsig_fields = fields; + } + end + + module Cstr = struct + let mk self fields = + { + pcstr_self = self; + pcstr_fields = fields; + } + end + + (** Row fields *) + module Rf = struct + let mk ?(loc = !default_loc) ?(attrs = []) desc = { + prf_desc = desc; + prf_loc = loc; + prf_attributes = attrs; + } + let tag ?loc ?attrs label const tys = + mk ?loc ?attrs (Rtag (label, const, tys)) + let inherit_?loc ty = + mk ?loc (Rinherit ty) + end + + (** Object fields *) + module Of = struct + let mk ?(loc = !default_loc) ?(attrs=[]) desc = { + pof_desc = desc; + pof_loc = loc; + pof_attributes = attrs; + } + let tag ?loc ?attrs label ty = + mk ?loc ?attrs (Otag (label, ty)) + let inherit_ ?loc ty = + mk ?loc (Oinherit ty) + end +end + +module Ast_mapper : sig + open Parsetree + + (** {1 A generic Parsetree mapper} *) + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constant: mapper -> constant -> constant; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + (** A mapper record implements one "method" per syntactic category, + using an open recursion style: each method takes as its first + argument the mapper to be applied to children in the syntax + tree. *) + + val default_mapper: mapper + (** A default mapper, which implements a "deep identity" mapping. *) + + (** {1 Apply mappers to compilation units} *) + + val tool_name: unit -> string + (** Can be used within a ppx preprocessor to know which tool is + calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], + ["ocaml"], ... Some global variables that reflect command-line + options are automatically synchronized between the calling tool + and the ppx preprocessor: {!Clflags.include_dirs}, + {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, + {!Clflags.debug}. *) + + + val apply: source:string -> target:string -> mapper -> unit + (** Apply a mapper (parametrized by the unit name) to a dumped + parsetree found in the [source] file and put the result in the + [target] file. The [structure] or [signature] field of the mapper + is applied to the implementation or interface. *) + + val run_main: (string list -> mapper) -> unit + (** Entry point to call to implement a standalone -ppx rewriter from a + mapper, parametrized by the command line arguments. The current + unit name can be obtained from {!Location.input_name}. This + function implements proper error reporting for uncaught + exceptions. *) + + (** {1 Registration API} *) + + val register_function: (string -> (string list -> mapper) -> unit) ref + + val register: string -> (string list -> mapper) -> unit + (** Apply the [register_function]. The default behavior is to run the + mapper immediately, taking arguments from the process command + line. This is to support a scenario where a mapper is linked as a + stand-alone executable. + + It is possible to overwrite the [register_function] to define + "-ppx drivers", which combine several mappers in a single process. + Typically, a driver starts by defining [register_function] to a + custom implementation, then lets ppx rewriters (linked statically + or dynamically) register themselves, and then run all or some of + them. It is also possible to have -ppx drivers apply rewriters to + only specific parts of an AST. + + The first argument to [register] is a symbolic name to be used by + the ppx driver. *) + + + (** {1 Convenience functions to write mappers} *) + + val map_opt: ('a -> 'b) -> 'a option -> 'b option + + val extension_of_error: Locations.location_error -> extension + (** Encode an error into an 'ocaml.error' extension node which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the error. *) + + val attribute_of_warning: Location.t -> string -> attribute + (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be + inserted in a generated Parsetree. The compiler will be + responsible for reporting the warning. *) + + include Locations.Helpers_intf + + (** {1 Helper functions to call external mappers} *) + + val add_ppx_context_str: + tool_name:string -> Parsetree.structure -> Parsetree.structure + (** Extract information from the current environment and encode it + into an attribute which is prepended to the list of structure + items in order to pass the information to an external + processor. *) + + val add_ppx_context_sig: + tool_name:string -> Parsetree.signature -> Parsetree.signature + (** Same as [add_ppx_context_str], but for signatures. *) + + val drop_ppx_context_str: + restore:bool -> Parsetree.structure -> Parsetree.structure + (** Drop the ocaml.ppx.context attribute from a structure. If + [restore] is true, also restore the associated data in the current + process. *) + + val drop_ppx_context_sig: + restore:bool -> Parsetree.signature -> Parsetree.signature + (** Same as [drop_ppx_context_str], but for signatures. *) + + (** {1 Cookies} *) + + (** Cookies are used to pass information from a ppx processor to + a further invocation of itself, when called from the OCaml + toplevel (or other tools that support cookies). *) + + val set_cookie: string -> Parsetree.expression -> unit + val get_cookie: string -> Parsetree.expression option +end = struct + open Parsetree + open Ast_helper + open Location + + module String = Misc.Stdlib.String + + type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { + attribute: mapper -> attribute -> attribute; + attributes: mapper -> attribute list -> attribute list; + binding_op: mapper -> binding_op -> binding_op; + case: mapper -> case -> case; + cases: mapper -> case list -> case list; + class_declaration: mapper -> class_declaration -> class_declaration; + class_description: mapper -> class_description -> class_description; + class_expr: mapper -> class_expr -> class_expr; + class_field: mapper -> class_field -> class_field; + class_signature: mapper -> class_signature -> class_signature; + class_structure: mapper -> class_structure -> class_structure; + class_type: mapper -> class_type -> class_type; + class_type_declaration: mapper -> class_type_declaration + -> class_type_declaration; + class_type_field: mapper -> class_type_field -> class_type_field; + constant: mapper -> constant -> constant; + constructor_declaration: mapper -> constructor_declaration + -> constructor_declaration; + expr: mapper -> expression -> expression; + extension: mapper -> extension -> extension; + extension_constructor: mapper -> extension_constructor + -> extension_constructor; + include_declaration: mapper -> include_declaration -> include_declaration; + include_description: mapper -> include_description -> include_description; + label_declaration: mapper -> label_declaration -> label_declaration; + location: mapper -> Location.t -> Location.t; + module_binding: mapper -> module_binding -> module_binding; + module_declaration: mapper -> module_declaration -> module_declaration; + module_substitution: mapper -> module_substitution -> module_substitution; + module_expr: mapper -> module_expr -> module_expr; + module_type: mapper -> module_type -> module_type; + module_type_declaration: mapper -> module_type_declaration + -> module_type_declaration; + open_declaration: mapper -> open_declaration -> open_declaration; + open_description: mapper -> open_description -> open_description; + pat: mapper -> pattern -> pattern; + payload: mapper -> payload -> payload; + signature: mapper -> signature -> signature; + signature_item: mapper -> signature_item -> signature_item; + structure: mapper -> structure -> structure; + structure_item: mapper -> structure_item -> structure_item; + typ: mapper -> core_type -> core_type; + type_declaration: mapper -> type_declaration -> type_declaration; + type_extension: mapper -> type_extension -> type_extension; + type_exception: mapper -> type_exception -> type_exception; + type_kind: mapper -> type_kind -> type_kind; + value_binding: mapper -> value_binding -> value_binding; + value_description: mapper -> value_description -> value_description; + with_constraint: mapper -> with_constraint -> with_constraint; + } + + let map_fst f (x, y) = (f x, y) + let map_snd f (x, y) = (x, f y) + let map_tuple f1 f2 (x, y) = (f1 x, f2 y) + let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) + let map_opt f = function None -> None | Some x -> Some (f x) + + let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} + + module C = struct + (* Constants *) + + let map sub c = match c with + | Pconst_integer _ + | Pconst_char _ + | Pconst_float _ + -> c + | Pconst_string (s, loc, quotation_delimiter) -> + let loc = sub.location sub loc in + Const.string ~loc ?quotation_delimiter s + end + + module T = struct + (* Type expressions for the core language *) + + let row_field sub { + prf_desc; + prf_loc; + prf_attributes; + } = + let loc = sub.location sub prf_loc in + let attrs = sub.attributes sub prf_attributes in + let desc = match prf_desc with + | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) + | Rinherit t -> Rinherit (sub.typ sub t) + in + Rf.mk ~loc ~attrs desc + + let object_field sub { + pof_desc; + pof_loc; + pof_attributes; + } = + let loc = sub.location sub pof_loc in + let attrs = sub.attributes sub pof_attributes in + let desc = match pof_desc with + | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) + | Oinherit t -> Oinherit (sub.typ sub t) + in + Of.mk ~loc ~attrs desc + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs + (List.map (map_loc sub) sl) (sub.typ sub t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + let loc = sub.location sub ptype_loc in + let attrs = sub.attributes sub ptype_attributes in + Type.mk ~loc ~attrs (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub.typ sub)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map + (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) + ptype_cstrs) + ~kind:(sub.type_kind sub ptype_kind) + ?manifest:(map_opt (sub.typ sub) ptype_manifest) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub.constructor_declaration sub) l) + | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) + | Ptype_open -> Ptype_open + + let map_constructor_arguments sub = function + | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) + | Pcstr_record l -> + Pcstr_record (List.map (sub.label_declaration sub) l) + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_loc; + ptyext_attributes} = + let loc = sub.location sub ptyext_loc in + let attrs = sub.attributes sub ptyext_attributes in + Te.mk ~loc ~attrs + (map_loc sub ptyext_path) + (List.map (sub.extension_constructor sub) ptyext_constructors) + ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) + ~priv:ptyext_private + + let map_type_exception sub + {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = + let loc = sub.location sub ptyexn_loc in + let attrs = sub.attributes sub ptyexn_attributes in + Te.mk_exception ~loc ~attrs + (sub.extension_constructor sub ptyexn_constructor) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + let loc = sub.location sub pext_loc in + let attrs = sub.attributes sub pext_attributes in + Te.constructor ~loc ~attrs + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + + end + + module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) + | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcty_open (o, ct) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) + | Pctf_val (s, m, v, t) -> + val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) + | Pctf_method (s, p, v, t) -> + method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub.typ sub pcsig_self) + (List.map (sub.class_type_field sub) pcsig_fields) + end + + let map_functor_param sub = function + | Unit -> Unit + | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt) + + module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) + | Pmty_functor (param, mt) -> + functor_ ~loc ~attrs + (map_functor_param sub param) + (sub.module_type sub mt) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub.module_type sub mt) + (List.map (sub.with_constraint sub) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) + | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub.type_declaration sub d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub.location sub loc in + match desc with + | Psig_value vd -> value ~loc (sub.value_description sub vd) + | Psig_type (rf, l) -> + type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Psig_typesubst l -> + type_subst ~loc (List.map (sub.type_declaration sub) l) + | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) + | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Psig_module x -> module_ ~loc (sub.module_declaration sub x) + | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub.module_declaration sub) l) + | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Psig_open x -> open_ ~loc (sub.open_description sub x) + | Psig_include x -> include_ ~loc (sub.include_description sub x) + | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Psig_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Psig_attribute x -> attribute ~loc (sub.attribute sub x) + end + + + module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) + | Pmod_functor (param, body) -> + functor_ ~loc ~attrs + (map_functor_param sub param) + (sub.module_expr sub body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub.module_expr sub m) + (sub.module_type sub mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) + | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub.location sub loc in + match desc with + | Pstr_eval (x, attrs) -> + let attrs = sub.attributes sub attrs in + eval ~loc ~attrs (sub.expr sub x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) + | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) + | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) + | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) + | Pstr_module x -> module_ ~loc (sub.module_binding sub x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) + | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) + | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) + | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub.class_type_declaration sub) l) + | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) + | Pstr_extension (x, attrs) -> + let attrs = sub.attributes sub attrs in + extension ~loc ~attrs (sub.extension sub x) + | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) + end + + module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs (sub.constant sub x) + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.expr sub e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) + (sub.expr sub e) + | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) + | Pexp_match (e, pel) -> + match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) + (map_opt (sub.expr sub) eo) + | Pexp_field (e, lid) -> + field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) + (sub.expr sub e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + (map_opt (sub.expr sub) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_while (e1, e2) -> + while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d + (sub.expr sub e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) + (sub.typ sub t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) + | Pexp_send (e, s) -> + send ~loc ~attrs (sub.expr sub e) (map_loc sub s) + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) + (sub.expr sub e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub.extension_constructor sub cd) + (sub.expr sub e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) + | Pexp_newtype (s, e) -> + newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) + | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) + | Pexp_open (o, e) -> + open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) + | Pexp_letop {let_; ands; body} -> + letop ~loc ~attrs (sub.binding_op sub let_) + (List.map (sub.binding_op sub) ands) (sub.expr sub body) + | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pexp_unreachable -> unreachable ~loc ~attrs () + + let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = + let open Exp in + let op = map_loc sub pbop_op in + let pat = sub.pat sub pbop_pat in + let exp = sub.expr sub pbop_exp in + let loc = sub.location sub pbop_loc in + binding_op op pat exp loc + + end + + module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs (sub.constant sub c) + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) + | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) + | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) + end + + module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub.class_structure sub s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub.expr sub) e) + (sub.pat sub p) + (sub.class_expr sub ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub.class_expr sub ce) + (List.map (map_snd (sub.expr sub)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) + (sub.class_expr sub ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) + | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) + | Pcl_open (o, ce) -> + open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) + | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in + match desc with + | Pcf_inherit (o, ce, s) -> + inherit_ ~loc ~attrs o (sub.class_expr sub ce) + (map_opt (map_loc sub) s) + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) + | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) + | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub.pat sub pcstr_self; + pcstr_fields = List.map (sub.class_field sub) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + let loc = sub.location sub pci_loc in + let attrs = sub.attributes sub pci_attributes in + Ci.mk ~loc ~attrs + ~virt:pci_virt + ~params:(List.map (map_fst (sub.typ sub)) pl) + (map_loc sub pci_name) + (f pci_expr) + end + + (* Now, a generic AST mapper, to be extended to cover all kinds and + cases of the OCaml grammar. The default behavior of the mapper is + the identity. *) + + let default_mapper = + { + constant = C.map; + structure = (fun this l -> List.map (this.structure_item this) l); + structure_item = M.map_structure_item; + module_expr = M.map; + signature = (fun this l -> List.map (this.signature_item this) l); + signature_item = MT.map_signature_item; + module_type = MT.map; + with_constraint = MT.map_with_constraint; + class_declaration = + (fun this -> CE.class_infos this (this.class_expr this)); + class_expr = CE.map; + class_field = CE.map_field; + class_structure = CE.map_structure; + class_type = CT.map; + class_type_field = CT.map_field; + class_signature = CT.map_signature; + class_type_declaration = + (fun this -> CE.class_infos this (this.class_type this)); + class_description = + (fun this -> CE.class_infos this (this.class_type this)); + type_declaration = T.map_type_declaration; + type_kind = T.map_type_kind; + typ = T.map; + type_extension = T.map_type_extension; + type_exception = T.map_type_exception; + extension_constructor = T.map_extension_constructor; + value_description = + (fun this {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} -> + Val.mk + (map_loc this pval_name) + (this.typ this pval_type) + ~attrs:(this.attributes this pval_attributes) + ~loc:(this.location this pval_loc) + ~prim:pval_prim + ); + + pat = P.map; + expr = E.map; + binding_op = E.map_binding_op; + + module_declaration = + (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> + Md.mk + (map_loc this pmd_name) + (this.module_type this pmd_type) + ~attrs:(this.attributes this pmd_attributes) + ~loc:(this.location this pmd_loc) + ); + + module_substitution = + (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> + Ms.mk + (map_loc this pms_name) + (map_loc this pms_manifest) + ~attrs:(this.attributes this pms_attributes) + ~loc:(this.location this pms_loc) + ); + + module_type_declaration = + (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this.module_type this) pmtd_type) + ~attrs:(this.attributes this pmtd_attributes) + ~loc:(this.location this pmtd_loc) + ); + + module_binding = + (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> + Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) + ~attrs:(this.attributes this pmb_attributes) + ~loc:(this.location this pmb_loc) + ); + + + open_declaration = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (this.module_expr this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + open_description = + (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> + Opn.mk (map_loc this popen_expr) + ~override:popen_override + ~loc:(this.location this popen_loc) + ~attrs:(this.attributes this popen_attributes) + ); + + include_description = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_type this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + include_declaration = + (fun this {pincl_mod; pincl_attributes; pincl_loc} -> + Incl.mk (this.module_expr this pincl_mod) + ~loc:(this.location this pincl_loc) + ~attrs:(this.attributes this pincl_attributes) + ); + + + value_binding = + (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> + Vb.mk + (this.pat this pvb_pat) + (this.expr this pvb_expr) + ~loc:(this.location this pvb_loc) + ~attrs:(this.attributes this pvb_attributes) + ); + + + constructor_declaration = + (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> + Type.constructor + (map_loc this pcd_name) + ~args:(T.map_constructor_arguments this pcd_args) + ?res:(map_opt (this.typ this) pcd_res) + ~loc:(this.location this pcd_loc) + ~attrs:(this.attributes this pcd_attributes) + ); + + label_declaration = + (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> + Type.field + (map_loc this pld_name) + (this.typ this pld_type) + ~mut:pld_mutable + ~loc:(this.location this pld_loc) + ~attrs:(this.attributes this pld_attributes) + ); + + cases = (fun this l -> List.map (this.case this) l); + case = + (fun this {pc_lhs; pc_guard; pc_rhs} -> + { + pc_lhs = this.pat this pc_lhs; + pc_guard = map_opt (this.expr this) pc_guard; + pc_rhs = this.expr this pc_rhs; + } + ); + + + + location = (fun _this l -> l); + + extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); + attribute = (fun this a -> + { + attr_name = map_loc this a.attr_name; + attr_payload = this.payload this a.attr_payload; + attr_loc = this.location this a.attr_loc + } + ); + attributes = (fun this l -> List.map (this.attribute this) l); + payload = + (fun this -> function + | PStr x -> PStr (this.structure this x) + | PSig x -> PSig (this.signature this x) + | PTyp x -> PTyp (this.typ this x) + | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) + ); + } + + let extension_of_error (error : Locations.location_error) : extension = + Locations.extension_of_error + ~mk_pstr:(fun x -> PStr x) + ~mk_extension:(fun x -> Str.extension x) + ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, Location.none (* XXX *), None)))) + error + + let attribute_of_warning loc s = + Attr.mk + {loc; txt = "ocaml.ppwarning" } + (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, loc, None)))])) + + include Locations.Helpers_impl + + let cookies = ref String.Map.empty + + let get_cookie k = + try Some (String.Map.find k !cookies) + with Not_found -> None + + let set_cookie k v = + cookies := String.Map.add k v !cookies + + let tool_name_ref = ref "_none_" + + let tool_name () = !tool_name_ref + + + module PpxContext = struct + open Longident + open Asttypes + open Ast_helper + + let lid name = { txt = Lident name; loc = Location.none } + + let make_string s = Exp.constant (Const.string s) + + let make_bool x = + if x + then Exp.construct (lid "true") None + else Exp.construct (lid "false") None + + let rec make_list f lst = + match lst with + | x :: rest -> + Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) + | [] -> + Exp.construct (lid "[]") None + + let make_pair f1 f2 (x1, x2) = + Exp.tuple [f1 x1; f2 x2] + + let make_option f opt = + match opt with + | Some x -> Exp.construct (lid "Some") (Some (f x)) + | None -> Exp.construct (lid "None") None + + let get_cookies () = + lid "cookies", + make_list (make_pair make_string (fun x -> x)) + (String.Map.bindings !cookies) + + let mk fields = + { + attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; + attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; + attr_loc = Location.none + } + + let make ~tool_name () = + let fields = + [ + lid "tool_name", make_string tool_name; + lid "include_dirs", make_list make_string !Clflags.include_dirs; + lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); + lid "open_modules", make_list make_string !Clflags.open_modules; + lid "for_package", make_option make_string !Clflags.for_package; + lid "debug", make_bool !Clflags.debug; + lid "use_threads", make_bool !Clflags.use_threads; + lid "use_vmthreads", make_bool false; + lid "recursive_types", make_bool !Clflags.recursive_types; + lid "principal", make_bool !Clflags.principal; + lid "transparent_modules", make_bool !Clflags.transparent_modules; + lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); + lid "unsafe_string", make_bool !Clflags.unsafe_string; + get_cookies () + ] + in + mk fields + + let get_fields = function + | PStr [{pstr_desc = Pstr_eval + ({ pexp_desc = Pexp_record (fields, None) }, [])}] -> + fields + | _ -> + raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" + + let restore fields = + let field name payload = + let rec get_string = function + | { pexp_desc = Pexp_constant (Pconst_string (str, _, None)) } -> str + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] string syntax" name + and get_bool pexp = + match pexp with + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, + None)} -> + true + | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, + None)} -> + false + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] bool syntax" name + and get_list elem = function + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "::"}, + Some {pexp_desc = Pexp_tuple [exp; rest]}) } -> + elem exp :: get_list elem rest + | {pexp_desc = + Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> + [] + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] list syntax" name + and get_pair f1 f2 = function + | {pexp_desc = Pexp_tuple [e1; e2]} -> + (f1 e1, f2 e2) + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] pair syntax" name + and get_option elem = function + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } -> + Some (elem exp) + | { pexp_desc = + Pexp_construct ({ txt = Longident.Lident "None" }, None) } -> + None + | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ + { %s }] option syntax" name + in + match name with + | "tool_name" -> + tool_name_ref := get_string payload + | "include_dirs" -> + Clflags.include_dirs := get_list get_string payload + | "load_path" -> + Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) + | "open_modules" -> + Clflags.open_modules := get_list get_string payload + | "for_package" -> + Clflags.for_package := get_option get_string payload + | "debug" -> + Clflags.debug := get_bool payload + | "use_threads" -> + Clflags.use_threads := get_bool payload + | "use_vmthreads" -> + if get_bool payload then + raise_errorf "Internal error: vmthreads not supported after 4.09.0" + | "recursive_types" -> + Clflags.recursive_types := get_bool payload + | "principal" -> + Clflags.principal := get_bool payload + | "transparent_modules" -> + Clflags.transparent_modules := get_bool payload + | "unboxed_types" -> + Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) + | "unsafe_string" -> + Clflags.unsafe_string := get_bool payload + | "cookies" -> + let l = get_list (get_pair get_string (fun x -> x)) payload in + cookies := + List.fold_left + (fun s (k, v) -> String.Map.add k v s) String.Map.empty + l + | _ -> + () + in + List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields + + let update_cookies fields = + let fields = + List.filter + (function ({txt=Lident "cookies"}, _) -> false | _ -> true) + fields + in + fields @ [get_cookies ()] + end + + let ppx_context = PpxContext.make + + let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) + + let apply_lazy ~source ~target mapper = + let implem ast = + let fields, ast = + match ast with + | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"}; + attr_payload = x})} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.structure mapper ast + with exn -> + [{pstr_desc = Pstr_extension (extension_of_exn exn, []); + pstr_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Str.attribute (PpxContext.mk fields) :: ast + in + let iface ast = + let fields, ast = + match ast with + | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"}; + attr_payload = x; + attr_loc = _})} :: l -> + PpxContext.get_fields x, l + | _ -> [], ast + in + PpxContext.restore fields; + let ast = + try + let mapper = mapper () in + mapper.signature mapper ast + with exn -> + [{psig_desc = Psig_extension (extension_of_exn exn, []); + psig_loc = Location.none}] + in + let fields = PpxContext.update_cookies fields in + Sig.attribute (PpxContext.mk fields) :: ast + in + + let ic = open_in_bin source in + let magic = + really_input_string ic (String.length Config.ast_impl_magic_number) + in + + let rewrite transform = + Location.input_name := input_value ic; + let ast = input_value ic in + close_in ic; + let ast = transform ast in + let oc = open_out_bin target in + output_string oc magic; + output_value oc !Location.input_name; + output_value oc ast; + close_out oc + and fail () = + close_in ic; + failwith "Ast_mapper: OCaml version mismatch or malformed input"; + in + + if magic = Config.ast_impl_magic_number then + rewrite (implem : structure -> structure) + else if magic = Config.ast_intf_magic_number then + rewrite (iface : signature -> signature) + else fail () + + let drop_ppx_context_str ~restore = function + | {pstr_desc = Pstr_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"}; + attr_payload = a; + attr_loc = _}} + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let drop_ppx_context_sig ~restore = function + | {psig_desc = Psig_attribute + {attr_name = {Location.txt = "ocaml.ppx.context"}; + attr_payload = a; + attr_loc = _}} + :: items -> + if restore then + PpxContext.restore (PpxContext.get_fields a); + items + | items -> items + + let add_ppx_context_str ~tool_name ast = + Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast + + let add_ppx_context_sig ~tool_name ast = + Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast + + + let apply ~source ~target mapper = + apply_lazy ~source ~target (fun () -> mapper) + + let run_main mapper = + try + let a = Sys.argv in + let n = Array.length a in + if n > 2 then + let mapper () = + try mapper (Array.to_list (Array.sub a 1 (n - 3))) + with exn -> + (* PR#6463 *) + let f _ _ = raise exn in + {default_mapper with structure = f; signature = f} + in + apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper + else begin + Printf.eprintf "Usage: %s [extra_args] \n%!" + Sys.executable_name; + exit 2 + end + with exn -> + prerr_endline (Printexc.to_string exn); + exit 2 + + let register_function = ref (fun _name f -> run_main f) + let register name f = !register_function name f +end + +module Type_immediacy = struct + type t (*IF_CURRENT = Type_immediacy.t *) = + | Unknown + | Always + | Always_on_64bits +end + +module Outcometree = struct + (* Module [Outcometree]: results displayed by the toplevel *) + + (* These types represent messages that the toplevel displays as normal + results or errors. The real displaying is customisable using the hooks: + [Toploop.print_out_value] + [Toploop.print_out_type] + [Toploop.print_out_sig_item] + [Toploop.print_out_phrase] *) + + (** An [out_name] is a string representation of an identifier which can be + rewritten on the fly to avoid name collisions *) + type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } + + type out_ident (*IF_CURRENT = Outcometree.out_ident *) = + | Oide_apply of out_ident * out_ident + | Oide_dot of out_ident * string + | Oide_ident of out_name + + type out_string (*IF_CURRENT = Outcometree.out_string *) = + | Ostr_string + | Ostr_bytes + + type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = + { oattr_name: string } + + type out_value (*IF_CURRENT = Outcometree.out_value *) = + | Oval_array of out_value list + | Oval_char of char + | Oval_constr of out_ident * out_value list + | Oval_ellipsis + | Oval_float of float + | Oval_int of int + | Oval_int32 of int32 + | Oval_int64 of int64 + | Oval_nativeint of nativeint + | Oval_list of out_value list + | Oval_printer of (Format.formatter -> unit) + | Oval_record of (out_ident * out_value) list + | Oval_string of string * int * out_string (* string, size-to-print, kind *) + | Oval_stuff of string + | Oval_tuple of out_value list + | Oval_variant of string * out_value option + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of out_type * string + | Otyp_arrow of string * out_type * out_type + | Otyp_class of bool * out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of (string * out_type) list * bool option + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of (string * out_type list * out_type option) list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of + bool * out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * string list * out_type list + | Otyp_attribute of out_type * out_attribute + + and out_variant (*IF_CURRENT = Outcometree.out_variant *) = + | Ovar_fields of (string * bool * out_type list) list + | Ovar_typ of out_type + + type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = + | Octy_constr of out_ident * out_type list + | Octy_arrow of string * out_type * out_class_type + | Octy_signature of out_type option * out_class_sig_item list + and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = + | Ocsg_constraint of out_type * out_type + | Ocsg_method of string * bool * bool * out_type + | Ocsg_value of string * bool * bool * out_type + + type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = + | Omty_abstract + | Omty_functor of (string option * out_module_type) option * out_module_type + | Omty_ident of out_ident + | Omty_signature of out_sig_item list + | Omty_alias of out_ident + and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = + | Osig_class of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * (string * (bool * bool)) list * out_class_type * + out_rec_status + | Osig_typext of out_extension_constructor * out_ext_status + | Osig_modtype of string * out_module_type + | Osig_module of string * out_module_type * out_rec_status + | Osig_type of out_type_decl * out_rec_status + | Osig_value of out_val_decl + | Osig_ellipsis + and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = + { otype_name: string; + otype_params: (string * (bool * bool)) list; + otype_type: out_type; + otype_private: Asttypes.private_flag; + otype_immediate: Type_immediacy.t; + otype_unboxed: bool; + otype_cstrs: (out_type * out_type) list } + and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = + { oext_name: string; + oext_type_name: string; + oext_type_params: string list; + oext_args: out_type list; + oext_ret_type: out_type option; + oext_private: Asttypes.private_flag } + and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = + { otyext_name: string; + otyext_params: string list; + otyext_constructors: (string * out_type list * out_type option) list; + otyext_private: Asttypes.private_flag } + and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = + { oval_name: string; + oval_type: out_type; + oval_prims: string list; + oval_attributes: out_attribute list } + and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = + | Orec_not + | Orec_first + | Orec_next + and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = + | Oext_first + | Oext_next + | Oext_exception + + type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = + | Ophr_eval of out_value * out_type + | Ophr_signature of (out_sig_item * out_value option) list + | Ophr_exception of (exn * out_value) +end + +module Config = struct + let ast_impl_magic_number = "Caml1999M028" + let ast_intf_magic_number = "Caml1999N028" +end + +let map_signature mapper = mapper.Ast_mapper.signature mapper +let map_structure mapper = mapper.Ast_mapper.structure mapper + +let shallow_identity = + let id _ x = x in + { + Ast_mapper. + structure = id; + structure_item = id; + module_expr = id; + signature = id; + signature_item = id; + module_type = id; + with_constraint = id; + class_declaration = id; + class_expr = id; + class_field = id; + class_structure = id; + class_type = id; + class_type_field = id; + class_signature = id; + class_type_declaration = id; + class_description = id; + type_declaration = id; + type_kind = id; + typ = id; + type_extension = id; + extension_constructor = id; + value_description = id; + pat = id; + expr = id; + module_declaration = id; + module_type_declaration = id; + module_binding = id; + open_description = id; + include_description = id; + include_declaration = id; + value_binding = id; + constructor_declaration = id; + label_declaration = id; + cases = id; + case = id; + location = id; + extension = id; + attribute = id; + attributes = id; + payload = id; + binding_op = id; + module_substitution = id; + open_declaration = id; + type_exception = id; + constant = id; + } + +let failing_mapper = + let fail _ _ = + invalid_arg "failing_mapper: this mapper function should never get called" + in + { + Ast_mapper. + structure = fail; + structure_item = fail; + module_expr = fail; + signature = fail; + signature_item = fail; + module_type = fail; + with_constraint = fail; + class_declaration = fail; + class_expr = fail; + class_field = fail; + class_structure = fail; + class_type = fail; + class_type_field = fail; + class_signature = fail; + class_type_declaration = fail; + class_description = fail; + type_declaration = fail; + type_kind = fail; + typ = fail; + type_extension = fail; + extension_constructor = fail; + value_description = fail; + pat = fail; + expr = fail; + module_declaration = fail; + module_type_declaration = fail; + module_binding = fail; + open_description = fail; + include_description = fail; + include_declaration = fail; + value_binding = fail; + constructor_declaration = fail; + label_declaration = fail; + cases = fail; + case = fail; + location = fail; + extension = fail; + attribute = fail; + attributes = fail; + payload = fail; + binding_op = fail; + module_substitution = fail; + open_declaration = fail; + type_exception = fail; + constant = fail; + } + +let make_top_mapper ~signature ~structure = + {failing_mapper with Ast_mapper. + signature = (fun _ x -> signature x); + structure = (fun _ x -> structure x) } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/cinaps_helpers b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/cinaps_helpers new file mode 100644 index 000000000..05ff7b6cf --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/cinaps_helpers @@ -0,0 +1,74 @@ +(* -*- tuareg -*- *) + +open StdLabels +open Printf + +let nl () = printf "\n" + +let supported_versions = [ + ("402", "4.02"); + ("403", "4.03"); + ("404", "4.04"); + ("405", "4.05"); + ("406", "4.06"); + ("407", "4.07"); + ("408", "4.08"); + ("409", "4.09"); + ("410", "4.10"); + ("411", "4.11"); +] + +let qualified_types = [ + "Parsetree", + [ "structure" + ; "signature" + ; "toplevel_phrase" + ; "core_type" + ; "expression" + ; "pattern" + ; "case" + ; "type_declaration" + ; "type_extension" + ; "extension_constructor" + ]; + + "Outcometree", + [ "out_value" + ; "out_type" + ; "out_class_type" + ; "out_module_type" + ; "out_sig_item" + ; "out_type_extension" + ; "out_phrase" + ]; + + "Ast_mapper", + [ "mapper" + ]; +] + +let all_types = List.concat (List.map ~f:snd qualified_types) + +let foreach_module f = + nl (); + List.iter qualified_types ~f:(fun (m, types) -> f m types) + +let foreach_type f = + foreach_module (fun m -> List.iter ~f:(f m)) + +let foreach_version f = + nl (); + List.iter supported_versions ~f:(fun (suffix, version) -> f suffix version) + +let foreach_version_pair f = + nl (); + let rec aux = function + | (x,_) :: ((y,_) :: _ as tail) -> f x y; aux tail + | [_] | [] -> () + in + aux supported_versions + +let with_then_and () = + let first = ref true in fun oc -> + output_string oc (if !first then "with" else "and"); + first := false diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_406_and_lt_408.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_406_and_lt_408.ml new file mode 100644 index 000000000..fc4ac8b1c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_406_and_lt_408.ml @@ -0,0 +1,19 @@ +let error_of_exn exn = + match Location.error_of_exn exn with + | Some (`Ok exn) -> Some exn + | Some `Already_displayed -> None + | None -> None + +let get_load_paths () = + !Config.load_path + +let load_path_init l = + Config.load_path := l + +let get_unboxed_types () = + !Clflags.unboxed_types + +let set_unboxed_types b = + Clflags.unboxed_types := b + +let may_map = Misc.may_map diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_408_and_lt_410.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_408_and_lt_410.ml new file mode 100644 index 000000000..ec9294789 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_408_and_lt_410.ml @@ -0,0 +1,19 @@ +let error_of_exn exn = + match Location.error_of_exn exn with + | Some (`Ok exn) -> Some exn + | Some `Already_displayed -> None + | None -> None + +let get_load_paths () = + Load_path.get_paths () + +let load_path_init l = + Load_path.init l + +let get_unboxed_types () = + !Clflags.unboxed_types + +let set_unboxed_types b = + Clflags.unboxed_types := b + +let may_map = Misc.may_map diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_410.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_410.ml new file mode 100644 index 000000000..3c732e399 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/ge_410.ml @@ -0,0 +1,19 @@ +let error_of_exn exn = + match Location.error_of_exn exn with + | Some (`Ok exn) -> Some exn + | Some `Already_displayed -> None + | None -> None + +let get_load_paths () = + Load_path.get_paths () + +let load_path_init l = + Load_path.init l + +let get_unboxed_types () = + !Clflags.unboxed_types + +let set_unboxed_types b = + Clflags.unboxed_types := b + +let may_map = Option.map diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/lt_406.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/lt_406.ml new file mode 100644 index 000000000..7fe780266 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/compiler-functions/lt_406.ml @@ -0,0 +1,15 @@ +let error_of_exn = Location.error_of_exn + +let get_load_paths () = + !Config.load_path + +let load_path_init l = + Config.load_path := l + +let get_unboxed_types () = + false + +let set_unboxed_types _b = + () + +let may_map = Misc.may_map diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/config/gen.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/config/gen.ml new file mode 100644 index 000000000..7a190cb01 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/config/gen.ml @@ -0,0 +1,34 @@ +let write fn s = + let oc = open_out fn in + output_string oc s; + close_out oc + +let () = + let ocaml_version_str = Sys.argv.(1) in + let ocaml_version = + Scanf.sscanf ocaml_version_str "%u.%u" (fun a b -> (a, b)) + in + write "ast-version" + (match ocaml_version with + | (4, 02) -> "402" + | (4, 03) -> "403" + | (4, 04) -> "404" + | (4, 05) -> "405" + | (4, 06) -> "406" + | (4, 07) -> "407" + | (4, 08) -> "408" + | (4, 09) -> "409" + | (4, 10) -> "410" + | (4, 11) -> "411" + | _ -> + Printf.eprintf "Unkown OCaml version %s\n" ocaml_version_str; + exit 1); + write "compiler-functions-file" + (if ocaml_version < (4, 06) then + "lt_406.ml" + else if ocaml_version < (4, 08) then + "ge_406_and_lt_408.ml" + else if ocaml_version < (4, 10) then + "ge_408_and_lt_410.ml" + else + "ge_410.ml") diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/dune new file mode 100644 index 000000000..10aaab0f2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/dune @@ -0,0 +1,31 @@ +(library + (name reason_migrate_parsetree) + (public_name reason.ocaml-migrate-parsetree) + ; Changed for reason to avoid conflicting modules at link time between + ; omp and reason itself. + (wrapped true) + ; (wrapped + ; (transition "Access modules via the Migrate_parsetree toplevel module")) + (libraries compiler-libs.common result ppx_derivers) + (modules :standard \ migrate_parsetree_driver_main) + (preprocess (action (run %{exe:../tools/pp.exe} %{read:ast-version} %{input-file}))) + (ppx.driver + (main Migrate_parsetree.Driver.run_main) + (flags --dump-ast) + (lint_flags --null))) + +(library + (name migrate_parsetree_driver_main) + (public_name reason.ocaml-migrate-parsetree.driver-main) + (modules migrate_parsetree_driver_main) + (library_flags -linkall) + (libraries reason_migrate_parsetree)) + +(rule + (copy# + compiler-functions/%{read:compiler-functions-file} + migrate_parsetree_compiler_functions.ml)) + +(rule + (targets ast-version compiler-functions-file) + (action (run %{ocaml} %{dep:config/gen.ml} %{ocaml_version}))) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/locations.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/locations.ml new file mode 100644 index 000000000..24afce5fb --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/locations.ml @@ -0,0 +1,135 @@ +type old_location_error (*IF_NOT_AT_LEAST 408 = Location.error *) = { + loc: Location.t; + msg: string; + sub: old_location_error list; + if_highlight: string; + } + +type location_msg = (Format.formatter -> unit) Location.loc + +type location_report_kind (*IF_AT_LEAST 408 = Location.report_kind *) = + | Report_error + | Report_warning of string + | Report_warning_as_error of string + | Report_alert of string + | Report_alert_as_error of string + +type location_report (*IF_AT_LEAST 408 = Location.report *) = { + kind : location_report_kind; + main : location_msg; + sub : location_msg list; +} + +type location_error (*IF_AT_LEAST 408 = Location.error *) (*IF_NOT_AT_LEAST 408 = old_location_error *) + +type error_type = [`Report of location_report | `Old_error of old_location_error] + +let error_type_of_location_error : location_error -> error_type = fun x -> + (*IF_AT_LEAST 408 `Report x *) + (*IF_NOT_AT_LEAST 408 `Old_error x *) + +let location_error_of_exn : exn -> location_error = fun exn -> + (*IF_AT_LEAST 408 match Location.error_of_exn exn with None | Some `Already_displayed -> raise exn | Some (`Ok e) -> e *) + (*IF_NOT_AT_LEAST 408 match Migrate_parsetree_compiler_functions.error_of_exn exn with None -> raise exn | Some e -> e*) + +let extension_of_error ~mk_pstr ~mk_extension ~mk_string_constant (error : location_error) = + match error_type_of_location_error error with + | `Old_error old_error -> + let rec extension_of_old_error ({loc; msg; if_highlight = _; sub} : old_location_error) = + { Location.loc; txt = "ocaml.error" }, + mk_pstr ((mk_string_constant msg) :: + (List.map (fun ext -> mk_extension (extension_of_old_error ext)) sub)) in + extension_of_old_error old_error + | `Report report -> + let extension_of_report ({kind; main; sub} : location_report) = + if kind <> Report_error then + raise (Invalid_argument "extension_of_error: expected kind Report_error"); + let str_of_pp pp_msg = Format.asprintf "%t" pp_msg in + let extension_of_sub (sub : location_msg) = + { Location.loc = sub.loc; txt = "ocaml.error" }, + mk_pstr ([mk_string_constant (str_of_pp sub.txt)]) + in + { Location.loc = main.loc; txt = "ocaml.error" }, + mk_pstr (mk_string_constant (str_of_pp main.txt) :: + List.map (fun msg -> mk_extension (extension_of_sub msg)) sub) in + extension_of_report report + +let error_of_exn exn = + try Some (location_error_of_exn exn) with _ -> None + +let register_error_of_exn f = Location.register_error_of_exn f + +let report_exception ppf exn = Location.report_exception ppf exn + +let errorf ~loc fmt = Location.errorf ~loc ~sub:[] fmt + +let raise_errorf ?(loc = Location.none) fmt = Location.raise_errorf ~loc ~sub:[] fmt + +let _get_error_message_old location_error = + location_error.msg + +let _get_error_message_new location_error = + let buff = Buffer.create 128 in + let ppf = Format.formatter_of_buffer buff in + location_error.main.txt ppf; + Format.pp_print_flush ppf (); + Buffer.contents buff + +let get_error_message location_error = + (*IF_NOT_AT_LEAST 408 _get_error_message_old location_error*) + (*IF_AT_LEAST 408 _get_error_message_new location_error*) + +let _set_error_message_old location_error msg = + { location_error with msg; } + +let _set_error_message_new location_error msg = + let txt ppf = Format.pp_print_string ppf msg in + let main = { location_error.main with txt; } in + { location_error with main } + +let set_error_message location_error msg = + (*IF_NOT_AT_LEAST 408 _set_error_message_old location_error msg*) + (*IF_AT_LEAST 408 _set_error_message_new location_error msg*) + +let make_error_of_message_old ~loc msg ~sub = + let sub = List.map (fun (loc, msg) -> { loc; msg; sub = []; if_highlight = msg; }) sub in + { loc; msg; sub; if_highlight = msg; } + +let make_error_of_message_new ~loc msg ~sub = + let mk_txt x ppf = Format.pp_print_string ppf x in + let mk loc x = { Location.loc; txt = mk_txt x; } in + { kind = Report_error; + main = mk loc msg; + sub = List.map (fun (loc, msg) -> mk loc msg) sub; } + +let make_error_of_message ~loc msg ~sub = + (*IF_NOT_AT_LEAST 408 make_error_of_message_old ~loc msg ~sub*) + (*IF_AT_LEAST 408 make_error_of_message_new ~loc msg ~sub*) + +let print_error ppf err = + (*IF_NOT_AT_LEAST 408 Location.report_error ppf err*) + (*IF_AT_LEAST 408 Location.print_report ppf err*) + +module type Helpers_intf = sig + type nonrec location_error = location_error + val error_of_exn : exn -> location_error option + val register_error_of_exn : (exn -> location_error option) -> unit + val report_exception : Format.formatter -> exn -> unit + val get_error_message : location_error -> string + val set_error_message : location_error -> string -> location_error + val make_error_of_message : loc:Location.t -> string -> sub:(Location.t * string) list -> location_error + val print_error : Format.formatter -> location_error -> unit + val raise_error : location_error -> 'a +end + +module Helpers_impl = struct + type nonrec location_error = location_error + let error_of_exn = error_of_exn + let register_error_of_exn = register_error_of_exn + let report_exception = report_exception + let get_error_message = get_error_message + let set_error_message = set_error_message + let make_error_of_message = make_error_of_message + let print_error = print_error + let raise_error err = raise (Location.Error err) +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403.ml new file mode 100644 index 000000000..b67d68dff --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_402_403_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + (*$*) + payload + } as mapper) -> + let module R = Migrate_parsetree_403_402_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + (*$*) + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload Location.none x))) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403_migrate.ml new file mode 100644 index 000000000..bda5b2f33 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_402_403_migrate.ml @@ -0,0 +1,1884 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_402 +module To = Ast_403 + +let extract_predef_option label typ = + let open From in + let open Longident in + match label, typ.Parsetree.ptyp_desc with + | To.Asttypes.Optional _, + From.Parsetree.Ptyp_constr ( + {Location.txt = Ldot (Lident "*predef*", "option"); _}, [d]) -> + d + | _ -> typ + +let rec copy_expression : + From.Parsetree.expression -> + To.Parsetree.expression + = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = + (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> + To.Parsetree.expression_desc + = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant + (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc + copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), x1) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert + (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy + (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (x0, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack + (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension + (copy_extension x0) + +and copy_direction_flag : + From.Asttypes.direction_flag -> + To.Asttypes.direction_flag + = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = + (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = + (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> + To.Parsetree.value_binding + = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = + (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = + (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = + (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> + To.Parsetree.pattern_desc + = + function + | From.Parsetree.Ppat_any -> + To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant + (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc + copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident + x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy + (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception + (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension + (copy_extension x0) + +and copy_core_type : + From.Parsetree.core_type -> + To.Parsetree.core_type + = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = + (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> + To.Parsetree.core_type_desc + = + function + | From.Parsetree.Ptyp_any -> + To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> + To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + let label = copy_arg_label x0 in + To.Parsetree.Ptyp_arrow + (label, + copy_core_type (extract_predef_option label x1), + copy_core_type x2) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option + (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package + (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension + (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> + To.Parsetree.package_type + = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> + To.Parsetree.row_field + = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit + (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> + To.Parsetree.attributes + = fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> + To.Parsetree.attribute + = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr + (copy_structure x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp + (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> + To.Parsetree.structure + = fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> + To.Parsetree.structure_item + = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = + (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type x0 -> + let recflag, types = type_declarations x0 in + To.Parsetree.Pstr_type (recflag, types) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute + (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos + copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> + To.Parsetree.class_declaration + = + fun x -> + copy_class_infos + copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> + To.Parsetree.class_expr + = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = + (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> + To.Parsetree.class_expr_desc + = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension + (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> + To.Parsetree.class_structure + = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> + To.Parsetree.class_field + = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = + (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> + To.Parsetree.class_field_desc + = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> x) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute + (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension + (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> + To.Parsetree.class_field_kind + = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual + (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> + To.Parsetree.module_binding + = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = + (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> + To.Parsetree.module_expr + = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = + (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> + To.Parsetree.module_expr_desc + = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure + (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack + (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension + (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> + To.Parsetree.module_type + = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = + (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> + To.Parsetree.module_type_desc + = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature + (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof + (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension + (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident + x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> + To.Parsetree.with_constraint + = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc + copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc + copy_longident x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc + copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> + To.Parsetree.signature + = fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> + To.Parsetree.signature_item + = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = + (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type x0 -> + let recflag, types = type_declarations x0 in + To.Parsetree.Psig_type (recflag, types) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute + (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> + To.Parsetree.class_description + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> + To.Parsetree.class_type + = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = + (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> + To.Parsetree.class_type_desc + = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + let label = copy_arg_label x0 in + To.Parsetree.Pcty_arrow + (label, + copy_core_type (extract_predef_option label x1), + copy_class_type x2) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension + (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> + To.Parsetree.class_signature + = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field + pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> + To.Parsetree.class_type_field + = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = + (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit + (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute + (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension + (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> + To.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 From.Parsetree.class_infos -> + 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = + (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> + To.Asttypes.virtual_flag + = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos + copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = + (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> + To.Parsetree.open_description + = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident + popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = + (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> + To.Asttypes.override_flag + = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = + (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = + (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> + To.Parsetree.type_extension + = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident + ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = + (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + (To.Parsetree.Pcstr_tuple (List.map copy_core_type x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident + x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> + To.Parsetree.type_declaration + = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = + (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> + To.Asttypes.private_flag + = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> + To.Parsetree.type_kind + = + function + | From.Parsetree.Ptype_abstract -> + To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> + To.Parsetree.Ptype_open + +and copy_label_declaration : + From.Parsetree.label_declaration -> + To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = + (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> + To.Asttypes.mutable_flag + = + function + | From.Asttypes.Immutable -> + To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + To.Parsetree.Pcstr_tuple (List.map copy_core_type pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = + (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> + To.Asttypes.Covariant + | From.Asttypes.Contravariant -> + To.Asttypes.Contravariant + | From.Asttypes.Invariant -> + To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> + To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = + (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = + (copy_location pval_loc) + } + +and copy_closed_flag : + From.Asttypes.closed_flag -> + To.Asttypes.closed_flag + = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = + fun x -> + x + +and copy_arg_label : + From.Asttypes.label -> To.Asttypes.arg_label = + fun x -> + if x <> "" then + if x.[0] = '?' then To.Asttypes.Optional (String.sub x 1 (String.length x - 1)) + else To.Asttypes.Labelled x + else + To.Asttypes.Nolabel + + + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> + To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> + To.Asttypes.Recursive + +and copy_constant : + From.Asttypes.constant -> To.Parsetree.constant = + function + | From.Asttypes.Const_int x0 -> + To.Parsetree.Pconst_integer (string_of_int x0, None) + | From.Asttypes.Const_char x0 -> + To.Parsetree.Pconst_char x0 + | From.Asttypes.Const_string (x0,x1) -> + To.Parsetree.Pconst_string + (x0, (copy_option (fun x -> x) x1)) + | From.Asttypes.Const_float x0 -> + To.Parsetree.Pconst_float (x0, None) + | From.Asttypes.Const_int32 x0 -> + To.Parsetree.Pconst_integer (Int32.to_string x0, Some 'l') + | From.Asttypes.Const_int64 x0 -> + To.Parsetree.Pconst_integer (Int64.to_string x0, Some 'L') + | From.Asttypes.Const_nativeint x0 -> + To.Parsetree.Pconst_integer (Nativeint.to_string x0, Some 'n') + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : + From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> + To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun + { From.Asttypes.txt = txt; + From.Asttypes.loc = loc } + -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : + From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +and type_declarations types = + let is_nonrec (attr,_) = attr.To.Location.txt = "nonrec" in + match List.map copy_type_declaration types with + | (x :: xs) + when List.exists is_nonrec x.To.Parsetree.ptype_attributes -> + let ptype_attributes = + List.filter (fun x -> not (is_nonrec x)) x.To.Parsetree.ptype_attributes + in + (To.Asttypes.Nonrecursive, + {x with To.Parsetree.ptype_attributes} :: xs) + | types -> (To.Asttypes.Recursive, types) + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value (x0,x1,x2) -> + To.Outcometree.Osig_value { To.Outcometree. + oval_name = x0; + oval_type = copy_out_type x1; + oval_prims = List.map (fun x -> x) x2; + oval_attributes = [] } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_private_flag otype_private); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs); + To.Outcometree.otype_immediate = false; + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_private_flag oext_private) + } + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_name (x0,x1) -> + To.Outcometree.Ovar_name + ((copy_out_ident x0), + (List.map copy_out_type x1)) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int x0 -> To.Parsetree.Pdir_int (string_of_int x0, None) + | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402.ml new file mode 100644 index 000000000..d24b9674a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_403_402_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + (*$*) + payload + } as mapper) -> + let module R = Migrate_parsetree_402_403_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + (*$*) + payload = (fun _ x -> copy_payload Location.none (payload mapper (R.copy_payload x))) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402_migrate.ml new file mode 100644 index 000000000..efdd06aa0 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_402_migrate.ml @@ -0,0 +1,1941 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Def = Migrate_parsetree_def +module From = Ast_403 +module To = Ast_402 + +let inject_predef_option label d = + let open To in + let open Parsetree in + match label with + | From.Asttypes.Optional _ -> + let loc = {d.ptyp_loc with Location.loc_ghost = true} in + let txt = Longident.Ldot (Longident.Lident "*predef*", "option") in + let ident = {Location. txt; loc} in + { ptyp_desc = Ptyp_constr(ident,[d]); ptyp_loc = loc; ptyp_attributes = []} + | _ -> d + +let from_loc {From.Location. txt = _; loc} = loc + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let rec copy_expression : + From.Parsetree.expression -> + To.Parsetree.expression + = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_loc pexp_desc); + To.Parsetree.pexp_loc = + (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc loc : + From.Parsetree.expression_desc -> + To.Parsetree.expression_desc + = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant + (copy_constant loc x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc + copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), x1) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert + (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy + (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (x0, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack + (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension + (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> + migration_error loc Def.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> + To.Asttypes.direction_flag + = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = + (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = + (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> + To.Parsetree.value_binding + = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = + (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = + (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_loc ppat_desc); + To.Parsetree.ppat_loc = + (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc loc : + From.Parsetree.pattern_desc -> + To.Parsetree.pattern_desc + = + function + | From.Parsetree.Ppat_any -> + To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant + (copy_constant loc x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant loc x0), + (copy_constant loc x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc + copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident + x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy + (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception + (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension + (copy_extension x0) + +and copy_core_type : + From.Parsetree.core_type -> + To.Parsetree.core_type + = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = + (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> + To.Parsetree.core_type_desc + = + function + | From.Parsetree.Ptyp_any -> + To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> + To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + inject_predef_option x0 (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option + (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package + (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension + (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> + To.Parsetree.package_type + = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> + To.Parsetree.row_field + = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit + (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> + To.Parsetree.attributes + = fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> + To.Parsetree.attribute + = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload (from_loc x0) x1)) + +and copy_payload loc : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr + (copy_structure x0) + | From.Parsetree.PSig _x0 -> + migration_error loc Def.PSig + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp + (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> + To.Parsetree.structure + = fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> + To.Parsetree.structure_item + = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = + (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type (type_declarations x0 x1) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute + (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos + copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> + To.Parsetree.class_declaration + = + fun x -> + copy_class_infos + copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> + To.Parsetree.class_expr + = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = + (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> + To.Parsetree.class_expr_desc + = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension + (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> + To.Parsetree.class_structure + = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> + To.Parsetree.class_field + = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = + (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> + To.Parsetree.class_field_desc + = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> x) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute + (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension + (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> + To.Parsetree.class_field_kind + = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual + (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> + To.Parsetree.module_binding + = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = + (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> + To.Parsetree.module_expr + = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = + (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> + To.Parsetree.module_expr_desc + = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure + (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack + (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension + (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> + To.Parsetree.module_type + = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = + (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> + To.Parsetree.module_type_desc + = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature + (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof + (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension + (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident + x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> + To.Parsetree.with_constraint + = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc + copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc + copy_longident x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc + copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> + To.Parsetree.signature + = fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> + To.Parsetree.signature_item + = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = + (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type (type_declarations x0 x1) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute + (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> + To.Parsetree.class_description + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> + To.Parsetree.class_type + = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = + (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> + To.Parsetree.class_type_desc + = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + inject_predef_option x0 (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension + (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> + To.Parsetree.class_signature + = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field + pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> + To.Parsetree.class_type_field + = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = + (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit + (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute + (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension + (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> + To.Parsetree.extension + = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload (from_loc x0) x1)) + +and copy_class_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.class_infos -> + 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = + (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> + To.Asttypes.virtual_flag + = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos + copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = + (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> + To.Parsetree.open_description + = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident + popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = + (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> + To.Asttypes.override_flag + = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = + (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = + (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> + To.Parsetree.type_extension + = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident + ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind (from_loc pext_name) pext_kind); + To.Parsetree.pext_loc = + (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind loc : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments loc x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident + x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> + To.Parsetree.type_declaration + = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = + (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> + To.Asttypes.private_flag + = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> + To.Parsetree.type_kind + = + function + | From.Parsetree.Ptype_abstract -> + To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> + To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments (from_loc pcd_name) pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = + (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments loc : + From.Parsetree.constructor_arguments -> + To.Parsetree.core_type list + = + function + | From.Parsetree.Pcstr_tuple x0 -> + List.map copy_core_type x0 + | From.Parsetree.Pcstr_record _x0 -> + migration_error loc Def.Pcstr_record + +and copy_label_declaration : + From.Parsetree.label_declaration -> + To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = + (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> + To.Asttypes.mutable_flag + = + function + | From.Asttypes.Immutable -> + To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> + To.Asttypes.Covariant + | From.Asttypes.Contravariant -> + To.Asttypes.Contravariant + | From.Asttypes.Invariant -> + To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> + To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = + (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = + (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> string + = + function + | From.Asttypes.Nolabel -> "" + | From.Asttypes.Labelled x0 -> x0 + | From.Asttypes.Optional x0 -> "?" ^ x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> + To.Asttypes.closed_flag + = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = + fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> + To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> + To.Asttypes.Recursive + +and copy_constant loc : + From.Parsetree.constant -> To.Asttypes.constant + = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + begin match x1 with + | None -> To.Asttypes.Const_int (int_of_string x0) + | Some 'l' -> + To.Asttypes.Const_int32 (Int32.of_string x0) + | Some 'L' -> + To.Asttypes.Const_int64 (Int64.of_string x0) + | Some 'n' -> + To.Asttypes.Const_nativeint (Nativeint.of_string x0) + | Some _ -> migration_error loc Def.Pconst_integer + end + | From.Parsetree.Pconst_char x0 -> + To.Asttypes.Const_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Asttypes.Const_string (x0,x1) + | From.Parsetree.Pconst_float (x0,x1) -> + begin match x1 with + | None -> To.Asttypes.Const_float x0 + | Some _ -> migration_error loc Def.Pconst_float + end + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = function + | From.Longident.Lident x0 -> + To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot + ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun + { From.Asttypes.txt = txt; + From.Asttypes.loc = loc } + -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = copy_location loc + } + +and copy_location : + From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +and type_declarations recflag types = + match + (recflag, List.map copy_type_declaration types) + with + | From.Asttypes.Recursive, types -> types + | From.Asttypes.Nonrecursive, [] -> [] + | From.Asttypes.Nonrecursive, (x :: xs) -> + let pos = {Lexing. pos_fname = "_none_"; pos_lnum = 1; + pos_bol = 0; pos_cnum = -1} in + let loc = {To.Location. loc_start = pos; loc_end = pos; + loc_ghost = true} in + let ptype_attributes = + ({To.Asttypes.txt = "nonrec"; loc}, To.Parsetree.PStr []) :: + x.To.Parsetree.ptype_attributes + in + {x with To.Parsetree.ptype_attributes} :: xs + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> copy_out_val_decl x0 + | From.Outcometree.Osig_ellipsis -> + To.Outcometree.Osig_value ("...", To.Outcometree.Otyp_abstract, []) + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_sig_item = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = _ } + -> + To.Outcometree.Osig_value ( + oval_name, + copy_out_type oval_type, + List.map (fun x -> x) oval_prims + ) + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = _; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + (*To.Outcometree.otype_immediate = (copy_bool otype_immediate);*) + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (_x0,_x1) -> + To.Outcometree.Otyp_abstract + (*To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1))*) + +(*and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name }*) + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_name (x0,x1) -> + To.Outcometree.Ovar_name + ((copy_out_ident x0), + (List.map copy_out_type x1)) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> + To.Parsetree.directive_argument + = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,_x1) -> + To.Parsetree.Pdir_int (int_of_string x0) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404.ml new file mode 100644 index 000000000..06a5a6831 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_403_404_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_404_403_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404_migrate.ml new file mode 100644 index 000000000..2fa97c316 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_403_404_migrate.ml @@ -0,0 +1,1907 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_403 +module To = Ast_404 + +let rec copy_expression : + From.Parsetree.expression -> + To.Parsetree.expression + = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = + (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> + To.Parsetree.expression_desc + = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant + (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc + copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), x1) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert + (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy + (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (x0, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack + (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension + (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> + To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> + To.Asttypes.direction_flag + = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = + (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = + (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> + To.Parsetree.value_binding + = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = + (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = + (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = + (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> + To.Parsetree.pattern_desc + = + function + | From.Parsetree.Ppat_any -> + To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant + (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc + copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident + x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy + (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception + (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension + (copy_extension x0) + +and copy_core_type : + From.Parsetree.core_type -> + To.Parsetree.core_type + = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = + (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> + To.Parsetree.core_type_desc + = + function + | From.Parsetree.Ptyp_any -> + To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> + To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option + (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package + (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension + (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> + To.Parsetree.package_type + = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> + To.Parsetree.row_field + = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit + (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> + To.Parsetree.attributes + = fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> + To.Parsetree.attribute + = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr + (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig + (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp + (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> + To.Parsetree.structure + = fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> + To.Parsetree.structure_item + = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = + (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute + (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos + copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> + To.Parsetree.class_declaration + = + fun x -> + copy_class_infos + copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> + To.Parsetree.class_expr + = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = + (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> + To.Parsetree.class_expr_desc + = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension + (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> + To.Parsetree.class_structure + = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> + To.Parsetree.class_field + = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = + (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> + To.Parsetree.class_field_desc + = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> x) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute + (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension + (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> + To.Parsetree.class_field_kind + = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual + (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> + To.Parsetree.module_binding + = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = + (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> + To.Parsetree.module_expr + = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = + (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> + To.Parsetree.module_expr_desc + = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure + (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack + (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension + (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> + To.Parsetree.module_type + = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = + (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> + To.Parsetree.module_type_desc + = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature + (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof + (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension + (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident + x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> + To.Parsetree.with_constraint + = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc + copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc + copy_longident x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc + copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> + To.Parsetree.signature + = fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> + To.Parsetree.signature_item + = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = + (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute + (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> + To.Parsetree.class_description + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> + To.Parsetree.class_type + = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = + (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> + To.Parsetree.class_type_desc + = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension + (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> + To.Parsetree.class_signature + = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field + pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> + To.Parsetree.class_type_field + = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = + (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit + (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute + (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension + (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> + To.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 From.Parsetree.class_infos -> + 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = + (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> + To.Asttypes.virtual_flag + = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos + copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = + (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> + To.Parsetree.open_description + = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident + popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = + (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> + To.Asttypes.override_flag + = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = + (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = + (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> + To.Parsetree.type_extension + = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident + ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = + (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident + x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> + To.Parsetree.type_declaration + = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = + (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> + To.Asttypes.private_flag + = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> + To.Parsetree.type_kind + = + function + | From.Parsetree.Ptype_abstract -> + To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> + To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = + (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> + To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = + (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> + To.Asttypes.mutable_flag + = + function + | From.Asttypes.Immutable -> + To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> + To.Asttypes.Covariant + | From.Asttypes.Contravariant -> + To.Asttypes.Contravariant + | From.Asttypes.Invariant -> + To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> + To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = + (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = + (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label + = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> + To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> + To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> + To.Asttypes.closed_flag + = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = + fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> + To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> + To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant + = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer + (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> + To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string + (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float + (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : + From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> + To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot + ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun + { From.Asttypes.txt = txt; + From.Asttypes.loc = loc } + -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : + From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = false; + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_name (x0,x1) -> + To.Outcometree.Ovar_name + ((copy_out_ident x0), + (List.map copy_out_type x1)) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir (x0, copy_directive_argument x1) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, copy_option (fun x -> x) x1) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403.ml new file mode 100644 index 000000000..4dc190899 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_404_403_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_403_404_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403_migrate.ml new file mode 100644 index 000000000..2f69e3fd4 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_403_migrate.ml @@ -0,0 +1,1916 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Def = Migrate_parsetree_def +module From = Ast_404 +module To = Ast_403 + +let from_loc {From.Location. txt = _; loc} = loc + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let rec copy_expression : + From.Parsetree.expression -> + To.Parsetree.expression + = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_loc pexp_desc); + To.Parsetree.pexp_loc = + (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc loc : + From.Parsetree.expression_desc -> + To.Parsetree.expression_desc + = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant + (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc + copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), x1) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident + x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception _ -> + migration_error loc Def.Pexp_letexception + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert + (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy + (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (x0, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack + (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc + copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension + (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> + To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> + To.Asttypes.direction_flag + = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = + (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = + (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> + To.Parsetree.value_binding + = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = + (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = + (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_loc ppat_desc); + To.Parsetree.ppat_loc = + (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc loc : + From.Parsetree.pattern_desc -> + To.Parsetree.pattern_desc + = + function + | From.Parsetree.Ppat_any -> + To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant + (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc + copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident + x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy + (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception + (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension + (copy_extension x0) + | From.Parsetree.Ppat_open _ -> + migration_error loc Def.Ppat_open +and copy_core_type : + From.Parsetree.core_type -> + To.Parsetree.core_type + = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = + (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> + To.Parsetree.core_type_desc + = + function + | From.Parsetree.Ptyp_any -> + To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> + To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option + (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package + (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension + (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> + To.Parsetree.package_type + = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc + copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> + To.Parsetree.row_field + = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit + (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> + To.Parsetree.attributes + = fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> + To.Parsetree.attribute + = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr + (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig + (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp + (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> + To.Parsetree.structure + = fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> + To.Parsetree.structure_item + = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = + (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute + (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos + copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> + To.Parsetree.class_declaration + = + fun x -> + copy_class_infos + copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> + To.Parsetree.class_expr + = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = + (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> + To.Parsetree.class_expr_desc + = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension + (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> + To.Parsetree.class_structure + = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> + To.Parsetree.class_field + = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = + (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> + To.Parsetree.class_field_desc + = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> x) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute + (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension + (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> + To.Parsetree.class_field_kind + = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual + (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> + To.Parsetree.module_binding + = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = + (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> + To.Parsetree.module_expr + = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = + (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> + To.Parsetree.module_expr_desc + = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure + (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack + (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension + (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> + To.Parsetree.module_type + = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = + (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> + To.Parsetree.module_type_desc + = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident + x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature + (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof + (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension + (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident + x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> + To.Parsetree.with_constraint + = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc + copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc + copy_longident x0), + (copy_loc + copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc + copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> + To.Parsetree.signature + = fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> + To.Parsetree.signature_item + = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = + (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute + (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> + To.Parsetree.class_description + = + fun x -> + copy_class_infos + copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> + To.Parsetree.class_type + = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = + (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> + To.Parsetree.class_type_desc + = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc + copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension + (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> + To.Parsetree.class_signature + = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field + pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> + To.Parsetree.class_type_field + = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = + (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit + (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute + (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension + (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> + To.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 From.Parsetree.class_infos -> + 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = + (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> + To.Asttypes.virtual_flag + = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos + copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = + (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> + To.Parsetree.open_description + = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident + popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = + (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> + To.Asttypes.override_flag + = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = + (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = + (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> + To.Parsetree.type_extension + = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident + ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = + (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident + x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> + To.Parsetree.type_declaration + = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = + (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> + To.Asttypes.private_flag + = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> + To.Parsetree.type_kind + = + function + | From.Parsetree.Ptype_abstract -> + To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> + To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = + (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> + To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = + (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> + To.Asttypes.mutable_flag + = + function + | From.Asttypes.Immutable -> + To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> + To.Asttypes.Covariant + | From.Asttypes.Contravariant -> + To.Asttypes.Contravariant + | From.Asttypes.Invariant -> + To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> + To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = + (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = + (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label + = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> + To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> + To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> + To.Asttypes.closed_flag + = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = + fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> + To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> + To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant + = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer + (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> + To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string + (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float + (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : + From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> + To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot + ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun + { From.Asttypes.txt = txt; + From.Asttypes.loc = loc } + -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : + From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = _otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_name (x0,x1) -> + To.Outcometree.Ovar_name + ((copy_out_ident x0), + (List.map copy_out_type x1)) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405.ml new file mode 100644 index 000000000..ad6594ee6 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_404_405_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_405_404_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405_migrate.ml new file mode 100644 index 000000000..d62423a8d --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_404_405_migrate.ml @@ -0,0 +1,1716 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_404 +module To = Ast_405 + +let noloc x = { Location. txt = x; loc = Location.none } + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), noloc x1) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (noloc x0, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (noloc x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> noloc x) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> noloc x) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (noloc x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (noloc x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_name (x0,x1) -> + To.Outcometree.Ovar_typ + (To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1))) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404.ml new file mode 100644 index 000000000..82cb5cd5d --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_405_404_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_404_405_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404_migrate.ml new file mode 100644 index 000000000..e34ac74c5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_404_migrate.ml @@ -0,0 +1,1716 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_405 +module To = Ast_404 + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), x1.From.Asttypes.txt) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + (x0.From.Asttypes.txt, (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + (x0.From.Asttypes.txt, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> x.From.Asttypes.txt) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> x.From.Asttypes.txt) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc (fun x -> x) x0), + (copy_loc copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (x0.From.Asttypes.txt, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (x0.From.Asttypes.txt, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ (From.Outcometree.Otyp_constr (id,tyl)) -> + To.Outcometree.Ovar_name (copy_out_ident id, List.map copy_out_type tyl) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_name + (To.Outcometree.Oide_ident "", [copy_out_type x0]) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406.ml new file mode 100644 index 000000000..c3e84c754 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_405_406_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_406_405_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406_migrate.ml new file mode 100644 index 000000000..c795a1d5c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_405_406_migrate.ml @@ -0,0 +1,1714 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_405 +module To = Ast_406 + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc (fun x -> x) x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (fun x -> + let (x0,x1,x2) = x in + To.Parsetree.Otag + (copy_loc (fun x -> x) x0, (copy_attributes x1), + (copy_core_type x2))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + (({ txt = copy_label x0; loc = Location.none; }), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (copy_loc (fun x -> x)) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst x0 -> + To.Parsetree.Pwith_typesubst + (copy_loc (fun x -> Longident.Lident x) x0.From.Parsetree.ptype_name, + copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + (copy_loc (fun x -> Longident.Lident x) x0, + copy_loc copy_longident x1) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string x0 -> + To.Outcometree.Oval_string (x0, max_int, Ostr_string) + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405.ml new file mode 100644 index 000000000..944378c8b --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_406_405_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_405_406_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405_migrate.ml new file mode 100644 index 000000000..b0757d534 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_405_migrate.ml @@ -0,0 +1,1724 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Def = Migrate_parsetree_def +module From = Ast_406 +module To = Ast_405 + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc (fun x -> x) x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map + (function + | From.Parsetree.Otag (x0,x1,x2) -> + (copy_loc (fun x -> x) x0, (copy_attributes x1), + (copy_core_type x2)) + | From.Parsetree.Oinherit _ -> + migration_error Location.none Def.Oinherit) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + ((copy_label x0.txt), + (copy_attributes x1), (copy_bool x2), + (List.map copy_core_type x3)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + | From.Parsetree.Pcl_open (_, loc, _) -> + migration_error loc.From.Location.loc Def.Pcl_open + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (copy_loc (fun x -> x)) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst ({ txt = Longident.Lident _; _ }, x0) -> + To.Parsetree.Pwith_typesubst + (copy_type_declaration x0) + | From.Parsetree.Pwith_modsubst ({ txt = Longident.Lident x0; loc },x1) -> + To.Parsetree.Pwith_modsubst + ({ txt = x0; loc }, (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst ({ loc; _ }, _x0) -> + migration_error loc Pwith_typesubst_longident + | From.Parsetree.Pwith_modsubst ({ loc; _ },_x1) -> + migration_error loc Pwith_modsubst_longident + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + | From.Parsetree.Pcty_open (_, loc, _) -> + migration_error loc.From.Location.loc Def.Pcty_open + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string (x0, _, _) -> To.Outcometree.Oval_string x0 + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407.ml new file mode 100644 index 000000000..3159e5ce5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_406_407_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_407_406_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407_migrate.ml new file mode 100644 index 000000000..f96ed71eb --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_406_407_migrate.ml @@ -0,0 +1,1734 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module Def = Migrate_parsetree_def +module From = Ast_406 +module To = Ast_407 + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc (fun x -> x) x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + (List.map copy_object_field x0, + copy_closed_flag x1) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + (copy_loc copy_label x0, + copy_attributes x1, copy_bool x2, + List.map copy_core_type x3) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + From.Parsetree.object_field -> To.Parsetree.object_field = + function + | From.Parsetree.Otag (x0,x1,x2) -> + To.Parsetree.Otag (copy_loc (fun x -> x) x0, + copy_attributes x1, + copy_core_type x2) + | From.Parsetree.Oinherit x -> To.Parsetree.Oinherit (copy_core_type x) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + | From.Parsetree.Pcl_open (ovf, loc, ce) -> + To.Parsetree.Pcl_open (copy_override_flag ovf, + copy_loc copy_longident loc, + copy_class_expr ce) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (copy_loc (fun x -> x)) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst (x0, x1) -> + To.Parsetree.Pwith_typesubst + (copy_loc copy_longident x0, copy_type_declaration x1) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + | From.Parsetree.Pcty_open (ovf, loc, cty) -> + To.Parsetree.Pcty_open (copy_override_flag ovf, + copy_loc copy_longident loc, + copy_class_type cty) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_string : + From.Outcometree.out_string -> To.Outcometree.out_string = + function + | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string + | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string (x0, x1, x2) -> + To.Outcometree.Oval_string (x0, x1, copy_out_string x2) + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406.ml new file mode 100644 index 000000000..67831d72c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406.ml @@ -0,0 +1,130 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_407_406_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module R = Migrate_parsetree_406_407_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406_migrate.ml new file mode 100644 index 000000000..047c8c58a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_406_migrate.ml @@ -0,0 +1,1730 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Alain Frisch, LexiFi *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +module From = Ast_407 +module To = Ast_406 + +let rec copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc (fun x -> x) x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ((copy_override_flag x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + (List.map copy_object_field x0, + copy_closed_flag x1) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + To.Parsetree.Rtag + (copy_loc copy_label x0, + copy_attributes x1, copy_bool x2, + List.map copy_core_type x3) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + From.Parsetree.object_field -> To.Parsetree.object_field = + function + | From.Parsetree.Otag (x0,x1,x2) -> + To.Parsetree.Otag (copy_loc (fun x -> x) x0, + copy_attributes x1, + copy_core_type x2) + | From.Parsetree.Oinherit x -> To.Parsetree.Oinherit (copy_core_type x) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (copy_extension_constructor x0) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + To.Parsetree.Pstr_open + (copy_open_description x0) + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + | From.Parsetree.Pcl_open (ovf, loc, ce) -> + To.Parsetree.Pcl_open (copy_override_flag ovf, + copy_loc copy_longident loc, + copy_class_expr ce) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (copy_loc (fun x -> x)) x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc (fun x -> x) x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst (x0, x1) -> + To.Parsetree.Pwith_typesubst + (copy_loc copy_longident x0, copy_type_declaration x1) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + (copy_loc copy_longident x0, copy_loc copy_longident x1) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (copy_extension_constructor x0) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + | From.Parsetree.Pcty_open (ovf, loc, cty) -> + To.Parsetree.Pcty_open (copy_override_flag ovf, + copy_loc copy_longident loc, + copy_class_type cty) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.Parsetree.Pctf_val + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_method x0 -> + To.Parsetree.Pctf_method + (let (x0,x1,x2,x3) = x0 in + (copy_loc (fun x -> x) x0, (copy_private_flag x1), + (copy_virtual_flag x2), + (copy_core_type x3))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.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 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_lid = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_string : + From.Outcometree.out_string -> To.Outcometree.out_string = + function + | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string + | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string (x0, x1, x2) -> + To.Outcometree.Oval_string (x0, x1, copy_out_string x2) + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + (x0, (copy_directive_argument x1)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> To.Parsetree.directive_argument = + function + | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408.ml new file mode 100644 index 000000000..f9af1f5cd --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408.ml @@ -0,0 +1,138 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_407_408_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let migration_error location feature = + raise (Def.Migration_error (feature, location)) in + let module R = Migrate_parsetree_408_407_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + (* The following ones were introduced in 4.08. *) + binding_op = (fun _ x -> migration_error x.pbop_op.Location.loc Def.Pexp_letop); + module_substitution = (fun _ x -> migration_error x.pms_loc Def.Psig_modsubst); + open_declaration = (fun _ x -> migration_error x.popen_loc Def.Pexp_open); + type_exception = (fun _ x -> migration_error x.ptyexn_loc Def.Psig_typesubst); + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408_migrate.ml new file mode 100644 index 000000000..a0429ec92 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_407_408_migrate.ml @@ -0,0 +1,1808 @@ +module From = Ast_407 +module To = Ast_408 + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir (x0,x1) -> + To.Parsetree.Ptop_dir + { To.Parsetree.pdir_name = { To.Location.txt = x0; To.Location.loc = Location.none; }; + To.Parsetree.pdir_arg = copy_directive_argument x1; + To.Parsetree.pdir_loc = Location.none; } + +and copy_directive_argument : + From.Parsetree.directive_argument -> + To.Parsetree.directive_argument option + = + let wrap pdira_desc = + Some { To.Parsetree.pdira_desc; + To.Parsetree.pdira_loc = Location.none; } in + function + | From.Parsetree.Pdir_none -> None + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 |> wrap + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) |> wrap + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) |> wrap + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) |> wrap + +and copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_loc_stack = []; + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), + (copy_loc copy_label x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_label x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1,x2) -> + To.Parsetree.Pexp_open + ({ To.Parsetree.popen_expr = + { To.Parsetree.pmod_desc = To.Parsetree.Pmod_ident (copy_loc copy_longident x1); + To.Parsetree.pmod_loc = x1.Location.loc; + To.Parsetree.pmod_attributes = []; }; + To.Parsetree.popen_override = (copy_override_flag x0); + To.Parsetree.popen_loc = x1.Location.loc; + To.Parsetree.popen_attributes = []; }, + (copy_expression x2)) + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_loc_stack = []; + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_loc_stack = []; + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map copy_object_field x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + function + | From.Parsetree.Rtag (x0,x1,x2,x3) -> + { To.Parsetree.prf_desc = + (To.Parsetree.Rtag + ((copy_loc copy_label x0), + (copy_bool x2), + (List.map copy_core_type x3))); + To.Parsetree.prf_loc = x0.Location.loc; + To.Parsetree.prf_attributes = (copy_attributes x1); } + | From.Parsetree.Rinherit x0 -> + { To.Parsetree.prf_desc = (To.Parsetree.Rinherit (copy_core_type x0)); + To.Parsetree.prf_loc = x0.From.Parsetree.ptyp_loc; + To.Parsetree.prf_attributes = []; } + +and copy_object_field : + From.Parsetree.object_field -> To.Parsetree.object_field = + function + | From.Parsetree.Otag (x0,x1,x2) -> + { To.Parsetree.pof_desc = + (To.Parsetree.Otag + ((copy_loc copy_label x0), + (copy_core_type x2))); + To.Parsetree.pof_loc = x0.Location.loc; + To.Parsetree.pof_attributes = (copy_attributes x1); } + | From.Parsetree.Oinherit x0 -> + { To.Parsetree.pof_desc = (To.Parsetree.Oinherit (copy_core_type x0)); + To.Parsetree.pof_loc = x0.From.Parsetree.ptyp_loc; + To.Parsetree.pof_attributes = []; } + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun x -> + let (x0,x1) = x in + { To.Parsetree.attr_name = copy_loc (fun x -> x) x0; + To.Parsetree.attr_payload = copy_payload x1; + To.Parsetree.attr_loc = x0.Location.loc; } + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + let atat, at = List.partition (function + | {Location.txt=("ocaml.deprecated"|"deprecated");_},_ -> false + | _ -> true) x0.pext_attributes + in + let x0 = { x0 with pext_attributes = at } in + To.Parsetree.Pstr_exception + { To.Parsetree.ptyexn_constructor = (copy_extension_constructor x0); + To.Parsetree.ptyexn_loc = x0.From.Parsetree.pext_loc; + To.Parsetree.ptyexn_attributes = copy_attributes atat } + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open + { From.Parsetree.popen_lid; + From.Parsetree.popen_override; + From.Parsetree.popen_loc; + From.Parsetree.popen_attributes; } -> + To.Parsetree.Pstr_open + { To.Parsetree.popen_expr = + { To.Parsetree.pmod_desc = To.Parsetree.Pmod_ident (copy_loc copy_longident popen_lid); + To.Parsetree.pmod_loc = popen_loc; + To.Parsetree.pmod_attributes = []; }; + To.Parsetree.popen_override = (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = (copy_attributes popen_attributes); + } + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + | From.Parsetree.Pcl_open (x0,x1,x2) -> + To.Parsetree.Pcl_open + ({ To.Parsetree.popen_expr = (copy_loc copy_longident x1); + To.Parsetree.popen_override = (copy_override_flag x0); + To.Parsetree.popen_loc = x1.Location.loc; + To.Parsetree.popen_attributes = []; }, + (copy_class_expr x2)) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + let fields = + List.sort + (fun (a : From.Parsetree.class_field) (b : From.Parsetree.class_field) -> + compare a.pcf_loc.loc_start.pos_cnum b.pcf_loc.loc_start.pos_cnum) + pcstr_fields + in + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> copy_loc (fun x -> x) x) + x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc copy_label x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc copy_label x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst (x0,x1) -> + To.Parsetree.Pwith_typesubst + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + let atat, at = List.partition (function + | {Location.txt=("ocaml.deprecated"|"deprecated");_},_ -> false + | _ -> true) x0.pext_attributes + in + let x0 = { x0 with pext_attributes = at } in + + To.Parsetree.Psig_exception + { To.Parsetree.ptyexn_constructor = (copy_extension_constructor x0); + To.Parsetree.ptyexn_loc = x0.From.Parsetree.pext_loc; + To.Parsetree.ptyexn_attributes = copy_attributes atat; } + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + | From.Parsetree.Pcty_open (x0,x1,x2) -> + To.Parsetree.Pcty_open + ({ To.Parsetree.popen_expr = (copy_loc copy_longident x1); + To.Parsetree.popen_override = (copy_override_flag x0); + To.Parsetree.popen_loc = x1.Location.loc; + To.Parsetree.popen_attributes = []; }, + (copy_class_type x2)) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + let fields = + List.sort + (fun (a : From.Parsetree.class_type_field) (b : From.Parsetree.class_type_field) -> + compare a.pctf_loc.loc_start.pos_cnum b.pctf_loc.loc_start.pos_cnum) + pcsig_fields + in + + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.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))) + | From.Parsetree.Pctf_method x0 -> + To.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))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.Parsetree.extension = + fun x -> + let (x0,x1) = x in + let x1 = + match x0.txt with + | "ocaml.error" | "error" -> + begin match x1 with + | PStr (hd :: _ :: tl) -> From.Parsetree.PStr (hd :: tl) + | _ -> x1 + end + | _ -> x1 in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_class_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_lid = popen_lid; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { + To.Parsetree.popen_expr = + (copy_loc copy_longident popen_lid); + To.Parsetree.popen_override = + (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_loc = ptyext_path.Location.loc; + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + ((To.Outcometree.Oide_ident { To.Outcometree.printed_name = x0; }), + (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_string : + From.Outcometree.out_string -> To.Outcometree.out_string = + function + | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string + | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string (x0, x1, x2) -> + To.Outcometree.Oval_string (x0, x1, copy_out_string x2) + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> + To.Outcometree.Oide_ident + ({ To.Outcometree.printed_name = x0; }) + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407.ml new file mode 100644 index 000000000..050d412e1 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407.ml @@ -0,0 +1,135 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_408_407_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + (*$*) + (* The following ones were introduced in 4.08. *) + binding_op = _; + module_substitution = _; + open_declaration = _; + type_exception = _; + } as mapper) -> + let module R = Migrate_parsetree_407_408_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407_migrate.ml new file mode 100644 index 000000000..a9952e4a9 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_407_migrate.ml @@ -0,0 +1,1819 @@ +module From = Ast_408 +module To = Ast_407 + +module Def = Migrate_parsetree_def + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let rec copy_toplevel_phrase : + From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = + function + | From.Parsetree.Ptop_def x0 -> + To.Parsetree.Ptop_def (copy_structure x0) + | From.Parsetree.Ptop_dir + { From.Parsetree.pdir_name; + From.Parsetree.pdir_arg; + From.Parsetree.pdir_loc = _; } -> + To.Parsetree.Ptop_dir + (pdir_name.Location.txt, + (match pdir_arg with + | None -> To.Parsetree.Pdir_none + | Some arg -> copy_directive_argument arg)) + +and copy_directive_argument : + From.Parsetree.directive_argument -> + To.Parsetree.directive_argument + = + fun + { From.Parsetree.pdira_desc = pdira_desc; + From.Parsetree.pdira_loc = _pdira_loc } + -> + (copy_directive_argument_desc pdira_desc) + +and copy_directive_argument_desc : + From.Parsetree.directive_argument_desc -> + To.Parsetree.directive_argument + = + function + | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 + | From.Parsetree.Pdir_int (x0,x1) -> + To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pdir_ident x0 -> + To.Parsetree.Pdir_ident (copy_longident x0) + | From.Parsetree.Pdir_bool x0 -> + To.Parsetree.Pdir_bool (copy_bool x0) + +and copy_expression : + From.Parsetree.expression -> To.Parsetree.expression = + fun + { From.Parsetree.pexp_desc = pexp_desc; + From.Parsetree.pexp_loc = pexp_loc; + From.Parsetree.pexp_loc_stack = _; + From.Parsetree.pexp_attributes = pexp_attributes } + -> + { + To.Parsetree.pexp_desc = + (copy_expression_desc pexp_desc); + To.Parsetree.pexp_loc = (copy_location pexp_loc); + To.Parsetree.pexp_attributes = + (copy_attributes pexp_attributes) + } + +and copy_expression_desc : + From.Parsetree.expression_desc -> To.Parsetree.expression_desc = + function + | From.Parsetree.Pexp_ident x0 -> + To.Parsetree.Pexp_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_constant x0 -> + To.Parsetree.Pexp_constant (copy_constant x0) + | From.Parsetree.Pexp_let (x0,x1,x2) -> + To.Parsetree.Pexp_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_expression x2)) + | From.Parsetree.Pexp_function x0 -> + To.Parsetree.Pexp_function + (List.map copy_case x0) + | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> + To.Parsetree.Pexp_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_expression x3)) + | From.Parsetree.Pexp_apply (x0,x1) -> + To.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pexp_match (x0,x1) -> + To.Parsetree.Pexp_match + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_try (x0,x1) -> + To.Parsetree.Pexp_try + ((copy_expression x0), + (List.map copy_case x1)) + | From.Parsetree.Pexp_tuple x0 -> + To.Parsetree.Pexp_tuple + (List.map copy_expression x0) + | From.Parsetree.Pexp_construct (x0,x1) -> + To.Parsetree.Pexp_construct + ((copy_loc copy_longident x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_variant (x0,x1) -> + To.Parsetree.Pexp_variant + ((copy_label x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_record (x0,x1) -> + To.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_expression x1))) x0), + (copy_option copy_expression x1)) + | From.Parsetree.Pexp_field (x0,x1) -> + To.Parsetree.Pexp_field + ((copy_expression x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pexp_setfield (x0,x1,x2) -> + To.Parsetree.Pexp_setfield + ((copy_expression x0), + (copy_loc copy_longident x1), + (copy_expression x2)) + | From.Parsetree.Pexp_array x0 -> + To.Parsetree.Pexp_array + (List.map copy_expression x0) + | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + To.Parsetree.Pexp_ifthenelse + ((copy_expression x0), + (copy_expression x1), + (copy_option copy_expression x2)) + | From.Parsetree.Pexp_sequence (x0,x1) -> + To.Parsetree.Pexp_sequence + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_while (x0,x1) -> + To.Parsetree.Pexp_while + ((copy_expression x0), + (copy_expression x1)) + | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + To.Parsetree.Pexp_for + ((copy_pattern x0), + (copy_expression x1), + (copy_expression x2), + (copy_direction_flag x3), + (copy_expression x4)) + | From.Parsetree.Pexp_constraint (x0,x1) -> + To.Parsetree.Pexp_constraint + ((copy_expression x0), + (copy_core_type x1)) + | From.Parsetree.Pexp_coerce (x0,x1,x2) -> + To.Parsetree.Pexp_coerce + ((copy_expression x0), + (copy_option copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Pexp_send (x0,x1) -> + To.Parsetree.Pexp_send + ((copy_expression x0), + (copy_loc copy_label x1)) + | From.Parsetree.Pexp_new x0 -> + To.Parsetree.Pexp_new + (copy_loc copy_longident x0) + | From.Parsetree.Pexp_setinstvar (x0,x1) -> + To.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), + (copy_expression x1)) + | From.Parsetree.Pexp_override x0 -> + To.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_label x0), + (copy_expression x1))) x0) + | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> + To.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), + (copy_module_expr x1), + (copy_expression x2)) + | From.Parsetree.Pexp_letexception (x0,x1) -> + To.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), + (copy_expression x1)) + | From.Parsetree.Pexp_assert x0 -> + To.Parsetree.Pexp_assert (copy_expression x0) + | From.Parsetree.Pexp_lazy x0 -> + To.Parsetree.Pexp_lazy (copy_expression x0) + | From.Parsetree.Pexp_poly (x0,x1) -> + To.Parsetree.Pexp_poly + ((copy_expression x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pexp_object x0 -> + To.Parsetree.Pexp_object + (copy_class_structure x0) + | From.Parsetree.Pexp_newtype (x0,x1) -> + To.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), + (copy_expression x1)) + | From.Parsetree.Pexp_pack x0 -> + To.Parsetree.Pexp_pack (copy_module_expr x0) + | From.Parsetree.Pexp_open (x0,x1) -> + begin match x0.From.Parsetree.popen_expr.From.Parsetree.pmod_desc with + | Pmod_ident lid -> + To.Parsetree.Pexp_open + (copy_override_flag x0.From.Parsetree.popen_override, + (copy_loc copy_longident lid), + (copy_expression x1)) + | Pmod_structure _ | Pmod_functor _ | Pmod_apply _ + | Pmod_constraint _ | Pmod_unpack _ | Pmod_extension _ -> + migration_error x0.From.Parsetree.popen_loc Def.Pexp_open + end + | From.Parsetree.Pexp_letop { let_; ands = _; body = _; } -> + migration_error let_.pbop_op.loc Def.Pexp_letop + | From.Parsetree.Pexp_extension x0 -> + To.Parsetree.Pexp_extension (copy_extension x0) + | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable + +and copy_direction_flag : + From.Asttypes.direction_flag -> To.Asttypes.direction_flag = + function + | From.Asttypes.Upto -> To.Asttypes.Upto + | From.Asttypes.Downto -> To.Asttypes.Downto + +and copy_case : + From.Parsetree.case -> To.Parsetree.case = + fun + { From.Parsetree.pc_lhs = pc_lhs; + From.Parsetree.pc_guard = pc_guard; + From.Parsetree.pc_rhs = pc_rhs } + -> + { + To.Parsetree.pc_lhs = (copy_pattern pc_lhs); + To.Parsetree.pc_guard = + (copy_option copy_expression pc_guard); + To.Parsetree.pc_rhs = (copy_expression pc_rhs) + } + +and copy_value_binding : + From.Parsetree.value_binding -> To.Parsetree.value_binding = + fun + { From.Parsetree.pvb_pat = pvb_pat; + From.Parsetree.pvb_expr = pvb_expr; + From.Parsetree.pvb_attributes = pvb_attributes; + From.Parsetree.pvb_loc = pvb_loc } + -> + { + To.Parsetree.pvb_pat = (copy_pattern pvb_pat); + To.Parsetree.pvb_expr = + (copy_expression pvb_expr); + To.Parsetree.pvb_attributes = + (copy_attributes pvb_attributes); + To.Parsetree.pvb_loc = (copy_location pvb_loc) + } + +and copy_pattern : + From.Parsetree.pattern -> To.Parsetree.pattern = + fun + { From.Parsetree.ppat_desc = ppat_desc; + From.Parsetree.ppat_loc = ppat_loc; + From.Parsetree.ppat_loc_stack = _; + From.Parsetree.ppat_attributes = ppat_attributes } + -> + { + To.Parsetree.ppat_desc = + (copy_pattern_desc ppat_desc); + To.Parsetree.ppat_loc = (copy_location ppat_loc); + To.Parsetree.ppat_attributes = + (copy_attributes ppat_attributes) + } + +and copy_pattern_desc : + From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = + function + | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any + | From.Parsetree.Ppat_var x0 -> + To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_alias (x0,x1) -> + To.Parsetree.Ppat_alias + ((copy_pattern x0), + (copy_loc (fun x -> x) x1)) + | From.Parsetree.Ppat_constant x0 -> + To.Parsetree.Ppat_constant (copy_constant x0) + | From.Parsetree.Ppat_interval (x0,x1) -> + To.Parsetree.Ppat_interval + ((copy_constant x0), + (copy_constant x1)) + | From.Parsetree.Ppat_tuple x0 -> + To.Parsetree.Ppat_tuple + (List.map copy_pattern x0) + | From.Parsetree.Ppat_construct (x0,x1) -> + To.Parsetree.Ppat_construct + ((copy_loc copy_longident x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_variant (x0,x1) -> + To.Parsetree.Ppat_variant + ((copy_label x0), + (copy_option copy_pattern x1)) + | From.Parsetree.Ppat_record (x0,x1) -> + To.Parsetree.Ppat_record + ((List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_pattern x1))) x0), + (copy_closed_flag x1)) + | From.Parsetree.Ppat_array x0 -> + To.Parsetree.Ppat_array + (List.map copy_pattern x0) + | From.Parsetree.Ppat_or (x0,x1) -> + To.Parsetree.Ppat_or + ((copy_pattern x0), + (copy_pattern x1)) + | From.Parsetree.Ppat_constraint (x0,x1) -> + To.Parsetree.Ppat_constraint + ((copy_pattern x0), + (copy_core_type x1)) + | From.Parsetree.Ppat_type x0 -> + To.Parsetree.Ppat_type + (copy_loc copy_longident x0) + | From.Parsetree.Ppat_lazy x0 -> + To.Parsetree.Ppat_lazy (copy_pattern x0) + | From.Parsetree.Ppat_unpack x0 -> + To.Parsetree.Ppat_unpack + (copy_loc (fun x -> x) x0) + | From.Parsetree.Ppat_exception x0 -> + To.Parsetree.Ppat_exception (copy_pattern x0) + | From.Parsetree.Ppat_extension x0 -> + To.Parsetree.Ppat_extension (copy_extension x0) + | From.Parsetree.Ppat_open (x0,x1) -> + To.Parsetree.Ppat_open + ((copy_loc copy_longident x0), + (copy_pattern x1)) + +and copy_core_type : + From.Parsetree.core_type -> To.Parsetree.core_type = + fun + { From.Parsetree.ptyp_desc = ptyp_desc; + From.Parsetree.ptyp_loc = ptyp_loc; + From.Parsetree.ptyp_loc_stack = _; + From.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + To.Parsetree.ptyp_desc = + (copy_core_type_desc ptyp_desc); + To.Parsetree.ptyp_loc = (copy_location ptyp_loc); + To.Parsetree.ptyp_attributes = + (copy_attributes ptyp_attributes) + } + +and copy_core_type_desc : + From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = + function + | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any + | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 + | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> + To.Parsetree.Ptyp_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_core_type x2)) + | From.Parsetree.Ptyp_tuple x0 -> + To.Parsetree.Ptyp_tuple + (List.map copy_core_type x0) + | From.Parsetree.Ptyp_constr (x0,x1) -> + To.Parsetree.Ptyp_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_object (x0,x1) -> + To.Parsetree.Ptyp_object + ((List.map copy_object_field x0), + (copy_closed_flag x1)) + | From.Parsetree.Ptyp_class (x0,x1) -> + To.Parsetree.Ptyp_class + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Ptyp_alias (x0,x1) -> + To.Parsetree.Ptyp_alias + ((copy_core_type x0), x1) + | From.Parsetree.Ptyp_variant (x0,x1,x2) -> + To.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), + (copy_closed_flag x1), + (copy_option (fun x -> List.map copy_label x) x2)) + | From.Parsetree.Ptyp_poly (x0,x1) -> + To.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | From.Parsetree.Ptyp_package x0 -> + To.Parsetree.Ptyp_package (copy_package_type x0) + | From.Parsetree.Ptyp_extension x0 -> + To.Parsetree.Ptyp_extension (copy_extension x0) + +and copy_package_type : + From.Parsetree.package_type -> To.Parsetree.package_type = + fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_loc copy_longident x0), + (copy_core_type x1))) x1)) + +and copy_row_field : + From.Parsetree.row_field -> To.Parsetree.row_field = + fun + { From.Parsetree.prf_desc = prf_desc; + From.Parsetree.prf_loc = _; + From.Parsetree.prf_attributes = prf_attributes } + -> + match prf_desc with + | From.Parsetree.Rtag (x0, x1, x2) -> + To.Parsetree.Rtag ((copy_loc copy_label x0), + (copy_attributes prf_attributes), + (copy_bool x1), + (List.map copy_core_type x2)) + | From.Parsetree.Rinherit x0 -> + To.Parsetree.Rinherit (copy_core_type x0) + +and copy_object_field : + From.Parsetree.object_field -> To.Parsetree.object_field = + fun + { From.Parsetree.pof_desc = pof_desc; + From.Parsetree.pof_loc = _; + From.Parsetree.pof_attributes = pof_attributes } + -> + match pof_desc with + | From.Parsetree.Otag (x0, x1) -> + To.Parsetree.Otag ((copy_loc copy_label x0), + (copy_attributes pof_attributes), + (copy_core_type x1)) + | From.Parsetree.Oinherit x0 -> + To.Parsetree.Oinherit (copy_core_type x0) + +and copy_attributes : + From.Parsetree.attributes -> To.Parsetree.attributes = + fun x -> List.map copy_attribute x + +and copy_attribute : + From.Parsetree.attribute -> To.Parsetree.attribute = + fun + { From.Parsetree.attr_name = attr_name; + From.Parsetree.attr_payload = attr_payload; + From.Parsetree.attr_loc = _ } + -> + ((copy_loc (fun x -> x) attr_name), + (copy_payload attr_payload)) + +and copy_payload : + From.Parsetree.payload -> To.Parsetree.payload = + function + | From.Parsetree.PStr x0 -> + To.Parsetree.PStr (copy_structure x0) + | From.Parsetree.PSig x0 -> + To.Parsetree.PSig (copy_signature x0) + | From.Parsetree.PTyp x0 -> + To.Parsetree.PTyp (copy_core_type x0) + | From.Parsetree.PPat (x0,x1) -> + To.Parsetree.PPat + ((copy_pattern x0), + (copy_option copy_expression x1)) + +and copy_structure : + From.Parsetree.structure -> To.Parsetree.structure = + fun x -> List.map copy_structure_item x + +and copy_structure_item : + From.Parsetree.structure_item -> To.Parsetree.structure_item = + fun + { From.Parsetree.pstr_desc = pstr_desc; + From.Parsetree.pstr_loc = pstr_loc } + -> + { + To.Parsetree.pstr_desc = + (copy_structure_item_desc pstr_desc); + To.Parsetree.pstr_loc = (copy_location pstr_loc) + } + +and copy_structure_item_desc : + From.Parsetree.structure_item_desc -> + To.Parsetree.structure_item_desc + = + function + | From.Parsetree.Pstr_eval (x0,x1) -> + To.Parsetree.Pstr_eval + ((copy_expression x0), + (copy_attributes x1)) + | From.Parsetree.Pstr_value (x0,x1) -> + To.Parsetree.Pstr_value + ((copy_rec_flag x0), + (List.map copy_value_binding x1)) + | From.Parsetree.Pstr_primitive x0 -> + To.Parsetree.Pstr_primitive + (copy_value_description x0) + | From.Parsetree.Pstr_type (x0,x1) -> + To.Parsetree.Pstr_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Pstr_typext x0 -> + To.Parsetree.Pstr_typext + (copy_type_extension x0) + | From.Parsetree.Pstr_exception x0 -> + To.Parsetree.Pstr_exception + (let e = copy_extension_constructor + x0.From.Parsetree.ptyexn_constructor in + { e with pext_attributes = e.pext_attributes @ (copy_attributes x0.ptyexn_attributes) } + ) + | From.Parsetree.Pstr_module x0 -> + To.Parsetree.Pstr_module + (copy_module_binding x0) + | From.Parsetree.Pstr_recmodule x0 -> + To.Parsetree.Pstr_recmodule + (List.map copy_module_binding x0) + | From.Parsetree.Pstr_modtype x0 -> + To.Parsetree.Pstr_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Pstr_open x0 -> + begin match x0.From.Parsetree.popen_expr.From.Parsetree.pmod_desc with + | Pmod_ident lid -> + To.Parsetree.Pstr_open + { To.Parsetree.popen_lid = (copy_loc copy_longident lid); + To.Parsetree.popen_override = (copy_override_flag x0.From.Parsetree.popen_override); + To.Parsetree.popen_loc = (copy_location x0.From.Parsetree.popen_loc); + To.Parsetree.popen_attributes = (copy_attributes x0.From.Parsetree.popen_attributes); } + | Pmod_structure _ | Pmod_functor _ | Pmod_apply _ + | Pmod_constraint _ | Pmod_unpack _ | Pmod_extension _ -> + migration_error x0.From.Parsetree.popen_loc Def.Pexp_open + end + | From.Parsetree.Pstr_class x0 -> + To.Parsetree.Pstr_class + (List.map copy_class_declaration x0) + | From.Parsetree.Pstr_class_type x0 -> + To.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Pstr_include x0 -> + To.Parsetree.Pstr_include + (copy_include_declaration x0) + | From.Parsetree.Pstr_attribute x0 -> + To.Parsetree.Pstr_attribute (copy_attribute x0) + | From.Parsetree.Pstr_extension (x0,x1) -> + To.Parsetree.Pstr_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_include_declaration : + From.Parsetree.include_declaration -> + To.Parsetree.include_declaration + = + fun x -> + copy_include_infos copy_module_expr x + +and copy_class_declaration : + From.Parsetree.class_declaration -> To.Parsetree.class_declaration + = + fun x -> + copy_class_infos copy_class_expr x + +and copy_class_expr : + From.Parsetree.class_expr -> To.Parsetree.class_expr = + fun + { From.Parsetree.pcl_desc = pcl_desc; + From.Parsetree.pcl_loc = pcl_loc; + From.Parsetree.pcl_attributes = pcl_attributes } + -> + { + To.Parsetree.pcl_desc = + (copy_class_expr_desc pcl_desc); + To.Parsetree.pcl_loc = (copy_location pcl_loc); + To.Parsetree.pcl_attributes = + (copy_attributes pcl_attributes) + } + +and copy_class_expr_desc : + From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = + function + | From.Parsetree.Pcl_constr (x0,x1) -> + To.Parsetree.Pcl_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcl_structure x0 -> + To.Parsetree.Pcl_structure + (copy_class_structure x0) + | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> + To.Parsetree.Pcl_fun + ((copy_arg_label x0), + (copy_option copy_expression x1), + (copy_pattern x2), + (copy_class_expr x3)) + | From.Parsetree.Pcl_apply (x0,x1) -> + To.Parsetree.Pcl_apply + ((copy_class_expr x0), + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_arg_label x0), + (copy_expression x1))) x1)) + | From.Parsetree.Pcl_let (x0,x1,x2) -> + To.Parsetree.Pcl_let + ((copy_rec_flag x0), + (List.map copy_value_binding x1), + (copy_class_expr x2)) + | From.Parsetree.Pcl_constraint (x0,x1) -> + To.Parsetree.Pcl_constraint + ((copy_class_expr x0), + (copy_class_type x1)) + | From.Parsetree.Pcl_extension x0 -> + To.Parsetree.Pcl_extension (copy_extension x0) + | From.Parsetree.Pcl_open (x0,x1) -> + To.Parsetree.Pcl_open + ((copy_override_flag x0.From.Parsetree.popen_override), + (copy_loc copy_longident x0.From.Parsetree.popen_expr), + (copy_class_expr x1)) + +and copy_class_structure : + From.Parsetree.class_structure -> To.Parsetree.class_structure = + fun + { From.Parsetree.pcstr_self = pcstr_self; + From.Parsetree.pcstr_fields = pcstr_fields } + -> + { + To.Parsetree.pcstr_self = + (copy_pattern pcstr_self); + To.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } + +and copy_class_field : + From.Parsetree.class_field -> To.Parsetree.class_field = + fun + { From.Parsetree.pcf_desc = pcf_desc; + From.Parsetree.pcf_loc = pcf_loc; + From.Parsetree.pcf_attributes = pcf_attributes } + -> + { + To.Parsetree.pcf_desc = + (copy_class_field_desc pcf_desc); + To.Parsetree.pcf_loc = (copy_location pcf_loc); + To.Parsetree.pcf_attributes = + (copy_attributes pcf_attributes) + } + +and copy_class_field_desc : + From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = + function + | From.Parsetree.Pcf_inherit (x0,x1,x2) -> + To.Parsetree.Pcf_inherit + ((copy_override_flag x0), + (copy_class_expr x1), + (copy_option (fun x -> copy_loc (fun x -> x) x) + x2)) + | From.Parsetree.Pcf_val x0 -> + To.Parsetree.Pcf_val + (let (x0,x1,x2) = x0 in + ((copy_loc copy_label x0), + (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_method x0 -> + To.Parsetree.Pcf_method + (let (x0,x1,x2) = x0 in + ((copy_loc copy_label x0), + (copy_private_flag x1), + (copy_class_field_kind x2))) + | From.Parsetree.Pcf_constraint x0 -> + To.Parsetree.Pcf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pcf_initializer x0 -> + To.Parsetree.Pcf_initializer + (copy_expression x0) + | From.Parsetree.Pcf_attribute x0 -> + To.Parsetree.Pcf_attribute (copy_attribute x0) + | From.Parsetree.Pcf_extension x0 -> + To.Parsetree.Pcf_extension (copy_extension x0) + +and copy_class_field_kind : + From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = + function + | From.Parsetree.Cfk_virtual x0 -> + To.Parsetree.Cfk_virtual (copy_core_type x0) + | From.Parsetree.Cfk_concrete (x0,x1) -> + To.Parsetree.Cfk_concrete + ((copy_override_flag x0), + (copy_expression x1)) + +and copy_module_binding : + From.Parsetree.module_binding -> To.Parsetree.module_binding = + fun + { From.Parsetree.pmb_name = pmb_name; + From.Parsetree.pmb_expr = pmb_expr; + From.Parsetree.pmb_attributes = pmb_attributes; + From.Parsetree.pmb_loc = pmb_loc } + -> + { + To.Parsetree.pmb_name = + (copy_loc (fun x -> x) pmb_name); + To.Parsetree.pmb_expr = + (copy_module_expr pmb_expr); + To.Parsetree.pmb_attributes = + (copy_attributes pmb_attributes); + To.Parsetree.pmb_loc = (copy_location pmb_loc) + } + +and copy_module_expr : + From.Parsetree.module_expr -> To.Parsetree.module_expr = + fun + { From.Parsetree.pmod_desc = pmod_desc; + From.Parsetree.pmod_loc = pmod_loc; + From.Parsetree.pmod_attributes = pmod_attributes } + -> + { + To.Parsetree.pmod_desc = + (copy_module_expr_desc pmod_desc); + To.Parsetree.pmod_loc = (copy_location pmod_loc); + To.Parsetree.pmod_attributes = + (copy_attributes pmod_attributes) + } + +and copy_module_expr_desc : + From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = + function + | From.Parsetree.Pmod_ident x0 -> + To.Parsetree.Pmod_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmod_structure x0 -> + To.Parsetree.Pmod_structure (copy_structure x0) + | From.Parsetree.Pmod_functor (x0,x1,x2) -> + To.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_expr x2)) + | From.Parsetree.Pmod_apply (x0,x1) -> + To.Parsetree.Pmod_apply + ((copy_module_expr x0), + (copy_module_expr x1)) + | From.Parsetree.Pmod_constraint (x0,x1) -> + To.Parsetree.Pmod_constraint + ((copy_module_expr x0), + (copy_module_type x1)) + | From.Parsetree.Pmod_unpack x0 -> + To.Parsetree.Pmod_unpack (copy_expression x0) + | From.Parsetree.Pmod_extension x0 -> + To.Parsetree.Pmod_extension (copy_extension x0) + +and copy_module_type : + From.Parsetree.module_type -> To.Parsetree.module_type = + fun + { From.Parsetree.pmty_desc = pmty_desc; + From.Parsetree.pmty_loc = pmty_loc; + From.Parsetree.pmty_attributes = pmty_attributes } + -> + { + To.Parsetree.pmty_desc = + (copy_module_type_desc pmty_desc); + To.Parsetree.pmty_loc = (copy_location pmty_loc); + To.Parsetree.pmty_attributes = + (copy_attributes pmty_attributes) + } + +and copy_module_type_desc : + From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = + function + | From.Parsetree.Pmty_ident x0 -> + To.Parsetree.Pmty_ident + (copy_loc copy_longident x0) + | From.Parsetree.Pmty_signature x0 -> + To.Parsetree.Pmty_signature (copy_signature x0) + | From.Parsetree.Pmty_functor (x0,x1,x2) -> + To.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), + (copy_option copy_module_type x1), + (copy_module_type x2)) + | From.Parsetree.Pmty_with (x0,x1) -> + To.Parsetree.Pmty_with + ((copy_module_type x0), + (List.map copy_with_constraint x1)) + | From.Parsetree.Pmty_typeof x0 -> + To.Parsetree.Pmty_typeof (copy_module_expr x0) + | From.Parsetree.Pmty_extension x0 -> + To.Parsetree.Pmty_extension (copy_extension x0) + | From.Parsetree.Pmty_alias x0 -> + To.Parsetree.Pmty_alias + (copy_loc copy_longident x0) + +and copy_with_constraint : + From.Parsetree.with_constraint -> To.Parsetree.with_constraint = + function + | From.Parsetree.Pwith_type (x0,x1) -> + To.Parsetree.Pwith_type + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_module (x0,x1) -> + To.Parsetree.Pwith_module + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + | From.Parsetree.Pwith_typesubst (x0,x1) -> + To.Parsetree.Pwith_typesubst + ((copy_loc copy_longident x0), + (copy_type_declaration x1)) + | From.Parsetree.Pwith_modsubst (x0,x1) -> + To.Parsetree.Pwith_modsubst + ((copy_loc copy_longident x0), + (copy_loc copy_longident x1)) + +and copy_signature : + From.Parsetree.signature -> To.Parsetree.signature = + fun x -> List.map copy_signature_item x + +and copy_signature_item : + From.Parsetree.signature_item -> To.Parsetree.signature_item = + fun + { From.Parsetree.psig_desc = psig_desc; + From.Parsetree.psig_loc = psig_loc } + -> + { + To.Parsetree.psig_desc = + (copy_signature_item_desc psig_desc); + To.Parsetree.psig_loc = (copy_location psig_loc) + } + +and copy_signature_item_desc : + From.Parsetree.signature_item_desc -> + To.Parsetree.signature_item_desc + = + function + | From.Parsetree.Psig_value x0 -> + To.Parsetree.Psig_value + (copy_value_description x0) + | From.Parsetree.Psig_type (x0,x1) -> + To.Parsetree.Psig_type + ((copy_rec_flag x0), + (List.map copy_type_declaration x1)) + | From.Parsetree.Psig_typesubst x0 -> + let x0_loc = + match x0 with + | [] -> Location.none + | { From.Parsetree.ptype_loc; _ } :: _ -> ptype_loc in + migration_error x0_loc Def.Psig_typesubst + | From.Parsetree.Psig_typext x0 -> + To.Parsetree.Psig_typext + (copy_type_extension x0) + | From.Parsetree.Psig_exception x0 -> + To.Parsetree.Psig_exception + (let e = copy_extension_constructor + x0.From.Parsetree.ptyexn_constructor in + {e with pext_attributes = e.pext_attributes @ (copy_attributes x0.ptyexn_attributes) }) + | From.Parsetree.Psig_module x0 -> + To.Parsetree.Psig_module + (copy_module_declaration x0) + | From.Parsetree.Psig_modsubst x0 -> + migration_error x0.pms_loc Def.Psig_modsubst + | From.Parsetree.Psig_recmodule x0 -> + To.Parsetree.Psig_recmodule + (List.map copy_module_declaration x0) + | From.Parsetree.Psig_modtype x0 -> + To.Parsetree.Psig_modtype + (copy_module_type_declaration x0) + | From.Parsetree.Psig_open x0 -> + To.Parsetree.Psig_open + (copy_open_description x0) + | From.Parsetree.Psig_include x0 -> + To.Parsetree.Psig_include + (copy_include_description x0) + | From.Parsetree.Psig_class x0 -> + To.Parsetree.Psig_class + (List.map copy_class_description x0) + | From.Parsetree.Psig_class_type x0 -> + To.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | From.Parsetree.Psig_attribute x0 -> + To.Parsetree.Psig_attribute (copy_attribute x0) + | From.Parsetree.Psig_extension (x0,x1) -> + To.Parsetree.Psig_extension + ((copy_extension x0), + (copy_attributes x1)) + +and copy_class_type_declaration : + From.Parsetree.class_type_declaration -> + To.Parsetree.class_type_declaration + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_description : + From.Parsetree.class_description -> To.Parsetree.class_description + = + fun x -> + copy_class_infos copy_class_type x + +and copy_class_type : + From.Parsetree.class_type -> To.Parsetree.class_type = + fun + { From.Parsetree.pcty_desc = pcty_desc; + From.Parsetree.pcty_loc = pcty_loc; + From.Parsetree.pcty_attributes = pcty_attributes } + -> + { + To.Parsetree.pcty_desc = + (copy_class_type_desc pcty_desc); + To.Parsetree.pcty_loc = (copy_location pcty_loc); + To.Parsetree.pcty_attributes = + (copy_attributes pcty_attributes) + } + +and copy_class_type_desc : + From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = + function + | From.Parsetree.Pcty_constr (x0,x1) -> + To.Parsetree.Pcty_constr + ((copy_loc copy_longident x0), + (List.map copy_core_type x1)) + | From.Parsetree.Pcty_signature x0 -> + To.Parsetree.Pcty_signature + (copy_class_signature x0) + | From.Parsetree.Pcty_arrow (x0,x1,x2) -> + To.Parsetree.Pcty_arrow + ((copy_arg_label x0), + (copy_core_type x1), + (copy_class_type x2)) + | From.Parsetree.Pcty_extension x0 -> + To.Parsetree.Pcty_extension (copy_extension x0) + | From.Parsetree.Pcty_open (x0,x1) -> + To.Parsetree.Pcty_open + ((copy_override_flag x0.From.Parsetree.popen_override), + (copy_loc copy_longident x0.From.Parsetree.popen_expr), + (copy_class_type x1)) + +and copy_class_signature : + From.Parsetree.class_signature -> To.Parsetree.class_signature = + fun + { From.Parsetree.pcsig_self = pcsig_self; + From.Parsetree.pcsig_fields = pcsig_fields } + -> + { + To.Parsetree.pcsig_self = + (copy_core_type pcsig_self); + To.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } + +and copy_class_type_field : + From.Parsetree.class_type_field -> To.Parsetree.class_type_field = + fun + { From.Parsetree.pctf_desc = pctf_desc; + From.Parsetree.pctf_loc = pctf_loc; + From.Parsetree.pctf_attributes = pctf_attributes } + -> + { + To.Parsetree.pctf_desc = + (copy_class_type_field_desc pctf_desc); + To.Parsetree.pctf_loc = (copy_location pctf_loc); + To.Parsetree.pctf_attributes = + (copy_attributes pctf_attributes) + } + +and copy_class_type_field_desc : + From.Parsetree.class_type_field_desc -> + To.Parsetree.class_type_field_desc + = + function + | From.Parsetree.Pctf_inherit x0 -> + To.Parsetree.Pctf_inherit (copy_class_type x0) + | From.Parsetree.Pctf_val x0 -> + To.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))) + | From.Parsetree.Pctf_method x0 -> + To.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))) + | From.Parsetree.Pctf_constraint x0 -> + To.Parsetree.Pctf_constraint + (let (x0,x1) = x0 in + ((copy_core_type x0), + (copy_core_type x1))) + | From.Parsetree.Pctf_attribute x0 -> + To.Parsetree.Pctf_attribute (copy_attribute x0) + | From.Parsetree.Pctf_extension x0 -> + To.Parsetree.Pctf_extension (copy_extension x0) + +and copy_extension : + From.Parsetree.extension -> To.Parsetree.extension = + fun x -> + let (x0,x1) = x in + let x1 = + match x0.txt with + | "ocaml.error" | "error" -> + begin match x1 with + | PStr (hd :: tl) -> From.Parsetree.PStr (hd :: hd :: tl) + | _ -> x1 + end + | _ -> x1 in + ((copy_loc (fun x -> x) x0), + (copy_payload x1)) + +and copy_class_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos + = + fun f0 -> + fun + { From.Parsetree.pci_virt = pci_virt; + From.Parsetree.pci_params = pci_params; + From.Parsetree.pci_name = pci_name; + From.Parsetree.pci_expr = pci_expr; + From.Parsetree.pci_loc = pci_loc; + From.Parsetree.pci_attributes = pci_attributes } + -> + { + To.Parsetree.pci_virt = + (copy_virtual_flag pci_virt); + To.Parsetree.pci_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) pci_params); + To.Parsetree.pci_name = + (copy_loc (fun x -> x) pci_name); + To.Parsetree.pci_expr = (f0 pci_expr); + To.Parsetree.pci_loc = (copy_location pci_loc); + To.Parsetree.pci_attributes = + (copy_attributes pci_attributes) + } + +and copy_virtual_flag : + From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = + function + | From.Asttypes.Virtual -> To.Asttypes.Virtual + | From.Asttypes.Concrete -> To.Asttypes.Concrete + +and copy_include_description : + From.Parsetree.include_description -> + To.Parsetree.include_description + = + fun x -> + copy_include_infos copy_module_type x + +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 From.Parsetree.include_infos -> + 'g0 To.Parsetree.include_infos + = + fun f0 -> + fun + { From.Parsetree.pincl_mod = pincl_mod; + From.Parsetree.pincl_loc = pincl_loc; + From.Parsetree.pincl_attributes = pincl_attributes } + -> + { + To.Parsetree.pincl_mod = (f0 pincl_mod); + To.Parsetree.pincl_loc = (copy_location pincl_loc); + To.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } + +and copy_open_description : + From.Parsetree.open_description -> To.Parsetree.open_description = + fun + { From.Parsetree.popen_expr = popen_expr; + From.Parsetree.popen_override = popen_override; + From.Parsetree.popen_loc = popen_loc; + From.Parsetree.popen_attributes = popen_attributes } + -> + { To.Parsetree.popen_lid = (copy_loc copy_longident popen_expr); + To.Parsetree.popen_override = (copy_override_flag popen_override); + To.Parsetree.popen_loc = (copy_location popen_loc); + To.Parsetree.popen_attributes = (copy_attributes popen_attributes); } + +and copy_override_flag : + From.Asttypes.override_flag -> To.Asttypes.override_flag = + function + | From.Asttypes.Override -> To.Asttypes.Override + | From.Asttypes.Fresh -> To.Asttypes.Fresh + +and copy_module_type_declaration : + From.Parsetree.module_type_declaration -> + To.Parsetree.module_type_declaration + = + fun + { From.Parsetree.pmtd_name = pmtd_name; + From.Parsetree.pmtd_type = pmtd_type; + From.Parsetree.pmtd_attributes = pmtd_attributes; + From.Parsetree.pmtd_loc = pmtd_loc } + -> + { + To.Parsetree.pmtd_name = + (copy_loc (fun x -> x) pmtd_name); + To.Parsetree.pmtd_type = + (copy_option copy_module_type pmtd_type); + To.Parsetree.pmtd_attributes = + (copy_attributes pmtd_attributes); + To.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } + +and copy_module_declaration : + From.Parsetree.module_declaration -> + To.Parsetree.module_declaration + = + fun + { From.Parsetree.pmd_name = pmd_name; + From.Parsetree.pmd_type = pmd_type; + From.Parsetree.pmd_attributes = pmd_attributes; + From.Parsetree.pmd_loc = pmd_loc } + -> + { + To.Parsetree.pmd_name = + (copy_loc (fun x -> x) pmd_name); + To.Parsetree.pmd_type = + (copy_module_type pmd_type); + To.Parsetree.pmd_attributes = + (copy_attributes pmd_attributes); + To.Parsetree.pmd_loc = (copy_location pmd_loc) + } + +(* and copy_type_exception : + From.Parsetree.type_exception -> To.Parsetree.type_exception = + fun + { From.Parsetree.ptyexn_constructor = ptyexn_constructor; + From.Parsetree.ptyexn_loc = ptyexn_loc; + From.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + To.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + To.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + To.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + }*) + +and copy_type_extension : + From.Parsetree.type_extension -> To.Parsetree.type_extension = + fun + { From.Parsetree.ptyext_path = ptyext_path; + From.Parsetree.ptyext_params = ptyext_params; + From.Parsetree.ptyext_constructors = ptyext_constructors; + From.Parsetree.ptyext_private = ptyext_private; + From.Parsetree.ptyext_loc = _; + From.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + To.Parsetree.ptyext_path = + (copy_loc copy_longident ptyext_path); + To.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptyext_params); + To.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor + ptyext_constructors); + To.Parsetree.ptyext_private = + (copy_private_flag ptyext_private); + To.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } + +and copy_extension_constructor : + From.Parsetree.extension_constructor -> + To.Parsetree.extension_constructor + = + fun + { From.Parsetree.pext_name = pext_name; + From.Parsetree.pext_kind = pext_kind; + From.Parsetree.pext_loc = pext_loc; + From.Parsetree.pext_attributes = pext_attributes } + -> + { + To.Parsetree.pext_name = + (copy_loc (fun x -> x) pext_name); + To.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + To.Parsetree.pext_loc = (copy_location pext_loc); + To.Parsetree.pext_attributes = + (copy_attributes pext_attributes) + } + +and copy_extension_constructor_kind : + From.Parsetree.extension_constructor_kind -> + To.Parsetree.extension_constructor_kind + = + function + | From.Parsetree.Pext_decl (x0,x1) -> + To.Parsetree.Pext_decl + ((copy_constructor_arguments x0), + (copy_option copy_core_type x1)) + | From.Parsetree.Pext_rebind x0 -> + To.Parsetree.Pext_rebind + (copy_loc copy_longident x0) + +and copy_type_declaration : + From.Parsetree.type_declaration -> To.Parsetree.type_declaration = + fun + { From.Parsetree.ptype_name = ptype_name; + From.Parsetree.ptype_params = ptype_params; + From.Parsetree.ptype_cstrs = ptype_cstrs; + From.Parsetree.ptype_kind = ptype_kind; + From.Parsetree.ptype_private = ptype_private; + From.Parsetree.ptype_manifest = ptype_manifest; + From.Parsetree.ptype_attributes = ptype_attributes; + From.Parsetree.ptype_loc = ptype_loc } + -> + { + To.Parsetree.ptype_name = + (copy_loc (fun x -> x) ptype_name); + To.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_core_type x0), + (copy_variance x1))) ptype_params); + To.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); + To.Parsetree.ptype_kind = + (copy_type_kind ptype_kind); + To.Parsetree.ptype_private = + (copy_private_flag ptype_private); + To.Parsetree.ptype_manifest = + (copy_option copy_core_type ptype_manifest); + To.Parsetree.ptype_attributes = + (copy_attributes ptype_attributes); + To.Parsetree.ptype_loc = (copy_location ptype_loc) + } + +and copy_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_type_kind : + From.Parsetree.type_kind -> To.Parsetree.type_kind = + function + | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract + | From.Parsetree.Ptype_variant x0 -> + To.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | From.Parsetree.Ptype_record x0 -> + To.Parsetree.Ptype_record + (List.map copy_label_declaration x0) + | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open + +and copy_constructor_declaration : + From.Parsetree.constructor_declaration -> + To.Parsetree.constructor_declaration + = + fun + { From.Parsetree.pcd_name = pcd_name; + From.Parsetree.pcd_args = pcd_args; + From.Parsetree.pcd_res = pcd_res; + From.Parsetree.pcd_loc = pcd_loc; + From.Parsetree.pcd_attributes = pcd_attributes } + -> + { + To.Parsetree.pcd_name = + (copy_loc (fun x -> x) pcd_name); + To.Parsetree.pcd_args = + (copy_constructor_arguments pcd_args); + To.Parsetree.pcd_res = + (copy_option copy_core_type pcd_res); + To.Parsetree.pcd_loc = (copy_location pcd_loc); + To.Parsetree.pcd_attributes = + (copy_attributes pcd_attributes) + } + +and copy_constructor_arguments : + From.Parsetree.constructor_arguments -> + To.Parsetree.constructor_arguments + = + function + | From.Parsetree.Pcstr_tuple x0 -> + To.Parsetree.Pcstr_tuple + (List.map copy_core_type x0) + | From.Parsetree.Pcstr_record x0 -> + To.Parsetree.Pcstr_record + (List.map copy_label_declaration x0) + +and copy_label_declaration : + From.Parsetree.label_declaration -> To.Parsetree.label_declaration + = + fun + { From.Parsetree.pld_name = pld_name; + From.Parsetree.pld_mutable = pld_mutable; + From.Parsetree.pld_type = pld_type; + From.Parsetree.pld_loc = pld_loc; + From.Parsetree.pld_attributes = pld_attributes } + -> + { + To.Parsetree.pld_name = + (copy_loc (fun x -> x) pld_name); + To.Parsetree.pld_mutable = + (copy_mutable_flag pld_mutable); + To.Parsetree.pld_type = + (copy_core_type pld_type); + To.Parsetree.pld_loc = (copy_location pld_loc); + To.Parsetree.pld_attributes = + (copy_attributes pld_attributes) + } + +and copy_mutable_flag : + From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = + function + | From.Asttypes.Immutable -> To.Asttypes.Immutable + | From.Asttypes.Mutable -> To.Asttypes.Mutable + +and copy_variance : + From.Asttypes.variance -> To.Asttypes.variance = + function + | From.Asttypes.Covariant -> To.Asttypes.Covariant + | From.Asttypes.Contravariant -> To.Asttypes.Contravariant + | From.Asttypes.Invariant -> To.Asttypes.Invariant + +and copy_value_description : + From.Parsetree.value_description -> To.Parsetree.value_description + = + fun + { From.Parsetree.pval_name = pval_name; + From.Parsetree.pval_type = pval_type; + From.Parsetree.pval_prim = pval_prim; + From.Parsetree.pval_attributes = pval_attributes; + From.Parsetree.pval_loc = pval_loc } + -> + { + To.Parsetree.pval_name = + (copy_loc (fun x -> x) pval_name); + To.Parsetree.pval_type = + (copy_core_type pval_type); + To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + To.Parsetree.pval_attributes = + (copy_attributes pval_attributes); + To.Parsetree.pval_loc = (copy_location pval_loc) + } + +and copy_arg_label : + From.Asttypes.arg_label -> To.Asttypes.arg_label = + function + | From.Asttypes.Nolabel -> To.Asttypes.Nolabel + | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 + | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 + +and copy_closed_flag : + From.Asttypes.closed_flag -> To.Asttypes.closed_flag = + function + | From.Asttypes.Closed -> To.Asttypes.Closed + | From.Asttypes.Open -> To.Asttypes.Open + +and copy_label : + From.Asttypes.label -> To.Asttypes.label = fun x -> x + +and copy_rec_flag : + From.Asttypes.rec_flag -> To.Asttypes.rec_flag = + function + | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive + | From.Asttypes.Recursive -> To.Asttypes.Recursive + +and copy_constant : + From.Parsetree.constant -> To.Parsetree.constant = + function + | From.Parsetree.Pconst_integer (x0,x1) -> + To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 + | From.Parsetree.Pconst_string (x0,x1) -> + To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) + | From.Parsetree.Pconst_float (x0,x1) -> + To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) + +and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = + fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) + +and copy_longident : From.Longident.t -> To.Longident.t = + function + | From.Longident.Lident x0 -> To.Longident.Lident x0 + | From.Longident.Ldot (x0,x1) -> + To.Longident.Ldot ((copy_longident x0), x1) + | From.Longident.Lapply (x0,x1) -> + To.Longident.Lapply + ((copy_longident x0), (copy_longident x1)) + +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc + = + fun f0 -> + fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> + { + To.Asttypes.txt = (f0 txt); + To.Asttypes.loc = (copy_location loc) + } + +and copy_location : From.Location.t -> To.Location.t = + fun + { From.Location.loc_start = loc_start; + From.Location.loc_end = loc_end; + From.Location.loc_ghost = loc_ghost } + -> + { + To.Location.loc_start = (copy_Lexing_position loc_start); + To.Location.loc_end = (copy_Lexing_position loc_end); + To.Location.loc_ghost = (copy_bool loc_ghost) + } + +and copy_bool : bool -> bool = function | false -> false | true -> true + +and copy_Lexing_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } + +let copy_cases x = List.map copy_case x +let copy_pat = copy_pattern +let copy_expr = copy_expression +let copy_typ = copy_core_type + +let rec copy_out_phrase : + From.Outcometree.out_phrase -> To.Outcometree.out_phrase = + function + | From.Outcometree.Ophr_eval (x0,x1) -> + To.Outcometree.Ophr_eval + ((copy_out_value x0), + (copy_out_type x1)) + | From.Outcometree.Ophr_signature x0 -> + To.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_sig_item x0), + (copy_option copy_out_value x1))) x0) + | From.Outcometree.Ophr_exception x0 -> + To.Outcometree.Ophr_exception + (let (x0,x1) = x0 in + ((copy_exn x0), (copy_out_value x1))) + +and copy_exn : exn -> exn = fun x -> x + +and copy_out_sig_item : + From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + function + | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> + To.Outcometree.Osig_class_type + ((copy_bool x0), x1, + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | From.Outcometree.Osig_typext (x0,x1) -> + To.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), + (copy_out_ext_status x1)) + | From.Outcometree.Osig_modtype (x0,x1) -> + To.Outcometree.Osig_modtype + (x0, (copy_out_module_type x1)) + | From.Outcometree.Osig_module (x0,x1,x2) -> + To.Outcometree.Osig_module + (x0, (copy_out_module_type x1), + (copy_out_rec_status x2)) + | From.Outcometree.Osig_type (x0,x1) -> + To.Outcometree.Osig_type + ((copy_out_type_decl x0), + (copy_out_rec_status x1)) + | From.Outcometree.Osig_value x0 -> + To.Outcometree.Osig_value + (copy_out_val_decl x0) + | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis + +and copy_out_val_decl : + From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + fun + { From.Outcometree.oval_name = oval_name; + From.Outcometree.oval_type = oval_type; + From.Outcometree.oval_prims = oval_prims; + From.Outcometree.oval_attributes = oval_attributes } + -> + { + To.Outcometree.oval_name = oval_name; + To.Outcometree.oval_type = + (copy_out_type oval_type); + To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + To.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } + +and copy_out_type_decl : + From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + fun + { From.Outcometree.otype_name = otype_name; + From.Outcometree.otype_params = otype_params; + From.Outcometree.otype_type = otype_type; + From.Outcometree.otype_private = otype_private; + From.Outcometree.otype_immediate = otype_immediate; + From.Outcometree.otype_unboxed = otype_unboxed; + From.Outcometree.otype_cstrs = otype_cstrs } + -> + { + To.Outcometree.otype_name = otype_name; + To.Outcometree.otype_params = + (List.map + (fun x -> + let (x0,x1) = x in + (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + otype_params); + To.Outcometree.otype_type = + (copy_out_type otype_type); + To.Outcometree.otype_private = + (copy_From_Asttypes_private_flag otype_private); + To.Outcometree.otype_immediate = (copy_bool otype_immediate); + To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); + To.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_type x0), + (copy_out_type x1))) otype_cstrs) + } + +and copy_out_module_type : + From.Outcometree.out_module_type -> To.Outcometree.out_module_type + = + function + | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract + | From.Outcometree.Omty_functor (x0,x1,x2) -> + To.Outcometree.Omty_functor + (x0, (copy_option copy_out_module_type x1), + (copy_out_module_type x2)) + | From.Outcometree.Omty_ident x0 -> + To.Outcometree.Omty_ident (copy_out_ident x0) + | From.Outcometree.Omty_signature x0 -> + To.Outcometree.Omty_signature + (List.map copy_out_sig_item x0) + | From.Outcometree.Omty_alias x0 -> + To.Outcometree.Omty_alias (copy_out_ident x0) + +and copy_out_ext_status : + From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + function + | From.Outcometree.Oext_first -> To.Outcometree.Oext_first + | From.Outcometree.Oext_next -> To.Outcometree.Oext_next + | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception + +and copy_out_extension_constructor : + From.Outcometree.out_extension_constructor -> + To.Outcometree.out_extension_constructor + = + fun + { From.Outcometree.oext_name = oext_name; + From.Outcometree.oext_type_name = oext_type_name; + From.Outcometree.oext_type_params = oext_type_params; + From.Outcometree.oext_args = oext_args; + From.Outcometree.oext_ret_type = oext_ret_type; + From.Outcometree.oext_private = oext_private } + -> + { + To.Outcometree.oext_name = oext_name; + To.Outcometree.oext_type_name = oext_type_name; + To.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + To.Outcometree.oext_args = + (List.map copy_out_type oext_args); + To.Outcometree.oext_ret_type = + (copy_option copy_out_type oext_ret_type); + To.Outcometree.oext_private = + (copy_From_Asttypes_private_flag oext_private) + } + +and copy_From_Asttypes_private_flag : + From.Asttypes.private_flag -> To.Asttypes.private_flag = + function + | From.Asttypes.Private -> To.Asttypes.Private + | From.Asttypes.Public -> To.Asttypes.Public + +and copy_out_rec_status : + From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + function + | From.Outcometree.Orec_not -> To.Outcometree.Orec_not + | From.Outcometree.Orec_first -> To.Outcometree.Orec_first + | From.Outcometree.Orec_next -> To.Outcometree.Orec_next + +and copy_out_class_type : + From.Outcometree.out_class_type -> To.Outcometree.out_class_type = + function + | From.Outcometree.Octy_constr (x0,x1) -> + To.Outcometree.Octy_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Octy_arrow (x0,x1,x2) -> + To.Outcometree.Octy_arrow + (x0, (copy_out_type x1), + (copy_out_class_type x2)) + | From.Outcometree.Octy_signature (x0,x1) -> + To.Outcometree.Octy_signature + ((copy_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) + +and copy_out_class_sig_item : + From.Outcometree.out_class_sig_item -> + To.Outcometree.out_class_sig_item + = + function + | From.Outcometree.Ocsg_constraint (x0,x1) -> + To.Outcometree.Ocsg_constraint + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_method + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> + To.Outcometree.Ocsg_value + (x0, (copy_bool x1), (copy_bool x2), + (copy_out_type x3)) + +and copy_out_type : + From.Outcometree.out_type -> To.Outcometree.out_type = + function + | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract + | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open + | From.Outcometree.Otyp_alias (x0,x1) -> + To.Outcometree.Otyp_alias + ((copy_out_type x0), x1) + | From.Outcometree.Otyp_arrow (x0,x1,x2) -> + To.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), + (copy_out_type x2)) + | From.Outcometree.Otyp_class (x0,x1,x2) -> + To.Outcometree.Otyp_class + ((copy_bool x0), (copy_out_ident x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_constr (x0,x1) -> + To.Outcometree.Otyp_constr + ((copy_out_ident x0), + (List.map copy_out_type x1)) + | From.Outcometree.Otyp_manifest (x0,x1) -> + To.Outcometree.Otyp_manifest + ((copy_out_type x0), + (copy_out_type x1)) + | From.Outcometree.Otyp_object (x0,x1) -> + To.Outcometree.Otyp_object + ((List.map + (fun x -> + let (x0,x1) = x in + (x0, (copy_out_type x1))) x0), + (copy_option copy_bool x1)) + | From.Outcometree.Otyp_record x0 -> + To.Outcometree.Otyp_record + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), (copy_out_type x2))) + x0) + | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 + | From.Outcometree.Otyp_sum x0 -> + To.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) x0) + | From.Outcometree.Otyp_tuple x0 -> + To.Outcometree.Otyp_tuple + (List.map copy_out_type x0) + | From.Outcometree.Otyp_var (x0,x1) -> + To.Outcometree.Otyp_var ((copy_bool x0), x1) + | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> + To.Outcometree.Otyp_variant + ((copy_bool x0), (copy_out_variant x1), + (copy_bool x2), + (copy_option (fun x -> List.map (fun x -> x) x) x3)) + | From.Outcometree.Otyp_poly (x0,x1) -> + To.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | From.Outcometree.Otyp_module (x0,x1,x2) -> + To.Outcometree.Otyp_module + ((match x0 with + | Oide_ident id -> id.From.Outcometree.printed_name + | From.Outcometree.Oide_apply _ + | From.Outcometree.Oide_dot _ -> + migration_error Location.none Def.Otyp_module), + (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | From.Outcometree.Otyp_attribute (x0,x1) -> + To.Outcometree.Otyp_attribute + ((copy_out_type x0), + (copy_out_attribute x1)) + +and copy_out_string : + From.Outcometree.out_string -> To.Outcometree.out_string = + function + | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string + | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes + +and copy_out_attribute : + From.Outcometree.out_attribute -> To.Outcometree.out_attribute = + fun { From.Outcometree.oattr_name = oattr_name } -> + { To.Outcometree.oattr_name = oattr_name } + +and copy_out_variant : + From.Outcometree.out_variant -> To.Outcometree.out_variant = + function + | From.Outcometree.Ovar_fields x0 -> + To.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (copy_bool x1), + (List.map copy_out_type x2))) x0) + | From.Outcometree.Ovar_typ x0 -> + To.Outcometree.Ovar_typ (copy_out_type x0) + +and copy_out_value : + From.Outcometree.out_value -> To.Outcometree.out_value = + function + | From.Outcometree.Oval_array x0 -> + To.Outcometree.Oval_array + (List.map copy_out_value x0) + | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 + | From.Outcometree.Oval_constr (x0,x1) -> + To.Outcometree.Oval_constr + ((copy_out_ident x0), + (List.map copy_out_value x1)) + | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis + | From.Outcometree.Oval_float x0 -> + To.Outcometree.Oval_float (copy_float x0) + | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 + | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 + | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 + | From.Outcometree.Oval_nativeint x0 -> + To.Outcometree.Oval_nativeint x0 + | From.Outcometree.Oval_list x0 -> + To.Outcometree.Oval_list + (List.map copy_out_value x0) + | From.Outcometree.Oval_printer x0 -> + To.Outcometree.Oval_printer x0 + | From.Outcometree.Oval_record x0 -> + To.Outcometree.Oval_record + (List.map + (fun x -> + let (x0,x1) = x in + ((copy_out_ident x0), + (copy_out_value x1))) x0) + | From.Outcometree.Oval_string (x0, x1, x2) -> + To.Outcometree.Oval_string (x0, x1, copy_out_string x2) + | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 + | From.Outcometree.Oval_tuple x0 -> + To.Outcometree.Oval_tuple + (List.map copy_out_value x0) + | From.Outcometree.Oval_variant (x0,x1) -> + To.Outcometree.Oval_variant + (x0, (copy_option copy_out_value x1)) + +and copy_float : float -> float = fun x -> x + +and copy_out_ident : + From.Outcometree.out_ident -> To.Outcometree.out_ident = + function + | From.Outcometree.Oide_apply (x0,x1) -> + To.Outcometree.Oide_apply + ((copy_out_ident x0), + (copy_out_ident x1)) + | From.Outcometree.Oide_dot (x0,x1) -> + To.Outcometree.Oide_dot + ((copy_out_ident x0), x1) + | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0.From.Outcometree.printed_name + +let copy_out_type_extension : + From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = + fun + { From.Outcometree.otyext_name = otyext_name; + From.Outcometree.otyext_params = otyext_params; + From.Outcometree.otyext_constructors = otyext_constructors; + From.Outcometree.otyext_private = otyext_private } + -> + { + To.Outcometree.otyext_name = otyext_name; + To.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + To.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0,x1,x2) = x in + (x0, (List.map copy_out_type x1), + (copy_option copy_out_type x2))) + otyext_constructors); + To.Outcometree.otyext_private = + (copy_private_flag otyext_private) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409.ml new file mode 100644 index 000000000..48bfd1e48 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409.ml @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_408_409_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_409_408_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409_migrate.ml new file mode 100644 index 000000000..297b53bc2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_408_409_migrate.ml @@ -0,0 +1,1501 @@ +open Stdlib0 +module From = Ast_408 +module To = Ast_409 +let rec copy_out_type_extension : + Ast_408.Outcometree.out_type_extension -> + Ast_409.Outcometree.out_type_extension + = + fun + { Ast_408.Outcometree.otyext_name = otyext_name; + Ast_408.Outcometree.otyext_params = otyext_params; + Ast_408.Outcometree.otyext_constructors = otyext_constructors; + Ast_408.Outcometree.otyext_private = otyext_private } + -> + { + Ast_409.Outcometree.otyext_name = otyext_name; + Ast_409.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_409.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_409.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_408.Outcometree.out_phrase -> Ast_409.Outcometree.out_phrase = + function + | Ast_408.Outcometree.Ophr_eval (x0, x1) -> + Ast_409.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_408.Outcometree.Ophr_signature x0 -> + Ast_409.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_408.Outcometree.Ophr_exception x0 -> + Ast_409.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_408.Outcometree.out_sig_item -> Ast_409.Outcometree.out_sig_item = + function + | Ast_408.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_409.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_408.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_409.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_408.Outcometree.Osig_typext (x0, x1) -> + Ast_409.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_408.Outcometree.Osig_modtype (x0, x1) -> + Ast_409.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_408.Outcometree.Osig_module (x0, x1, x2) -> + Ast_409.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_408.Outcometree.Osig_type (x0, x1) -> + Ast_409.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_408.Outcometree.Osig_value x0 -> + Ast_409.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_408.Outcometree.Osig_ellipsis -> Ast_409.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_408.Outcometree.out_val_decl -> Ast_409.Outcometree.out_val_decl = + fun + { Ast_408.Outcometree.oval_name = oval_name; + Ast_408.Outcometree.oval_type = oval_type; + Ast_408.Outcometree.oval_prims = oval_prims; + Ast_408.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_409.Outcometree.oval_name = oval_name; + Ast_409.Outcometree.oval_type = (copy_out_type oval_type); + Ast_409.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_409.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_408.Outcometree.out_type_decl -> Ast_409.Outcometree.out_type_decl = + fun + { Ast_408.Outcometree.otype_name = otype_name; + Ast_408.Outcometree.otype_params = otype_params; + Ast_408.Outcometree.otype_type = otype_type; + Ast_408.Outcometree.otype_private = otype_private; + Ast_408.Outcometree.otype_immediate = otype_immediate; + Ast_408.Outcometree.otype_unboxed = otype_unboxed; + Ast_408.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_409.Outcometree.otype_name = otype_name; + Ast_409.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_409.Outcometree.otype_type = (copy_out_type otype_type); + Ast_409.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_409.Outcometree.otype_immediate = otype_immediate; + Ast_409.Outcometree.otype_unboxed = otype_unboxed; + Ast_409.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_out_module_type : + Ast_408.Outcometree.out_module_type -> Ast_409.Outcometree.out_module_type + = + function + | Ast_408.Outcometree.Omty_abstract -> Ast_409.Outcometree.Omty_abstract + | Ast_408.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_409.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_408.Outcometree.Omty_ident x0 -> + Ast_409.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_408.Outcometree.Omty_signature x0 -> + Ast_409.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_408.Outcometree.Omty_alias x0 -> + Ast_409.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_408.Outcometree.out_ext_status -> Ast_409.Outcometree.out_ext_status = + function + | Ast_408.Outcometree.Oext_first -> Ast_409.Outcometree.Oext_first + | Ast_408.Outcometree.Oext_next -> Ast_409.Outcometree.Oext_next + | Ast_408.Outcometree.Oext_exception -> Ast_409.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_408.Outcometree.out_extension_constructor -> + Ast_409.Outcometree.out_extension_constructor + = + fun + { Ast_408.Outcometree.oext_name = oext_name; + Ast_408.Outcometree.oext_type_name = oext_type_name; + Ast_408.Outcometree.oext_type_params = oext_type_params; + Ast_408.Outcometree.oext_args = oext_args; + Ast_408.Outcometree.oext_ret_type = oext_ret_type; + Ast_408.Outcometree.oext_private = oext_private } + -> + { + Ast_409.Outcometree.oext_name = oext_name; + Ast_409.Outcometree.oext_type_name = oext_type_name; + Ast_409.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_409.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_409.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_408.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = + function + | Ast_408.Outcometree.Orec_not -> Ast_409.Outcometree.Orec_not + | Ast_408.Outcometree.Orec_first -> Ast_409.Outcometree.Orec_first + | Ast_408.Outcometree.Orec_next -> Ast_409.Outcometree.Orec_next +and copy_out_class_type : + Ast_408.Outcometree.out_class_type -> Ast_409.Outcometree.out_class_type = + function + | Ast_408.Outcometree.Octy_constr (x0, x1) -> + Ast_409.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_408.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_409.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_408.Outcometree.Octy_signature (x0, x1) -> + Ast_409.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_408.Outcometree.out_class_sig_item -> + Ast_409.Outcometree.out_class_sig_item + = + function + | Ast_408.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_409.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_408.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_409.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_408.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_409.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_408.Outcometree.out_type -> Ast_409.Outcometree.out_type = + function + | Ast_408.Outcometree.Otyp_abstract -> Ast_409.Outcometree.Otyp_abstract + | Ast_408.Outcometree.Otyp_open -> Ast_409.Outcometree.Otyp_open + | Ast_408.Outcometree.Otyp_alias (x0, x1) -> + Ast_409.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_408.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_408.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_408.Outcometree.Otyp_constr (x0, x1) -> + Ast_409.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_408.Outcometree.Otyp_manifest (x0, x1) -> + Ast_409.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_408.Outcometree.Otyp_object (x0, x1) -> + Ast_409.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (Option.map (fun x -> x) x1)) + | Ast_408.Outcometree.Otyp_record x0 -> + Ast_409.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_408.Outcometree.Otyp_stuff x0 -> Ast_409.Outcometree.Otyp_stuff x0 + | Ast_408.Outcometree.Otyp_sum x0 -> + Ast_409.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) x0) + | Ast_408.Outcometree.Otyp_tuple x0 -> + Ast_409.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_408.Outcometree.Otyp_var (x0, x1) -> + Ast_409.Outcometree.Otyp_var (x0, x1) + | Ast_408.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_409.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_408.Outcometree.Otyp_poly (x0, x1) -> + Ast_409.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_408.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_408.Outcometree.Otyp_attribute (x0, x1) -> + Ast_409.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_408.Outcometree.out_attribute -> Ast_409.Outcometree.out_attribute = + fun { Ast_408.Outcometree.oattr_name = oattr_name } -> + { Ast_409.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_408.Outcometree.out_variant -> Ast_409.Outcometree.out_variant = + function + | Ast_408.Outcometree.Ovar_fields x0 -> + Ast_409.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_408.Outcometree.Ovar_typ x0 -> + Ast_409.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_408.Outcometree.out_value -> Ast_409.Outcometree.out_value = + function + | Ast_408.Outcometree.Oval_array x0 -> + Ast_409.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_char x0 -> Ast_409.Outcometree.Oval_char x0 + | Ast_408.Outcometree.Oval_constr (x0, x1) -> + Ast_409.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_408.Outcometree.Oval_ellipsis -> Ast_409.Outcometree.Oval_ellipsis + | Ast_408.Outcometree.Oval_float x0 -> Ast_409.Outcometree.Oval_float x0 + | Ast_408.Outcometree.Oval_int x0 -> Ast_409.Outcometree.Oval_int x0 + | Ast_408.Outcometree.Oval_int32 x0 -> Ast_409.Outcometree.Oval_int32 x0 + | Ast_408.Outcometree.Oval_int64 x0 -> Ast_409.Outcometree.Oval_int64 x0 + | Ast_408.Outcometree.Oval_nativeint x0 -> + Ast_409.Outcometree.Oval_nativeint x0 + | Ast_408.Outcometree.Oval_list x0 -> + Ast_409.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_printer x0 -> + Ast_409.Outcometree.Oval_printer x0 + | Ast_408.Outcometree.Oval_record x0 -> + Ast_409.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_408.Outcometree.Oval_string (x0, x1, x2) -> + Ast_409.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_408.Outcometree.Oval_stuff x0 -> Ast_409.Outcometree.Oval_stuff x0 + | Ast_408.Outcometree.Oval_tuple x0 -> + Ast_409.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_variant (x0, x1) -> + Ast_409.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_408.Outcometree.out_string -> Ast_409.Outcometree.out_string = + function + | Ast_408.Outcometree.Ostr_string -> Ast_409.Outcometree.Ostr_string + | Ast_408.Outcometree.Ostr_bytes -> Ast_409.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_408.Outcometree.out_ident -> Ast_409.Outcometree.out_ident = + function + | Ast_408.Outcometree.Oide_apply (x0, x1) -> + Ast_409.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_408.Outcometree.Oide_dot (x0, x1) -> + Ast_409.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_408.Outcometree.Oide_ident x0 -> + Ast_409.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_408.Outcometree.out_name -> Ast_409.Outcometree.out_name = + fun { Ast_408.Outcometree.printed_name = printed_name } -> + { Ast_409.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_408.Parsetree.toplevel_phrase -> Ast_409.Parsetree.toplevel_phrase = + function + | Ast_408.Parsetree.Ptop_def x0 -> + Ast_409.Parsetree.Ptop_def (copy_structure x0) + | Ast_408.Parsetree.Ptop_dir x0 -> + Ast_409.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_408.Parsetree.toplevel_directive -> + Ast_409.Parsetree.toplevel_directive + = + fun + { Ast_408.Parsetree.pdir_name = pdir_name; + Ast_408.Parsetree.pdir_arg = pdir_arg; + Ast_408.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_409.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_409.Parsetree.pdir_arg = + (Option.map copy_directive_argument pdir_arg); + Ast_409.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_408.Parsetree.directive_argument -> + Ast_409.Parsetree.directive_argument + = + fun + { Ast_408.Parsetree.pdira_desc = pdira_desc; + Ast_408.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_409.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_409.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_408.Parsetree.directive_argument_desc -> + Ast_409.Parsetree.directive_argument_desc + = + function + | Ast_408.Parsetree.Pdir_string x0 -> Ast_409.Parsetree.Pdir_string x0 + | Ast_408.Parsetree.Pdir_int (x0, x1) -> + Ast_409.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) + | Ast_408.Parsetree.Pdir_ident x0 -> + Ast_409.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_408.Parsetree.Pdir_bool x0 -> Ast_409.Parsetree.Pdir_bool x0 +and copy_typ : Ast_408.Parsetree.typ -> Ast_409.Parsetree.typ = + fun x -> copy_core_type x +and copy_pat : Ast_408.Parsetree.pat -> Ast_409.Parsetree.pat = + fun x -> copy_pattern x +and copy_expr : Ast_408.Parsetree.expr -> Ast_409.Parsetree.expr = + fun x -> copy_expression x +and copy_expression : + Ast_408.Parsetree.expression -> Ast_409.Parsetree.expression = + fun + { Ast_408.Parsetree.pexp_desc = pexp_desc; + Ast_408.Parsetree.pexp_loc = pexp_loc; + Ast_408.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_408.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_409.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_409.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_409.Parsetree.pexp_loc_stack = + (List.map copy_location pexp_loc_stack); + Ast_409.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expression_desc : + Ast_408.Parsetree.expression_desc -> Ast_409.Parsetree.expression_desc = + function + | Ast_408.Parsetree.Pexp_ident x0 -> + Ast_409.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_408.Parsetree.Pexp_constant x0 -> + Ast_409.Parsetree.Pexp_constant (copy_constant x0) + | Ast_408.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_408.Parsetree.Pexp_function x0 -> + Ast_409.Parsetree.Pexp_function (copy_cases x0) + | Ast_408.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_409.Parsetree.Pexp_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_408.Parsetree.Pexp_apply (x0, x1) -> + Ast_409.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_408.Parsetree.Pexp_match (x0, x1) -> + Ast_409.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) + | Ast_408.Parsetree.Pexp_try (x0, x1) -> + Ast_409.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) + | Ast_408.Parsetree.Pexp_tuple x0 -> + Ast_409.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_408.Parsetree.Pexp_construct (x0, x1) -> + Ast_409.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) + | Ast_408.Parsetree.Pexp_variant (x0, x1) -> + Ast_409.Parsetree.Pexp_variant + ((copy_label x0), (Option.map copy_expression x1)) + | Ast_408.Parsetree.Pexp_record (x0, x1) -> + Ast_409.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_408.Parsetree.Pexp_field (x0, x1) -> + Ast_409.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_408.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_408.Parsetree.Pexp_array x0 -> + Ast_409.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_408.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (Option.map copy_expression x2)) + | Ast_408.Parsetree.Pexp_sequence (x0, x1) -> + Ast_409.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_while (x0, x1) -> + Ast_409.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_409.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_408.Parsetree.Pexp_constraint (x0, x1) -> + Ast_409.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_408.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_coerce + ((copy_expression x0), (Option.map copy_core_type x1), + (copy_core_type x2)) + | Ast_408.Parsetree.Pexp_send (x0, x1) -> + Ast_409.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_408.Parsetree.Pexp_new x0 -> + Ast_409.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_408.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_409.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_override x0 -> + Ast_409.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_408.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), (copy_module_expr x1), + (copy_expression x2)) + | Ast_408.Parsetree.Pexp_letexception (x0, x1) -> + Ast_409.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_assert x0 -> + Ast_409.Parsetree.Pexp_assert (copy_expression x0) + | Ast_408.Parsetree.Pexp_lazy x0 -> + Ast_409.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_408.Parsetree.Pexp_poly (x0, x1) -> + Ast_409.Parsetree.Pexp_poly + ((copy_expression x0), (Option.map copy_core_type x1)) + | Ast_408.Parsetree.Pexp_object x0 -> + Ast_409.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_408.Parsetree.Pexp_newtype (x0, x1) -> + Ast_409.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_pack x0 -> + Ast_409.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_408.Parsetree.Pexp_open (x0, x1) -> + Ast_409.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_408.Parsetree.Pexp_letop x0 -> + Ast_409.Parsetree.Pexp_letop (copy_letop x0) + | Ast_408.Parsetree.Pexp_extension x0 -> + Ast_409.Parsetree.Pexp_extension (copy_extension x0) + | Ast_408.Parsetree.Pexp_unreachable -> Ast_409.Parsetree.Pexp_unreachable +and copy_letop : Ast_408.Parsetree.letop -> Ast_409.Parsetree.letop = + fun + { Ast_408.Parsetree.let_ = let_; Ast_408.Parsetree.ands = ands; + Ast_408.Parsetree.body = body } + -> + { + Ast_409.Parsetree.let_ = (copy_binding_op let_); + Ast_409.Parsetree.ands = (List.map copy_binding_op ands); + Ast_409.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_408.Parsetree.binding_op -> Ast_409.Parsetree.binding_op = + fun + { Ast_408.Parsetree.pbop_op = pbop_op; + Ast_408.Parsetree.pbop_pat = pbop_pat; + Ast_408.Parsetree.pbop_exp = pbop_exp; + Ast_408.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_409.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_409.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_409.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_409.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_408.Asttypes.direction_flag -> Ast_409.Asttypes.direction_flag = + function + | Ast_408.Asttypes.Upto -> Ast_409.Asttypes.Upto + | Ast_408.Asttypes.Downto -> Ast_409.Asttypes.Downto +and copy_cases : Ast_408.Parsetree.cases -> Ast_409.Parsetree.cases = + fun x -> List.map copy_case x +and copy_case : Ast_408.Parsetree.case -> Ast_409.Parsetree.case = + fun + { Ast_408.Parsetree.pc_lhs = pc_lhs; + Ast_408.Parsetree.pc_guard = pc_guard; + Ast_408.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_409.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_409.Parsetree.pc_guard = (Option.map copy_expression pc_guard); + Ast_409.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_value_binding : + Ast_408.Parsetree.value_binding -> Ast_409.Parsetree.value_binding = + fun + { Ast_408.Parsetree.pvb_pat = pvb_pat; + Ast_408.Parsetree.pvb_expr = pvb_expr; + Ast_408.Parsetree.pvb_attributes = pvb_attributes; + Ast_408.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_409.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_409.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_409.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_409.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_408.Parsetree.pattern -> Ast_409.Parsetree.pattern = + fun + { Ast_408.Parsetree.ppat_desc = ppat_desc; + Ast_408.Parsetree.ppat_loc = ppat_loc; + Ast_408.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_408.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_409.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_409.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_409.Parsetree.ppat_loc_stack = + (List.map copy_location ppat_loc_stack); + Ast_409.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pattern_desc : + Ast_408.Parsetree.pattern_desc -> Ast_409.Parsetree.pattern_desc = + function + | Ast_408.Parsetree.Ppat_any -> Ast_409.Parsetree.Ppat_any + | Ast_408.Parsetree.Ppat_var x0 -> + Ast_409.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_408.Parsetree.Ppat_alias (x0, x1) -> + Ast_409.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_408.Parsetree.Ppat_constant x0 -> + Ast_409.Parsetree.Ppat_constant (copy_constant x0) + | Ast_408.Parsetree.Ppat_interval (x0, x1) -> + Ast_409.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_408.Parsetree.Ppat_tuple x0 -> + Ast_409.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_408.Parsetree.Ppat_construct (x0, x1) -> + Ast_409.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) + | Ast_408.Parsetree.Ppat_variant (x0, x1) -> + Ast_409.Parsetree.Ppat_variant + ((copy_label x0), (Option.map copy_pattern x1)) + | Ast_408.Parsetree.Ppat_record (x0, x1) -> + Ast_409.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_408.Parsetree.Ppat_array x0 -> + Ast_409.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_408.Parsetree.Ppat_or (x0, x1) -> + Ast_409.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_408.Parsetree.Ppat_constraint (x0, x1) -> + Ast_409.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_408.Parsetree.Ppat_type x0 -> + Ast_409.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_408.Parsetree.Ppat_lazy x0 -> + Ast_409.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_408.Parsetree.Ppat_unpack x0 -> + Ast_409.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) + | Ast_408.Parsetree.Ppat_exception x0 -> + Ast_409.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_408.Parsetree.Ppat_extension x0 -> + Ast_409.Parsetree.Ppat_extension (copy_extension x0) + | Ast_408.Parsetree.Ppat_open (x0, x1) -> + Ast_409.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_408.Parsetree.core_type -> Ast_409.Parsetree.core_type = + fun + { Ast_408.Parsetree.ptyp_desc = ptyp_desc; + Ast_408.Parsetree.ptyp_loc = ptyp_loc; + Ast_408.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_408.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_409.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_409.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_409.Parsetree.ptyp_loc_stack = + (List.map copy_location ptyp_loc_stack); + Ast_409.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_core_type_desc : + Ast_408.Parsetree.core_type_desc -> Ast_409.Parsetree.core_type_desc = + function + | Ast_408.Parsetree.Ptyp_any -> Ast_409.Parsetree.Ptyp_any + | Ast_408.Parsetree.Ptyp_var x0 -> Ast_409.Parsetree.Ptyp_var x0 + | Ast_408.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_409.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_408.Parsetree.Ptyp_tuple x0 -> + Ast_409.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_408.Parsetree.Ptyp_constr (x0, x1) -> + Ast_409.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_408.Parsetree.Ptyp_object (x0, x1) -> + Ast_409.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_408.Parsetree.Ptyp_class (x0, x1) -> + Ast_409.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_408.Parsetree.Ptyp_alias (x0, x1) -> + Ast_409.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_408.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_409.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (Option.map (fun x -> List.map copy_label x) x2)) + | Ast_408.Parsetree.Ptyp_poly (x0, x1) -> + Ast_409.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_408.Parsetree.Ptyp_package x0 -> + Ast_409.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_408.Parsetree.Ptyp_extension x0 -> + Ast_409.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_408.Parsetree.package_type -> Ast_409.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_408.Parsetree.row_field -> Ast_409.Parsetree.row_field = + fun + { Ast_408.Parsetree.prf_desc = prf_desc; + Ast_408.Parsetree.prf_loc = prf_loc; + Ast_408.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_409.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_409.Parsetree.prf_loc = (copy_location prf_loc); + Ast_409.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_408.Parsetree.row_field_desc -> Ast_409.Parsetree.row_field_desc = + function + | Ast_408.Parsetree.Rtag (x0, x1, x2) -> + Ast_409.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_408.Parsetree.Rinherit x0 -> + Ast_409.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_408.Parsetree.object_field -> Ast_409.Parsetree.object_field = + fun + { Ast_408.Parsetree.pof_desc = pof_desc; + Ast_408.Parsetree.pof_loc = pof_loc; + Ast_408.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_409.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_409.Parsetree.pof_loc = (copy_location pof_loc); + Ast_409.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_408.Parsetree.attributes -> Ast_409.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_408.Parsetree.attribute -> Ast_409.Parsetree.attribute = + fun + { Ast_408.Parsetree.attr_name = attr_name; + Ast_408.Parsetree.attr_payload = attr_payload; + Ast_408.Parsetree.attr_loc = attr_loc } + -> + { + Ast_409.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_409.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_409.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_408.Parsetree.payload -> Ast_409.Parsetree.payload = + function + | Ast_408.Parsetree.PStr x0 -> Ast_409.Parsetree.PStr (copy_structure x0) + | Ast_408.Parsetree.PSig x0 -> Ast_409.Parsetree.PSig (copy_signature x0) + | Ast_408.Parsetree.PTyp x0 -> Ast_409.Parsetree.PTyp (copy_core_type x0) + | Ast_408.Parsetree.PPat (x0, x1) -> + Ast_409.Parsetree.PPat + ((copy_pattern x0), (Option.map copy_expression x1)) +and copy_structure : + Ast_408.Parsetree.structure -> Ast_409.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_408.Parsetree.structure_item -> Ast_409.Parsetree.structure_item = + fun + { Ast_408.Parsetree.pstr_desc = pstr_desc; + Ast_408.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_409.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_409.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_408.Parsetree.structure_item_desc -> + Ast_409.Parsetree.structure_item_desc + = + function + | Ast_408.Parsetree.Pstr_eval (x0, x1) -> + Ast_409.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_408.Parsetree.Pstr_value (x0, x1) -> + Ast_409.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_408.Parsetree.Pstr_primitive x0 -> + Ast_409.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_408.Parsetree.Pstr_type (x0, x1) -> + Ast_409.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_408.Parsetree.Pstr_typext x0 -> + Ast_409.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_408.Parsetree.Pstr_exception x0 -> + Ast_409.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_408.Parsetree.Pstr_module x0 -> + Ast_409.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_408.Parsetree.Pstr_recmodule x0 -> + Ast_409.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_408.Parsetree.Pstr_modtype x0 -> + Ast_409.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_408.Parsetree.Pstr_open x0 -> + Ast_409.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_408.Parsetree.Pstr_class x0 -> + Ast_409.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_408.Parsetree.Pstr_class_type x0 -> + Ast_409.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_408.Parsetree.Pstr_include x0 -> + Ast_409.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_408.Parsetree.Pstr_attribute x0 -> + Ast_409.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_408.Parsetree.Pstr_extension (x0, x1) -> + Ast_409.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_408.Parsetree.include_declaration -> + Ast_409.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_408.Parsetree.class_declaration -> Ast_409.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_408.Parsetree.class_expr -> Ast_409.Parsetree.class_expr = + fun + { Ast_408.Parsetree.pcl_desc = pcl_desc; + Ast_408.Parsetree.pcl_loc = pcl_loc; + Ast_408.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_409.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_409.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_409.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_408.Parsetree.class_expr_desc -> Ast_409.Parsetree.class_expr_desc = + function + | Ast_408.Parsetree.Pcl_constr (x0, x1) -> + Ast_409.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_408.Parsetree.Pcl_structure x0 -> + Ast_409.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_408.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_409.Parsetree.Pcl_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_408.Parsetree.Pcl_apply (x0, x1) -> + Ast_409.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_408.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_409.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_408.Parsetree.Pcl_constraint (x0, x1) -> + Ast_409.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_408.Parsetree.Pcl_extension x0 -> + Ast_409.Parsetree.Pcl_extension (copy_extension x0) + | Ast_408.Parsetree.Pcl_open (x0, x1) -> + Ast_409.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_408.Parsetree.class_structure -> Ast_409.Parsetree.class_structure = + fun + { Ast_408.Parsetree.pcstr_self = pcstr_self; + Ast_408.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_409.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_409.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_408.Parsetree.class_field -> Ast_409.Parsetree.class_field = + fun + { Ast_408.Parsetree.pcf_desc = pcf_desc; + Ast_408.Parsetree.pcf_loc = pcf_loc; + Ast_408.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_409.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_409.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_409.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_408.Parsetree.class_field_desc -> Ast_409.Parsetree.class_field_desc = + function + | Ast_408.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_409.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_408.Parsetree.Pcf_val x0 -> + Ast_409.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_408.Parsetree.Pcf_method x0 -> + Ast_409.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_408.Parsetree.Pcf_constraint x0 -> + Ast_409.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_408.Parsetree.Pcf_initializer x0 -> + Ast_409.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_408.Parsetree.Pcf_attribute x0 -> + Ast_409.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_408.Parsetree.Pcf_extension x0 -> + Ast_409.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_408.Parsetree.class_field_kind -> Ast_409.Parsetree.class_field_kind = + function + | Ast_408.Parsetree.Cfk_virtual x0 -> + Ast_409.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_408.Parsetree.Cfk_concrete (x0, x1) -> + Ast_409.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_408.Parsetree.open_declaration -> Ast_409.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_408.Parsetree.module_binding -> Ast_409.Parsetree.module_binding = + fun + { Ast_408.Parsetree.pmb_name = pmb_name; + Ast_408.Parsetree.pmb_expr = pmb_expr; + Ast_408.Parsetree.pmb_attributes = pmb_attributes; + Ast_408.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_409.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); + Ast_409.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_409.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_409.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_408.Parsetree.module_expr -> Ast_409.Parsetree.module_expr = + fun + { Ast_408.Parsetree.pmod_desc = pmod_desc; + Ast_408.Parsetree.pmod_loc = pmod_loc; + Ast_408.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_409.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_409.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_409.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_408.Parsetree.module_expr_desc -> Ast_409.Parsetree.module_expr_desc = + function + | Ast_408.Parsetree.Pmod_ident x0 -> + Ast_409.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_408.Parsetree.Pmod_structure x0 -> + Ast_409.Parsetree.Pmod_structure (copy_structure x0) + | Ast_408.Parsetree.Pmod_functor (x0, x1, x2) -> + Ast_409.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), + (copy_module_expr x2)) + | Ast_408.Parsetree.Pmod_apply (x0, x1) -> + Ast_409.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_408.Parsetree.Pmod_constraint (x0, x1) -> + Ast_409.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_408.Parsetree.Pmod_unpack x0 -> + Ast_409.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_408.Parsetree.Pmod_extension x0 -> + Ast_409.Parsetree.Pmod_extension (copy_extension x0) +and copy_module_type : + Ast_408.Parsetree.module_type -> Ast_409.Parsetree.module_type = + fun + { Ast_408.Parsetree.pmty_desc = pmty_desc; + Ast_408.Parsetree.pmty_loc = pmty_loc; + Ast_408.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_409.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_409.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_409.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_408.Parsetree.module_type_desc -> Ast_409.Parsetree.module_type_desc = + function + | Ast_408.Parsetree.Pmty_ident x0 -> + Ast_409.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_408.Parsetree.Pmty_signature x0 -> + Ast_409.Parsetree.Pmty_signature (copy_signature x0) + | Ast_408.Parsetree.Pmty_functor (x0, x1, x2) -> + Ast_409.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), + (copy_module_type x2)) + | Ast_408.Parsetree.Pmty_with (x0, x1) -> + Ast_409.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_408.Parsetree.Pmty_typeof x0 -> + Ast_409.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_408.Parsetree.Pmty_extension x0 -> + Ast_409.Parsetree.Pmty_extension (copy_extension x0) + | Ast_408.Parsetree.Pmty_alias x0 -> + Ast_409.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_408.Parsetree.with_constraint -> Ast_409.Parsetree.with_constraint = + function + | Ast_408.Parsetree.Pwith_type (x0, x1) -> + Ast_409.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_408.Parsetree.Pwith_module (x0, x1) -> + Ast_409.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_408.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_409.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_408.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_409.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_408.Parsetree.signature -> Ast_409.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_408.Parsetree.signature_item -> Ast_409.Parsetree.signature_item = + fun + { Ast_408.Parsetree.psig_desc = psig_desc; + Ast_408.Parsetree.psig_loc = psig_loc } + -> + { + Ast_409.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_409.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_408.Parsetree.signature_item_desc -> + Ast_409.Parsetree.signature_item_desc + = + function + | Ast_408.Parsetree.Psig_value x0 -> + Ast_409.Parsetree.Psig_value (copy_value_description x0) + | Ast_408.Parsetree.Psig_type (x0, x1) -> + Ast_409.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_408.Parsetree.Psig_typesubst x0 -> + Ast_409.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_408.Parsetree.Psig_typext x0 -> + Ast_409.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_408.Parsetree.Psig_exception x0 -> + Ast_409.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_408.Parsetree.Psig_module x0 -> + Ast_409.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_408.Parsetree.Psig_modsubst x0 -> + Ast_409.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_408.Parsetree.Psig_recmodule x0 -> + Ast_409.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_408.Parsetree.Psig_modtype x0 -> + Ast_409.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_408.Parsetree.Psig_open x0 -> + Ast_409.Parsetree.Psig_open (copy_open_description x0) + | Ast_408.Parsetree.Psig_include x0 -> + Ast_409.Parsetree.Psig_include (copy_include_description x0) + | Ast_408.Parsetree.Psig_class x0 -> + Ast_409.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_408.Parsetree.Psig_class_type x0 -> + Ast_409.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_408.Parsetree.Psig_attribute x0 -> + Ast_409.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_408.Parsetree.Psig_extension (x0, x1) -> + Ast_409.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_408.Parsetree.class_type_declaration -> + Ast_409.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_408.Parsetree.class_description -> Ast_409.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_408.Parsetree.class_type -> Ast_409.Parsetree.class_type = + fun + { Ast_408.Parsetree.pcty_desc = pcty_desc; + Ast_408.Parsetree.pcty_loc = pcty_loc; + Ast_408.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_409.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_409.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_409.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_408.Parsetree.class_type_desc -> Ast_409.Parsetree.class_type_desc = + function + | Ast_408.Parsetree.Pcty_constr (x0, x1) -> + Ast_409.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_408.Parsetree.Pcty_signature x0 -> + Ast_409.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_408.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_409.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_408.Parsetree.Pcty_extension x0 -> + Ast_409.Parsetree.Pcty_extension (copy_extension x0) + | Ast_408.Parsetree.Pcty_open (x0, x1) -> + Ast_409.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_408.Parsetree.class_signature -> Ast_409.Parsetree.class_signature = + fun + { Ast_408.Parsetree.pcsig_self = pcsig_self; + Ast_408.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_409.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_409.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_408.Parsetree.class_type_field -> Ast_409.Parsetree.class_type_field = + fun + { Ast_408.Parsetree.pctf_desc = pctf_desc; + Ast_408.Parsetree.pctf_loc = pctf_loc; + Ast_408.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_409.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_409.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_409.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_408.Parsetree.class_type_field_desc -> + Ast_409.Parsetree.class_type_field_desc + = + function + | Ast_408.Parsetree.Pctf_inherit x0 -> + Ast_409.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_408.Parsetree.Pctf_val x0 -> + Ast_409.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_408.Parsetree.Pctf_method x0 -> + Ast_409.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_408.Parsetree.Pctf_constraint x0 -> + Ast_409.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_408.Parsetree.Pctf_attribute x0 -> + Ast_409.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_408.Parsetree.Pctf_extension x0 -> + Ast_409.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_408.Parsetree.extension -> Ast_409.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_408.Parsetree.class_infos -> 'g0 Ast_409.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_408.Parsetree.pci_virt = pci_virt; + Ast_408.Parsetree.pci_params = pci_params; + Ast_408.Parsetree.pci_name = pci_name; + Ast_408.Parsetree.pci_expr = pci_expr; + Ast_408.Parsetree.pci_loc = pci_loc; + Ast_408.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_409.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_409.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_409.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_409.Parsetree.pci_expr = (f0 pci_expr); + Ast_409.Parsetree.pci_loc = (copy_location pci_loc); + Ast_409.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_408.Asttypes.virtual_flag -> Ast_409.Asttypes.virtual_flag = + function + | Ast_408.Asttypes.Virtual -> Ast_409.Asttypes.Virtual + | Ast_408.Asttypes.Concrete -> Ast_409.Asttypes.Concrete +and copy_include_description : + Ast_408.Parsetree.include_description -> + Ast_409.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_408.Parsetree.include_infos -> + 'g0 Ast_409.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_408.Parsetree.pincl_mod = pincl_mod; + Ast_408.Parsetree.pincl_loc = pincl_loc; + Ast_408.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_409.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_409.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_409.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_408.Parsetree.open_description -> Ast_409.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_408.Parsetree.open_infos -> 'g0 Ast_409.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_408.Parsetree.popen_expr = popen_expr; + Ast_408.Parsetree.popen_override = popen_override; + Ast_408.Parsetree.popen_loc = popen_loc; + Ast_408.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_409.Parsetree.popen_expr = (f0 popen_expr); + Ast_409.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_409.Parsetree.popen_loc = (copy_location popen_loc); + Ast_409.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_408.Asttypes.override_flag -> Ast_409.Asttypes.override_flag = + function + | Ast_408.Asttypes.Override -> Ast_409.Asttypes.Override + | Ast_408.Asttypes.Fresh -> Ast_409.Asttypes.Fresh +and copy_module_type_declaration : + Ast_408.Parsetree.module_type_declaration -> + Ast_409.Parsetree.module_type_declaration + = + fun + { Ast_408.Parsetree.pmtd_name = pmtd_name; + Ast_408.Parsetree.pmtd_type = pmtd_type; + Ast_408.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_408.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_409.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_409.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); + Ast_409.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_409.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_408.Parsetree.module_substitution -> + Ast_409.Parsetree.module_substitution + = + fun + { Ast_408.Parsetree.pms_name = pms_name; + Ast_408.Parsetree.pms_manifest = pms_manifest; + Ast_408.Parsetree.pms_attributes = pms_attributes; + Ast_408.Parsetree.pms_loc = pms_loc } + -> + { + Ast_409.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_409.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_409.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_409.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_408.Parsetree.module_declaration -> + Ast_409.Parsetree.module_declaration + = + fun + { Ast_408.Parsetree.pmd_name = pmd_name; + Ast_408.Parsetree.pmd_type = pmd_type; + Ast_408.Parsetree.pmd_attributes = pmd_attributes; + Ast_408.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_409.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); + Ast_409.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_409.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_409.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_408.Parsetree.type_exception -> Ast_409.Parsetree.type_exception = + fun + { Ast_408.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_408.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_408.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_409.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_409.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_409.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_408.Parsetree.type_extension -> Ast_409.Parsetree.type_extension = + fun + { Ast_408.Parsetree.ptyext_path = ptyext_path; + Ast_408.Parsetree.ptyext_params = ptyext_params; + Ast_408.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_408.Parsetree.ptyext_private = ptyext_private; + Ast_408.Parsetree.ptyext_loc = ptyext_loc; + Ast_408.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_409.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_409.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_409.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_409.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_409.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_409.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_408.Parsetree.extension_constructor -> + Ast_409.Parsetree.extension_constructor + = + fun + { Ast_408.Parsetree.pext_name = pext_name; + Ast_408.Parsetree.pext_kind = pext_kind; + Ast_408.Parsetree.pext_loc = pext_loc; + Ast_408.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_409.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_409.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_409.Parsetree.pext_loc = (copy_location pext_loc); + Ast_409.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_408.Parsetree.extension_constructor_kind -> + Ast_409.Parsetree.extension_constructor_kind + = + function + | Ast_408.Parsetree.Pext_decl (x0, x1) -> + Ast_409.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) + | Ast_408.Parsetree.Pext_rebind x0 -> + Ast_409.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_408.Parsetree.type_declaration -> Ast_409.Parsetree.type_declaration = + fun + { Ast_408.Parsetree.ptype_name = ptype_name; + Ast_408.Parsetree.ptype_params = ptype_params; + Ast_408.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_408.Parsetree.ptype_kind = ptype_kind; + Ast_408.Parsetree.ptype_private = ptype_private; + Ast_408.Parsetree.ptype_manifest = ptype_manifest; + Ast_408.Parsetree.ptype_attributes = ptype_attributes; + Ast_408.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_409.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_409.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_409.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_409.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_409.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_409.Parsetree.ptype_manifest = + (Option.map copy_core_type ptype_manifest); + Ast_409.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_409.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_408.Asttypes.private_flag -> Ast_409.Asttypes.private_flag = + function + | Ast_408.Asttypes.Private -> Ast_409.Asttypes.Private + | Ast_408.Asttypes.Public -> Ast_409.Asttypes.Public +and copy_type_kind : + Ast_408.Parsetree.type_kind -> Ast_409.Parsetree.type_kind = + function + | Ast_408.Parsetree.Ptype_abstract -> Ast_409.Parsetree.Ptype_abstract + | Ast_408.Parsetree.Ptype_variant x0 -> + Ast_409.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_408.Parsetree.Ptype_record x0 -> + Ast_409.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_408.Parsetree.Ptype_open -> Ast_409.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_408.Parsetree.constructor_declaration -> + Ast_409.Parsetree.constructor_declaration + = + fun + { Ast_408.Parsetree.pcd_name = pcd_name; + Ast_408.Parsetree.pcd_args = pcd_args; + Ast_408.Parsetree.pcd_res = pcd_res; + Ast_408.Parsetree.pcd_loc = pcd_loc; + Ast_408.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_409.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_409.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_409.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); + Ast_409.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_409.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_408.Parsetree.constructor_arguments -> + Ast_409.Parsetree.constructor_arguments + = + function + | Ast_408.Parsetree.Pcstr_tuple x0 -> + Ast_409.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_408.Parsetree.Pcstr_record x0 -> + Ast_409.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_408.Parsetree.label_declaration -> Ast_409.Parsetree.label_declaration + = + fun + { Ast_408.Parsetree.pld_name = pld_name; + Ast_408.Parsetree.pld_mutable = pld_mutable; + Ast_408.Parsetree.pld_type = pld_type; + Ast_408.Parsetree.pld_loc = pld_loc; + Ast_408.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_409.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_409.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_409.Parsetree.pld_type = (copy_core_type pld_type); + Ast_409.Parsetree.pld_loc = (copy_location pld_loc); + Ast_409.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_408.Asttypes.mutable_flag -> Ast_409.Asttypes.mutable_flag = + function + | Ast_408.Asttypes.Immutable -> Ast_409.Asttypes.Immutable + | Ast_408.Asttypes.Mutable -> Ast_409.Asttypes.Mutable +and copy_variance : Ast_408.Asttypes.variance -> Ast_409.Asttypes.variance = + function + | Ast_408.Asttypes.Covariant -> Ast_409.Asttypes.Covariant + | Ast_408.Asttypes.Contravariant -> Ast_409.Asttypes.Contravariant + | Ast_408.Asttypes.Invariant -> Ast_409.Asttypes.Invariant +and copy_value_description : + Ast_408.Parsetree.value_description -> Ast_409.Parsetree.value_description + = + fun + { Ast_408.Parsetree.pval_name = pval_name; + Ast_408.Parsetree.pval_type = pval_type; + Ast_408.Parsetree.pval_prim = pval_prim; + Ast_408.Parsetree.pval_attributes = pval_attributes; + Ast_408.Parsetree.pval_loc = pval_loc } + -> + { + Ast_409.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_409.Parsetree.pval_type = (copy_core_type pval_type); + Ast_409.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_409.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_409.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_408.Parsetree.object_field_desc -> Ast_409.Parsetree.object_field_desc + = + function + | Ast_408.Parsetree.Otag (x0, x1) -> + Ast_409.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_408.Parsetree.Oinherit x0 -> + Ast_409.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_408.Asttypes.arg_label -> Ast_409.Asttypes.arg_label + = + function + | Ast_408.Asttypes.Nolabel -> Ast_409.Asttypes.Nolabel + | Ast_408.Asttypes.Labelled x0 -> Ast_409.Asttypes.Labelled x0 + | Ast_408.Asttypes.Optional x0 -> Ast_409.Asttypes.Optional x0 +and copy_closed_flag : + Ast_408.Asttypes.closed_flag -> Ast_409.Asttypes.closed_flag = + function + | Ast_408.Asttypes.Closed -> Ast_409.Asttypes.Closed + | Ast_408.Asttypes.Open -> Ast_409.Asttypes.Open +and copy_label : Ast_408.Asttypes.label -> Ast_409.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_408.Asttypes.rec_flag -> Ast_409.Asttypes.rec_flag = + function + | Ast_408.Asttypes.Nonrecursive -> Ast_409.Asttypes.Nonrecursive + | Ast_408.Asttypes.Recursive -> Ast_409.Asttypes.Recursive +and copy_constant : Ast_408.Parsetree.constant -> Ast_409.Parsetree.constant + = + function + | Ast_408.Parsetree.Pconst_integer (x0, x1) -> + Ast_409.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) + | Ast_408.Parsetree.Pconst_char x0 -> Ast_409.Parsetree.Pconst_char x0 + | Ast_408.Parsetree.Pconst_string (x0, x1) -> + Ast_409.Parsetree.Pconst_string (x0, (Option.map (fun x -> x) x1)) + | Ast_408.Parsetree.Pconst_float (x0, x1) -> + Ast_409.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) +and copy_Longident_t : Ast_408.Longident.t -> Ast_409.Longident.t = + function + | Ast_408.Longident.Lident x0 -> Ast_409.Longident.Lident x0 + | Ast_408.Longident.Ldot (x0, x1) -> + Ast_409.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_408.Longident.Lapply (x0, x1) -> + Ast_409.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_408.Asttypes.loc -> 'g0 Ast_409.Asttypes.loc + = + fun f0 -> + fun { Ast_408.Asttypes.txt = txt; Ast_408.Asttypes.loc = loc } -> + { + Ast_409.Asttypes.txt = (f0 txt); + Ast_409.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_408.Location.t -> Ast_409.Location.t = + fun + { Ast_408.Location.loc_start = loc_start; + Ast_408.Location.loc_end = loc_end; + Ast_408.Location.loc_ghost = loc_ghost } + -> + { + Ast_409.Location.loc_start = (copy_position loc_start); + Ast_409.Location.loc_end = (copy_position loc_end); + Ast_409.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408.ml new file mode 100644 index 000000000..b0754d676 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408.ml @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_409_408_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_408_409_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408_migrate.ml new file mode 100644 index 000000000..3cddd11fd --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_408_migrate.ml @@ -0,0 +1,1501 @@ +open Stdlib0 +module From = Ast_409 +module To = Ast_408 +let rec copy_out_type_extension : + Ast_409.Outcometree.out_type_extension -> + Ast_408.Outcometree.out_type_extension + = + fun + { Ast_409.Outcometree.otyext_name = otyext_name; + Ast_409.Outcometree.otyext_params = otyext_params; + Ast_409.Outcometree.otyext_constructors = otyext_constructors; + Ast_409.Outcometree.otyext_private = otyext_private } + -> + { + Ast_408.Outcometree.otyext_name = otyext_name; + Ast_408.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_408.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_408.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_409.Outcometree.out_phrase -> Ast_408.Outcometree.out_phrase = + function + | Ast_409.Outcometree.Ophr_eval (x0, x1) -> + Ast_408.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_409.Outcometree.Ophr_signature x0 -> + Ast_408.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_409.Outcometree.Ophr_exception x0 -> + Ast_408.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_409.Outcometree.out_sig_item -> Ast_408.Outcometree.out_sig_item = + function + | Ast_409.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_408.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_409.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_408.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_409.Outcometree.Osig_typext (x0, x1) -> + Ast_408.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_409.Outcometree.Osig_modtype (x0, x1) -> + Ast_408.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_409.Outcometree.Osig_module (x0, x1, x2) -> + Ast_408.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_409.Outcometree.Osig_type (x0, x1) -> + Ast_408.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_409.Outcometree.Osig_value x0 -> + Ast_408.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_409.Outcometree.Osig_ellipsis -> Ast_408.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_409.Outcometree.out_val_decl -> Ast_408.Outcometree.out_val_decl = + fun + { Ast_409.Outcometree.oval_name = oval_name; + Ast_409.Outcometree.oval_type = oval_type; + Ast_409.Outcometree.oval_prims = oval_prims; + Ast_409.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_408.Outcometree.oval_name = oval_name; + Ast_408.Outcometree.oval_type = (copy_out_type oval_type); + Ast_408.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_408.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_409.Outcometree.out_type_decl -> Ast_408.Outcometree.out_type_decl = + fun + { Ast_409.Outcometree.otype_name = otype_name; + Ast_409.Outcometree.otype_params = otype_params; + Ast_409.Outcometree.otype_type = otype_type; + Ast_409.Outcometree.otype_private = otype_private; + Ast_409.Outcometree.otype_immediate = otype_immediate; + Ast_409.Outcometree.otype_unboxed = otype_unboxed; + Ast_409.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_408.Outcometree.otype_name = otype_name; + Ast_408.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_408.Outcometree.otype_type = (copy_out_type otype_type); + Ast_408.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_408.Outcometree.otype_immediate = otype_immediate; + Ast_408.Outcometree.otype_unboxed = otype_unboxed; + Ast_408.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_out_module_type : + Ast_409.Outcometree.out_module_type -> Ast_408.Outcometree.out_module_type + = + function + | Ast_409.Outcometree.Omty_abstract -> Ast_408.Outcometree.Omty_abstract + | Ast_409.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_408.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_409.Outcometree.Omty_ident x0 -> + Ast_408.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_409.Outcometree.Omty_signature x0 -> + Ast_408.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_409.Outcometree.Omty_alias x0 -> + Ast_408.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_409.Outcometree.out_ext_status -> Ast_408.Outcometree.out_ext_status = + function + | Ast_409.Outcometree.Oext_first -> Ast_408.Outcometree.Oext_first + | Ast_409.Outcometree.Oext_next -> Ast_408.Outcometree.Oext_next + | Ast_409.Outcometree.Oext_exception -> Ast_408.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_409.Outcometree.out_extension_constructor -> + Ast_408.Outcometree.out_extension_constructor + = + fun + { Ast_409.Outcometree.oext_name = oext_name; + Ast_409.Outcometree.oext_type_name = oext_type_name; + Ast_409.Outcometree.oext_type_params = oext_type_params; + Ast_409.Outcometree.oext_args = oext_args; + Ast_409.Outcometree.oext_ret_type = oext_ret_type; + Ast_409.Outcometree.oext_private = oext_private } + -> + { + Ast_408.Outcometree.oext_name = oext_name; + Ast_408.Outcometree.oext_type_name = oext_type_name; + Ast_408.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_408.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_408.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_408.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_409.Outcometree.out_rec_status -> Ast_408.Outcometree.out_rec_status = + function + | Ast_409.Outcometree.Orec_not -> Ast_408.Outcometree.Orec_not + | Ast_409.Outcometree.Orec_first -> Ast_408.Outcometree.Orec_first + | Ast_409.Outcometree.Orec_next -> Ast_408.Outcometree.Orec_next +and copy_out_class_type : + Ast_409.Outcometree.out_class_type -> Ast_408.Outcometree.out_class_type = + function + | Ast_409.Outcometree.Octy_constr (x0, x1) -> + Ast_408.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_409.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_408.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_409.Outcometree.Octy_signature (x0, x1) -> + Ast_408.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_409.Outcometree.out_class_sig_item -> + Ast_408.Outcometree.out_class_sig_item + = + function + | Ast_409.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_408.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_409.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_408.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_409.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_408.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_409.Outcometree.out_type -> Ast_408.Outcometree.out_type = + function + | Ast_409.Outcometree.Otyp_abstract -> Ast_408.Outcometree.Otyp_abstract + | Ast_409.Outcometree.Otyp_open -> Ast_408.Outcometree.Otyp_open + | Ast_409.Outcometree.Otyp_alias (x0, x1) -> + Ast_408.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_409.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_408.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_409.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_408.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_409.Outcometree.Otyp_constr (x0, x1) -> + Ast_408.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_409.Outcometree.Otyp_manifest (x0, x1) -> + Ast_408.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_409.Outcometree.Otyp_object (x0, x1) -> + Ast_408.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (Option.map (fun x -> x) x1)) + | Ast_409.Outcometree.Otyp_record x0 -> + Ast_408.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_409.Outcometree.Otyp_stuff x0 -> Ast_408.Outcometree.Otyp_stuff x0 + | Ast_409.Outcometree.Otyp_sum x0 -> + Ast_408.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) x0) + | Ast_409.Outcometree.Otyp_tuple x0 -> + Ast_408.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_409.Outcometree.Otyp_var (x0, x1) -> + Ast_408.Outcometree.Otyp_var (x0, x1) + | Ast_409.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_408.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_409.Outcometree.Otyp_poly (x0, x1) -> + Ast_408.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_409.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_408.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_409.Outcometree.Otyp_attribute (x0, x1) -> + Ast_408.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_409.Outcometree.out_attribute -> Ast_408.Outcometree.out_attribute = + fun { Ast_409.Outcometree.oattr_name = oattr_name } -> + { Ast_408.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_409.Outcometree.out_variant -> Ast_408.Outcometree.out_variant = + function + | Ast_409.Outcometree.Ovar_fields x0 -> + Ast_408.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_409.Outcometree.Ovar_typ x0 -> + Ast_408.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_409.Outcometree.out_value -> Ast_408.Outcometree.out_value = + function + | Ast_409.Outcometree.Oval_array x0 -> + Ast_408.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_char x0 -> Ast_408.Outcometree.Oval_char x0 + | Ast_409.Outcometree.Oval_constr (x0, x1) -> + Ast_408.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_409.Outcometree.Oval_ellipsis -> Ast_408.Outcometree.Oval_ellipsis + | Ast_409.Outcometree.Oval_float x0 -> Ast_408.Outcometree.Oval_float x0 + | Ast_409.Outcometree.Oval_int x0 -> Ast_408.Outcometree.Oval_int x0 + | Ast_409.Outcometree.Oval_int32 x0 -> Ast_408.Outcometree.Oval_int32 x0 + | Ast_409.Outcometree.Oval_int64 x0 -> Ast_408.Outcometree.Oval_int64 x0 + | Ast_409.Outcometree.Oval_nativeint x0 -> + Ast_408.Outcometree.Oval_nativeint x0 + | Ast_409.Outcometree.Oval_list x0 -> + Ast_408.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_printer x0 -> + Ast_408.Outcometree.Oval_printer x0 + | Ast_409.Outcometree.Oval_record x0 -> + Ast_408.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_409.Outcometree.Oval_string (x0, x1, x2) -> + Ast_408.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_409.Outcometree.Oval_stuff x0 -> Ast_408.Outcometree.Oval_stuff x0 + | Ast_409.Outcometree.Oval_tuple x0 -> + Ast_408.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_variant (x0, x1) -> + Ast_408.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_409.Outcometree.out_string -> Ast_408.Outcometree.out_string = + function + | Ast_409.Outcometree.Ostr_string -> Ast_408.Outcometree.Ostr_string + | Ast_409.Outcometree.Ostr_bytes -> Ast_408.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_409.Outcometree.out_ident -> Ast_408.Outcometree.out_ident = + function + | Ast_409.Outcometree.Oide_apply (x0, x1) -> + Ast_408.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_409.Outcometree.Oide_dot (x0, x1) -> + Ast_408.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_409.Outcometree.Oide_ident x0 -> + Ast_408.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_409.Outcometree.out_name -> Ast_408.Outcometree.out_name = + fun { Ast_409.Outcometree.printed_name = printed_name } -> + { Ast_408.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_409.Parsetree.toplevel_phrase -> Ast_408.Parsetree.toplevel_phrase = + function + | Ast_409.Parsetree.Ptop_def x0 -> + Ast_408.Parsetree.Ptop_def (copy_structure x0) + | Ast_409.Parsetree.Ptop_dir x0 -> + Ast_408.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_409.Parsetree.toplevel_directive -> + Ast_408.Parsetree.toplevel_directive + = + fun + { Ast_409.Parsetree.pdir_name = pdir_name; + Ast_409.Parsetree.pdir_arg = pdir_arg; + Ast_409.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_408.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_408.Parsetree.pdir_arg = + (Option.map copy_directive_argument pdir_arg); + Ast_408.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_409.Parsetree.directive_argument -> + Ast_408.Parsetree.directive_argument + = + fun + { Ast_409.Parsetree.pdira_desc = pdira_desc; + Ast_409.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_408.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_408.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_409.Parsetree.directive_argument_desc -> + Ast_408.Parsetree.directive_argument_desc + = + function + | Ast_409.Parsetree.Pdir_string x0 -> Ast_408.Parsetree.Pdir_string x0 + | Ast_409.Parsetree.Pdir_int (x0, x1) -> + Ast_408.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) + | Ast_409.Parsetree.Pdir_ident x0 -> + Ast_408.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_409.Parsetree.Pdir_bool x0 -> Ast_408.Parsetree.Pdir_bool x0 +and copy_typ : Ast_409.Parsetree.typ -> Ast_408.Parsetree.typ = + fun x -> copy_core_type x +and copy_pat : Ast_409.Parsetree.pat -> Ast_408.Parsetree.pat = + fun x -> copy_pattern x +and copy_expr : Ast_409.Parsetree.expr -> Ast_408.Parsetree.expr = + fun x -> copy_expression x +and copy_expression : + Ast_409.Parsetree.expression -> Ast_408.Parsetree.expression = + fun + { Ast_409.Parsetree.pexp_desc = pexp_desc; + Ast_409.Parsetree.pexp_loc = pexp_loc; + Ast_409.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_409.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_408.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_408.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_408.Parsetree.pexp_loc_stack = + (List.map copy_location pexp_loc_stack); + Ast_408.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expression_desc : + Ast_409.Parsetree.expression_desc -> Ast_408.Parsetree.expression_desc = + function + | Ast_409.Parsetree.Pexp_ident x0 -> + Ast_408.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pexp_constant x0 -> + Ast_408.Parsetree.Pexp_constant (copy_constant x0) + | Ast_409.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_408.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_function x0 -> + Ast_408.Parsetree.Pexp_function (copy_cases x0) + | Ast_409.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_408.Parsetree.Pexp_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_409.Parsetree.Pexp_apply (x0, x1) -> + Ast_408.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_409.Parsetree.Pexp_match (x0, x1) -> + Ast_408.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) + | Ast_409.Parsetree.Pexp_try (x0, x1) -> + Ast_408.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) + | Ast_409.Parsetree.Pexp_tuple x0 -> + Ast_408.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_409.Parsetree.Pexp_construct (x0, x1) -> + Ast_408.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) + | Ast_409.Parsetree.Pexp_variant (x0, x1) -> + Ast_408.Parsetree.Pexp_variant + ((copy_label x0), (Option.map copy_expression x1)) + | Ast_409.Parsetree.Pexp_record (x0, x1) -> + Ast_408.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_409.Parsetree.Pexp_field (x0, x1) -> + Ast_408.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_409.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_408.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_array x0 -> + Ast_408.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_409.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_408.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (Option.map copy_expression x2)) + | Ast_409.Parsetree.Pexp_sequence (x0, x1) -> + Ast_408.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_while (x0, x1) -> + Ast_408.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_408.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_409.Parsetree.Pexp_constraint (x0, x1) -> + Ast_408.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_409.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_408.Parsetree.Pexp_coerce + ((copy_expression x0), (Option.map copy_core_type x1), + (copy_core_type x2)) + | Ast_409.Parsetree.Pexp_send (x0, x1) -> + Ast_408.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_409.Parsetree.Pexp_new x0 -> + Ast_408.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_408.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_override x0 -> + Ast_408.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_409.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_408.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> x) x0), (copy_module_expr x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_letexception (x0, x1) -> + Ast_408.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_assert x0 -> + Ast_408.Parsetree.Pexp_assert (copy_expression x0) + | Ast_409.Parsetree.Pexp_lazy x0 -> + Ast_408.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_409.Parsetree.Pexp_poly (x0, x1) -> + Ast_408.Parsetree.Pexp_poly + ((copy_expression x0), (Option.map copy_core_type x1)) + | Ast_409.Parsetree.Pexp_object x0 -> + Ast_408.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_409.Parsetree.Pexp_newtype (x0, x1) -> + Ast_408.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_pack x0 -> + Ast_408.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_409.Parsetree.Pexp_open (x0, x1) -> + Ast_408.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_letop x0 -> + Ast_408.Parsetree.Pexp_letop (copy_letop x0) + | Ast_409.Parsetree.Pexp_extension x0 -> + Ast_408.Parsetree.Pexp_extension (copy_extension x0) + | Ast_409.Parsetree.Pexp_unreachable -> Ast_408.Parsetree.Pexp_unreachable +and copy_letop : Ast_409.Parsetree.letop -> Ast_408.Parsetree.letop = + fun + { Ast_409.Parsetree.let_ = let_; Ast_409.Parsetree.ands = ands; + Ast_409.Parsetree.body = body } + -> + { + Ast_408.Parsetree.let_ = (copy_binding_op let_); + Ast_408.Parsetree.ands = (List.map copy_binding_op ands); + Ast_408.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_409.Parsetree.binding_op -> Ast_408.Parsetree.binding_op = + fun + { Ast_409.Parsetree.pbop_op = pbop_op; + Ast_409.Parsetree.pbop_pat = pbop_pat; + Ast_409.Parsetree.pbop_exp = pbop_exp; + Ast_409.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_408.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_408.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_408.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_408.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_409.Asttypes.direction_flag -> Ast_408.Asttypes.direction_flag = + function + | Ast_409.Asttypes.Upto -> Ast_408.Asttypes.Upto + | Ast_409.Asttypes.Downto -> Ast_408.Asttypes.Downto +and copy_cases : Ast_409.Parsetree.cases -> Ast_408.Parsetree.cases = + fun x -> List.map copy_case x +and copy_case : Ast_409.Parsetree.case -> Ast_408.Parsetree.case = + fun + { Ast_409.Parsetree.pc_lhs = pc_lhs; + Ast_409.Parsetree.pc_guard = pc_guard; + Ast_409.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_408.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_408.Parsetree.pc_guard = (Option.map copy_expression pc_guard); + Ast_408.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_value_binding : + Ast_409.Parsetree.value_binding -> Ast_408.Parsetree.value_binding = + fun + { Ast_409.Parsetree.pvb_pat = pvb_pat; + Ast_409.Parsetree.pvb_expr = pvb_expr; + Ast_409.Parsetree.pvb_attributes = pvb_attributes; + Ast_409.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_408.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_408.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_408.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_408.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_409.Parsetree.pattern -> Ast_408.Parsetree.pattern = + fun + { Ast_409.Parsetree.ppat_desc = ppat_desc; + Ast_409.Parsetree.ppat_loc = ppat_loc; + Ast_409.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_409.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_408.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_408.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_408.Parsetree.ppat_loc_stack = + (List.map copy_location ppat_loc_stack); + Ast_408.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pattern_desc : + Ast_409.Parsetree.pattern_desc -> Ast_408.Parsetree.pattern_desc = + function + | Ast_409.Parsetree.Ppat_any -> Ast_408.Parsetree.Ppat_any + | Ast_409.Parsetree.Ppat_var x0 -> + Ast_408.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_409.Parsetree.Ppat_alias (x0, x1) -> + Ast_408.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_409.Parsetree.Ppat_constant x0 -> + Ast_408.Parsetree.Ppat_constant (copy_constant x0) + | Ast_409.Parsetree.Ppat_interval (x0, x1) -> + Ast_408.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_409.Parsetree.Ppat_tuple x0 -> + Ast_408.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_409.Parsetree.Ppat_construct (x0, x1) -> + Ast_408.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) + | Ast_409.Parsetree.Ppat_variant (x0, x1) -> + Ast_408.Parsetree.Ppat_variant + ((copy_label x0), (Option.map copy_pattern x1)) + | Ast_409.Parsetree.Ppat_record (x0, x1) -> + Ast_408.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_409.Parsetree.Ppat_array x0 -> + Ast_408.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_409.Parsetree.Ppat_or (x0, x1) -> + Ast_408.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_409.Parsetree.Ppat_constraint (x0, x1) -> + Ast_408.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_409.Parsetree.Ppat_type x0 -> + Ast_408.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Ppat_lazy x0 -> + Ast_408.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_409.Parsetree.Ppat_unpack x0 -> + Ast_408.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) + | Ast_409.Parsetree.Ppat_exception x0 -> + Ast_408.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_409.Parsetree.Ppat_extension x0 -> + Ast_408.Parsetree.Ppat_extension (copy_extension x0) + | Ast_409.Parsetree.Ppat_open (x0, x1) -> + Ast_408.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_409.Parsetree.core_type -> Ast_408.Parsetree.core_type = + fun + { Ast_409.Parsetree.ptyp_desc = ptyp_desc; + Ast_409.Parsetree.ptyp_loc = ptyp_loc; + Ast_409.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_409.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_408.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_408.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_408.Parsetree.ptyp_loc_stack = + (List.map copy_location ptyp_loc_stack); + Ast_408.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_core_type_desc : + Ast_409.Parsetree.core_type_desc -> Ast_408.Parsetree.core_type_desc = + function + | Ast_409.Parsetree.Ptyp_any -> Ast_408.Parsetree.Ptyp_any + | Ast_409.Parsetree.Ptyp_var x0 -> Ast_408.Parsetree.Ptyp_var x0 + | Ast_409.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_408.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_409.Parsetree.Ptyp_tuple x0 -> + Ast_408.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_409.Parsetree.Ptyp_constr (x0, x1) -> + Ast_408.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_object (x0, x1) -> + Ast_408.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_409.Parsetree.Ptyp_class (x0, x1) -> + Ast_408.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_alias (x0, x1) -> + Ast_408.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_409.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_408.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (Option.map (fun x -> List.map copy_label x) x2)) + | Ast_409.Parsetree.Ptyp_poly (x0, x1) -> + Ast_408.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_package x0 -> + Ast_408.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_409.Parsetree.Ptyp_extension x0 -> + Ast_408.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_409.Parsetree.package_type -> Ast_408.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_409.Parsetree.row_field -> Ast_408.Parsetree.row_field = + fun + { Ast_409.Parsetree.prf_desc = prf_desc; + Ast_409.Parsetree.prf_loc = prf_loc; + Ast_409.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_408.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_408.Parsetree.prf_loc = (copy_location prf_loc); + Ast_408.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_409.Parsetree.row_field_desc -> Ast_408.Parsetree.row_field_desc = + function + | Ast_409.Parsetree.Rtag (x0, x1, x2) -> + Ast_408.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_409.Parsetree.Rinherit x0 -> + Ast_408.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_409.Parsetree.object_field -> Ast_408.Parsetree.object_field = + fun + { Ast_409.Parsetree.pof_desc = pof_desc; + Ast_409.Parsetree.pof_loc = pof_loc; + Ast_409.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_408.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_408.Parsetree.pof_loc = (copy_location pof_loc); + Ast_408.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_409.Parsetree.attributes -> Ast_408.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_409.Parsetree.attribute -> Ast_408.Parsetree.attribute = + fun + { Ast_409.Parsetree.attr_name = attr_name; + Ast_409.Parsetree.attr_payload = attr_payload; + Ast_409.Parsetree.attr_loc = attr_loc } + -> + { + Ast_408.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_408.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_408.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_409.Parsetree.payload -> Ast_408.Parsetree.payload = + function + | Ast_409.Parsetree.PStr x0 -> Ast_408.Parsetree.PStr (copy_structure x0) + | Ast_409.Parsetree.PSig x0 -> Ast_408.Parsetree.PSig (copy_signature x0) + | Ast_409.Parsetree.PTyp x0 -> Ast_408.Parsetree.PTyp (copy_core_type x0) + | Ast_409.Parsetree.PPat (x0, x1) -> + Ast_408.Parsetree.PPat + ((copy_pattern x0), (Option.map copy_expression x1)) +and copy_structure : + Ast_409.Parsetree.structure -> Ast_408.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_409.Parsetree.structure_item -> Ast_408.Parsetree.structure_item = + fun + { Ast_409.Parsetree.pstr_desc = pstr_desc; + Ast_409.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_408.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_408.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_409.Parsetree.structure_item_desc -> + Ast_408.Parsetree.structure_item_desc + = + function + | Ast_409.Parsetree.Pstr_eval (x0, x1) -> + Ast_408.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_409.Parsetree.Pstr_value (x0, x1) -> + Ast_408.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_409.Parsetree.Pstr_primitive x0 -> + Ast_408.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_409.Parsetree.Pstr_type (x0, x1) -> + Ast_408.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_409.Parsetree.Pstr_typext x0 -> + Ast_408.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_409.Parsetree.Pstr_exception x0 -> + Ast_408.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_409.Parsetree.Pstr_module x0 -> + Ast_408.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_409.Parsetree.Pstr_recmodule x0 -> + Ast_408.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_409.Parsetree.Pstr_modtype x0 -> + Ast_408.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_409.Parsetree.Pstr_open x0 -> + Ast_408.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_409.Parsetree.Pstr_class x0 -> + Ast_408.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_409.Parsetree.Pstr_class_type x0 -> + Ast_408.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_409.Parsetree.Pstr_include x0 -> + Ast_408.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_409.Parsetree.Pstr_attribute x0 -> + Ast_408.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pstr_extension (x0, x1) -> + Ast_408.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_409.Parsetree.include_declaration -> + Ast_408.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_409.Parsetree.class_declaration -> Ast_408.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_409.Parsetree.class_expr -> Ast_408.Parsetree.class_expr = + fun + { Ast_409.Parsetree.pcl_desc = pcl_desc; + Ast_409.Parsetree.pcl_loc = pcl_loc; + Ast_409.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_408.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_408.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_408.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_409.Parsetree.class_expr_desc -> Ast_408.Parsetree.class_expr_desc = + function + | Ast_409.Parsetree.Pcl_constr (x0, x1) -> + Ast_408.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Pcl_structure x0 -> + Ast_408.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_409.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_408.Parsetree.Pcl_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_409.Parsetree.Pcl_apply (x0, x1) -> + Ast_408.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_409.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_408.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_409.Parsetree.Pcl_constraint (x0, x1) -> + Ast_408.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_409.Parsetree.Pcl_extension x0 -> + Ast_408.Parsetree.Pcl_extension (copy_extension x0) + | Ast_409.Parsetree.Pcl_open (x0, x1) -> + Ast_408.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_409.Parsetree.class_structure -> Ast_408.Parsetree.class_structure = + fun + { Ast_409.Parsetree.pcstr_self = pcstr_self; + Ast_409.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_408.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_408.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_409.Parsetree.class_field -> Ast_408.Parsetree.class_field = + fun + { Ast_409.Parsetree.pcf_desc = pcf_desc; + Ast_409.Parsetree.pcf_loc = pcf_loc; + Ast_409.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_408.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_408.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_408.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_409.Parsetree.class_field_desc -> Ast_408.Parsetree.class_field_desc = + function + | Ast_409.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_408.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_409.Parsetree.Pcf_val x0 -> + Ast_408.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_409.Parsetree.Pcf_method x0 -> + Ast_408.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_409.Parsetree.Pcf_constraint x0 -> + Ast_408.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_409.Parsetree.Pcf_initializer x0 -> + Ast_408.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_409.Parsetree.Pcf_attribute x0 -> + Ast_408.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pcf_extension x0 -> + Ast_408.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_409.Parsetree.class_field_kind -> Ast_408.Parsetree.class_field_kind = + function + | Ast_409.Parsetree.Cfk_virtual x0 -> + Ast_408.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_409.Parsetree.Cfk_concrete (x0, x1) -> + Ast_408.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_409.Parsetree.open_declaration -> Ast_408.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_409.Parsetree.module_binding -> Ast_408.Parsetree.module_binding = + fun + { Ast_409.Parsetree.pmb_name = pmb_name; + Ast_409.Parsetree.pmb_expr = pmb_expr; + Ast_409.Parsetree.pmb_attributes = pmb_attributes; + Ast_409.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_408.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); + Ast_408.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_408.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_408.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_409.Parsetree.module_expr -> Ast_408.Parsetree.module_expr = + fun + { Ast_409.Parsetree.pmod_desc = pmod_desc; + Ast_409.Parsetree.pmod_loc = pmod_loc; + Ast_409.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_408.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_408.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_408.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_409.Parsetree.module_expr_desc -> Ast_408.Parsetree.module_expr_desc = + function + | Ast_409.Parsetree.Pmod_ident x0 -> + Ast_408.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pmod_structure x0 -> + Ast_408.Parsetree.Pmod_structure (copy_structure x0) + | Ast_409.Parsetree.Pmod_functor (x0, x1, x2) -> + Ast_408.Parsetree.Pmod_functor + ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), + (copy_module_expr x2)) + | Ast_409.Parsetree.Pmod_apply (x0, x1) -> + Ast_408.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_409.Parsetree.Pmod_constraint (x0, x1) -> + Ast_408.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_409.Parsetree.Pmod_unpack x0 -> + Ast_408.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_409.Parsetree.Pmod_extension x0 -> + Ast_408.Parsetree.Pmod_extension (copy_extension x0) +and copy_module_type : + Ast_409.Parsetree.module_type -> Ast_408.Parsetree.module_type = + fun + { Ast_409.Parsetree.pmty_desc = pmty_desc; + Ast_409.Parsetree.pmty_loc = pmty_loc; + Ast_409.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_408.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_408.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_408.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_409.Parsetree.module_type_desc -> Ast_408.Parsetree.module_type_desc = + function + | Ast_409.Parsetree.Pmty_ident x0 -> + Ast_408.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pmty_signature x0 -> + Ast_408.Parsetree.Pmty_signature (copy_signature x0) + | Ast_409.Parsetree.Pmty_functor (x0, x1, x2) -> + Ast_408.Parsetree.Pmty_functor + ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), + (copy_module_type x2)) + | Ast_409.Parsetree.Pmty_with (x0, x1) -> + Ast_408.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_409.Parsetree.Pmty_typeof x0 -> + Ast_408.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_409.Parsetree.Pmty_extension x0 -> + Ast_408.Parsetree.Pmty_extension (copy_extension x0) + | Ast_409.Parsetree.Pmty_alias x0 -> + Ast_408.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_409.Parsetree.with_constraint -> Ast_408.Parsetree.with_constraint = + function + | Ast_409.Parsetree.Pwith_type (x0, x1) -> + Ast_408.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_409.Parsetree.Pwith_module (x0, x1) -> + Ast_408.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_409.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_408.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_409.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_408.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_409.Parsetree.signature -> Ast_408.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_409.Parsetree.signature_item -> Ast_408.Parsetree.signature_item = + fun + { Ast_409.Parsetree.psig_desc = psig_desc; + Ast_409.Parsetree.psig_loc = psig_loc } + -> + { + Ast_408.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_408.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_409.Parsetree.signature_item_desc -> + Ast_408.Parsetree.signature_item_desc + = + function + | Ast_409.Parsetree.Psig_value x0 -> + Ast_408.Parsetree.Psig_value (copy_value_description x0) + | Ast_409.Parsetree.Psig_type (x0, x1) -> + Ast_408.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_409.Parsetree.Psig_typesubst x0 -> + Ast_408.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_409.Parsetree.Psig_typext x0 -> + Ast_408.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_409.Parsetree.Psig_exception x0 -> + Ast_408.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_409.Parsetree.Psig_module x0 -> + Ast_408.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_409.Parsetree.Psig_modsubst x0 -> + Ast_408.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_409.Parsetree.Psig_recmodule x0 -> + Ast_408.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_409.Parsetree.Psig_modtype x0 -> + Ast_408.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_409.Parsetree.Psig_open x0 -> + Ast_408.Parsetree.Psig_open (copy_open_description x0) + | Ast_409.Parsetree.Psig_include x0 -> + Ast_408.Parsetree.Psig_include (copy_include_description x0) + | Ast_409.Parsetree.Psig_class x0 -> + Ast_408.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_409.Parsetree.Psig_class_type x0 -> + Ast_408.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_409.Parsetree.Psig_attribute x0 -> + Ast_408.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_409.Parsetree.Psig_extension (x0, x1) -> + Ast_408.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_409.Parsetree.class_type_declaration -> + Ast_408.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_409.Parsetree.class_description -> Ast_408.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_409.Parsetree.class_type -> Ast_408.Parsetree.class_type = + fun + { Ast_409.Parsetree.pcty_desc = pcty_desc; + Ast_409.Parsetree.pcty_loc = pcty_loc; + Ast_409.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_408.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_408.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_408.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_409.Parsetree.class_type_desc -> Ast_408.Parsetree.class_type_desc = + function + | Ast_409.Parsetree.Pcty_constr (x0, x1) -> + Ast_408.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Pcty_signature x0 -> + Ast_408.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_409.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_408.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_409.Parsetree.Pcty_extension x0 -> + Ast_408.Parsetree.Pcty_extension (copy_extension x0) + | Ast_409.Parsetree.Pcty_open (x0, x1) -> + Ast_408.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_409.Parsetree.class_signature -> Ast_408.Parsetree.class_signature = + fun + { Ast_409.Parsetree.pcsig_self = pcsig_self; + Ast_409.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_408.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_408.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_409.Parsetree.class_type_field -> Ast_408.Parsetree.class_type_field = + fun + { Ast_409.Parsetree.pctf_desc = pctf_desc; + Ast_409.Parsetree.pctf_loc = pctf_loc; + Ast_409.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_408.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_408.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_408.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_409.Parsetree.class_type_field_desc -> + Ast_408.Parsetree.class_type_field_desc + = + function + | Ast_409.Parsetree.Pctf_inherit x0 -> + Ast_408.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_409.Parsetree.Pctf_val x0 -> + Ast_408.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_409.Parsetree.Pctf_method x0 -> + Ast_408.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_409.Parsetree.Pctf_constraint x0 -> + Ast_408.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_409.Parsetree.Pctf_attribute x0 -> + Ast_408.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pctf_extension x0 -> + Ast_408.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_409.Parsetree.extension -> Ast_408.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_409.Parsetree.class_infos -> 'g0 Ast_408.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.pci_virt = pci_virt; + Ast_409.Parsetree.pci_params = pci_params; + Ast_409.Parsetree.pci_name = pci_name; + Ast_409.Parsetree.pci_expr = pci_expr; + Ast_409.Parsetree.pci_loc = pci_loc; + Ast_409.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_408.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_408.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_408.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_408.Parsetree.pci_expr = (f0 pci_expr); + Ast_408.Parsetree.pci_loc = (copy_location pci_loc); + Ast_408.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_409.Asttypes.virtual_flag -> Ast_408.Asttypes.virtual_flag = + function + | Ast_409.Asttypes.Virtual -> Ast_408.Asttypes.Virtual + | Ast_409.Asttypes.Concrete -> Ast_408.Asttypes.Concrete +and copy_include_description : + Ast_409.Parsetree.include_description -> + Ast_408.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_409.Parsetree.include_infos -> + 'g0 Ast_408.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.pincl_mod = pincl_mod; + Ast_409.Parsetree.pincl_loc = pincl_loc; + Ast_409.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_408.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_408.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_408.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_409.Parsetree.open_description -> Ast_408.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_409.Parsetree.open_infos -> 'g0 Ast_408.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.popen_expr = popen_expr; + Ast_409.Parsetree.popen_override = popen_override; + Ast_409.Parsetree.popen_loc = popen_loc; + Ast_409.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_408.Parsetree.popen_expr = (f0 popen_expr); + Ast_408.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_408.Parsetree.popen_loc = (copy_location popen_loc); + Ast_408.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_409.Asttypes.override_flag -> Ast_408.Asttypes.override_flag = + function + | Ast_409.Asttypes.Override -> Ast_408.Asttypes.Override + | Ast_409.Asttypes.Fresh -> Ast_408.Asttypes.Fresh +and copy_module_type_declaration : + Ast_409.Parsetree.module_type_declaration -> + Ast_408.Parsetree.module_type_declaration + = + fun + { Ast_409.Parsetree.pmtd_name = pmtd_name; + Ast_409.Parsetree.pmtd_type = pmtd_type; + Ast_409.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_409.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_408.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_408.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); + Ast_408.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_408.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_409.Parsetree.module_substitution -> + Ast_408.Parsetree.module_substitution + = + fun + { Ast_409.Parsetree.pms_name = pms_name; + Ast_409.Parsetree.pms_manifest = pms_manifest; + Ast_409.Parsetree.pms_attributes = pms_attributes; + Ast_409.Parsetree.pms_loc = pms_loc } + -> + { + Ast_408.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_408.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_408.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_408.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_409.Parsetree.module_declaration -> + Ast_408.Parsetree.module_declaration + = + fun + { Ast_409.Parsetree.pmd_name = pmd_name; + Ast_409.Parsetree.pmd_type = pmd_type; + Ast_409.Parsetree.pmd_attributes = pmd_attributes; + Ast_409.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_408.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); + Ast_408.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_408.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_408.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_409.Parsetree.type_exception -> Ast_408.Parsetree.type_exception = + fun + { Ast_409.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_409.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_409.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_408.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_408.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_408.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_409.Parsetree.type_extension -> Ast_408.Parsetree.type_extension = + fun + { Ast_409.Parsetree.ptyext_path = ptyext_path; + Ast_409.Parsetree.ptyext_params = ptyext_params; + Ast_409.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_409.Parsetree.ptyext_private = ptyext_private; + Ast_409.Parsetree.ptyext_loc = ptyext_loc; + Ast_409.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_408.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_408.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_408.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_408.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_408.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_408.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_409.Parsetree.extension_constructor -> + Ast_408.Parsetree.extension_constructor + = + fun + { Ast_409.Parsetree.pext_name = pext_name; + Ast_409.Parsetree.pext_kind = pext_kind; + Ast_409.Parsetree.pext_loc = pext_loc; + Ast_409.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_408.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_408.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_408.Parsetree.pext_loc = (copy_location pext_loc); + Ast_408.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_409.Parsetree.extension_constructor_kind -> + Ast_408.Parsetree.extension_constructor_kind + = + function + | Ast_409.Parsetree.Pext_decl (x0, x1) -> + Ast_408.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) + | Ast_409.Parsetree.Pext_rebind x0 -> + Ast_408.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_409.Parsetree.type_declaration -> Ast_408.Parsetree.type_declaration = + fun + { Ast_409.Parsetree.ptype_name = ptype_name; + Ast_409.Parsetree.ptype_params = ptype_params; + Ast_409.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_409.Parsetree.ptype_kind = ptype_kind; + Ast_409.Parsetree.ptype_private = ptype_private; + Ast_409.Parsetree.ptype_manifest = ptype_manifest; + Ast_409.Parsetree.ptype_attributes = ptype_attributes; + Ast_409.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_408.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_408.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_408.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_408.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_408.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_408.Parsetree.ptype_manifest = + (Option.map copy_core_type ptype_manifest); + Ast_408.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_408.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_409.Asttypes.private_flag -> Ast_408.Asttypes.private_flag = + function + | Ast_409.Asttypes.Private -> Ast_408.Asttypes.Private + | Ast_409.Asttypes.Public -> Ast_408.Asttypes.Public +and copy_type_kind : + Ast_409.Parsetree.type_kind -> Ast_408.Parsetree.type_kind = + function + | Ast_409.Parsetree.Ptype_abstract -> Ast_408.Parsetree.Ptype_abstract + | Ast_409.Parsetree.Ptype_variant x0 -> + Ast_408.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_409.Parsetree.Ptype_record x0 -> + Ast_408.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_409.Parsetree.Ptype_open -> Ast_408.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_409.Parsetree.constructor_declaration -> + Ast_408.Parsetree.constructor_declaration + = + fun + { Ast_409.Parsetree.pcd_name = pcd_name; + Ast_409.Parsetree.pcd_args = pcd_args; + Ast_409.Parsetree.pcd_res = pcd_res; + Ast_409.Parsetree.pcd_loc = pcd_loc; + Ast_409.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_408.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_408.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_408.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); + Ast_408.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_408.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_409.Parsetree.constructor_arguments -> + Ast_408.Parsetree.constructor_arguments + = + function + | Ast_409.Parsetree.Pcstr_tuple x0 -> + Ast_408.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_409.Parsetree.Pcstr_record x0 -> + Ast_408.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_409.Parsetree.label_declaration -> Ast_408.Parsetree.label_declaration + = + fun + { Ast_409.Parsetree.pld_name = pld_name; + Ast_409.Parsetree.pld_mutable = pld_mutable; + Ast_409.Parsetree.pld_type = pld_type; + Ast_409.Parsetree.pld_loc = pld_loc; + Ast_409.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_408.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_408.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_408.Parsetree.pld_type = (copy_core_type pld_type); + Ast_408.Parsetree.pld_loc = (copy_location pld_loc); + Ast_408.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_409.Asttypes.mutable_flag -> Ast_408.Asttypes.mutable_flag = + function + | Ast_409.Asttypes.Immutable -> Ast_408.Asttypes.Immutable + | Ast_409.Asttypes.Mutable -> Ast_408.Asttypes.Mutable +and copy_variance : Ast_409.Asttypes.variance -> Ast_408.Asttypes.variance = + function + | Ast_409.Asttypes.Covariant -> Ast_408.Asttypes.Covariant + | Ast_409.Asttypes.Contravariant -> Ast_408.Asttypes.Contravariant + | Ast_409.Asttypes.Invariant -> Ast_408.Asttypes.Invariant +and copy_value_description : + Ast_409.Parsetree.value_description -> Ast_408.Parsetree.value_description + = + fun + { Ast_409.Parsetree.pval_name = pval_name; + Ast_409.Parsetree.pval_type = pval_type; + Ast_409.Parsetree.pval_prim = pval_prim; + Ast_409.Parsetree.pval_attributes = pval_attributes; + Ast_409.Parsetree.pval_loc = pval_loc } + -> + { + Ast_408.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_408.Parsetree.pval_type = (copy_core_type pval_type); + Ast_408.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_408.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_408.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_409.Parsetree.object_field_desc -> Ast_408.Parsetree.object_field_desc + = + function + | Ast_409.Parsetree.Otag (x0, x1) -> + Ast_408.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_409.Parsetree.Oinherit x0 -> + Ast_408.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_409.Asttypes.arg_label -> Ast_408.Asttypes.arg_label + = + function + | Ast_409.Asttypes.Nolabel -> Ast_408.Asttypes.Nolabel + | Ast_409.Asttypes.Labelled x0 -> Ast_408.Asttypes.Labelled x0 + | Ast_409.Asttypes.Optional x0 -> Ast_408.Asttypes.Optional x0 +and copy_closed_flag : + Ast_409.Asttypes.closed_flag -> Ast_408.Asttypes.closed_flag = + function + | Ast_409.Asttypes.Closed -> Ast_408.Asttypes.Closed + | Ast_409.Asttypes.Open -> Ast_408.Asttypes.Open +and copy_label : Ast_409.Asttypes.label -> Ast_408.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_409.Asttypes.rec_flag -> Ast_408.Asttypes.rec_flag = + function + | Ast_409.Asttypes.Nonrecursive -> Ast_408.Asttypes.Nonrecursive + | Ast_409.Asttypes.Recursive -> Ast_408.Asttypes.Recursive +and copy_constant : Ast_409.Parsetree.constant -> Ast_408.Parsetree.constant + = + function + | Ast_409.Parsetree.Pconst_integer (x0, x1) -> + Ast_408.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) + | Ast_409.Parsetree.Pconst_char x0 -> Ast_408.Parsetree.Pconst_char x0 + | Ast_409.Parsetree.Pconst_string (x0, x1) -> + Ast_408.Parsetree.Pconst_string (x0, (Option.map (fun x -> x) x1)) + | Ast_409.Parsetree.Pconst_float (x0, x1) -> + Ast_408.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) +and copy_Longident_t : Ast_409.Longident.t -> Ast_408.Longident.t = + function + | Ast_409.Longident.Lident x0 -> Ast_408.Longident.Lident x0 + | Ast_409.Longident.Ldot (x0, x1) -> + Ast_408.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_409.Longident.Lapply (x0, x1) -> + Ast_408.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_409.Asttypes.loc -> 'g0 Ast_408.Asttypes.loc + = + fun f0 -> + fun { Ast_409.Asttypes.txt = txt; Ast_409.Asttypes.loc = loc } -> + { + Ast_408.Asttypes.txt = (f0 txt); + Ast_408.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_409.Location.t -> Ast_408.Location.t = + fun + { Ast_409.Location.loc_start = loc_start; + Ast_409.Location.loc_end = loc_end; + Ast_409.Location.loc_ghost = loc_ghost } + -> + { + Ast_408.Location.loc_start = (copy_position loc_start); + Ast_408.Location.loc_end = (copy_position loc_end); + Ast_408.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410.ml new file mode 100644 index 000000000..81006e9c5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410.ml @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_409_410_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_410_409_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410_migrate.ml new file mode 100644 index 000000000..b4d507d91 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_409_410_migrate.ml @@ -0,0 +1,1514 @@ +module From = Ast_409 +module To = Ast_410 +let map_option f x = + match x with + | None -> None + | Some x -> Some (f x) +let rec copy_out_type_extension : + Ast_409.Outcometree.out_type_extension -> + Ast_410.Outcometree.out_type_extension + = + fun + { Ast_409.Outcometree.otyext_name = otyext_name; + Ast_409.Outcometree.otyext_params = otyext_params; + Ast_409.Outcometree.otyext_constructors = otyext_constructors; + Ast_409.Outcometree.otyext_private = otyext_private } + -> + { + Ast_410.Outcometree.otyext_name = otyext_name; + Ast_410.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_410.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (map_option copy_out_type x2))) otyext_constructors); + Ast_410.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_409.Outcometree.out_phrase -> Ast_410.Outcometree.out_phrase = + function + | Ast_409.Outcometree.Ophr_eval (x0, x1) -> + Ast_410.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_409.Outcometree.Ophr_signature x0 -> + Ast_410.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) + | Ast_409.Outcometree.Ophr_exception x0 -> + Ast_410.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_409.Outcometree.out_sig_item -> Ast_410.Outcometree.out_sig_item = + function + | Ast_409.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_410.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_409.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_410.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_409.Outcometree.Osig_typext (x0, x1) -> + Ast_410.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_409.Outcometree.Osig_modtype (x0, x1) -> + Ast_410.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_409.Outcometree.Osig_module (x0, x1, x2) -> + Ast_410.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_409.Outcometree.Osig_type (x0, x1) -> + Ast_410.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_409.Outcometree.Osig_value x0 -> + Ast_410.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_409.Outcometree.Osig_ellipsis -> Ast_410.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_409.Outcometree.out_val_decl -> Ast_410.Outcometree.out_val_decl = + fun + { Ast_409.Outcometree.oval_name = oval_name; + Ast_409.Outcometree.oval_type = oval_type; + Ast_409.Outcometree.oval_prims = oval_prims; + Ast_409.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_410.Outcometree.oval_name = oval_name; + Ast_410.Outcometree.oval_type = (copy_out_type oval_type); + Ast_410.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_410.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_409.Outcometree.out_type_decl -> Ast_410.Outcometree.out_type_decl = + fun + { Ast_409.Outcometree.otype_name = otype_name; + Ast_409.Outcometree.otype_params = otype_params; + Ast_409.Outcometree.otype_type = otype_type; + Ast_409.Outcometree.otype_private = otype_private; + Ast_409.Outcometree.otype_immediate = otype_immediate; + Ast_409.Outcometree.otype_unboxed = otype_unboxed; + Ast_409.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_410.Outcometree.otype_name = otype_name; + Ast_410.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_410.Outcometree.otype_type = (copy_out_type otype_type); + Ast_410.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_410.Outcometree.otype_immediate = (if otype_immediate then Always else Unknown); + Ast_410.Outcometree.otype_unboxed = otype_unboxed; + Ast_410.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_out_module_type : + Ast_409.Outcometree.out_module_type -> Ast_410.Outcometree.out_module_type + = + function + | Ast_409.Outcometree.Omty_abstract -> Ast_410.Outcometree.Omty_abstract + | Ast_409.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_410.Outcometree.Omty_functor + ((match x0, x1 with + | "*", None -> None + | "_", Some mt -> Some (None, copy_out_module_type mt) + | s, Some mt -> Some (Some s, copy_out_module_type mt) + |_ -> assert false), + copy_out_module_type x2) + | Ast_409.Outcometree.Omty_ident x0 -> + Ast_410.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_409.Outcometree.Omty_signature x0 -> + Ast_410.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_409.Outcometree.Omty_alias x0 -> + Ast_410.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_409.Outcometree.out_ext_status -> Ast_410.Outcometree.out_ext_status = + function + | Ast_409.Outcometree.Oext_first -> Ast_410.Outcometree.Oext_first + | Ast_409.Outcometree.Oext_next -> Ast_410.Outcometree.Oext_next + | Ast_409.Outcometree.Oext_exception -> Ast_410.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_409.Outcometree.out_extension_constructor -> + Ast_410.Outcometree.out_extension_constructor + = + fun + { Ast_409.Outcometree.oext_name = oext_name; + Ast_409.Outcometree.oext_type_name = oext_type_name; + Ast_409.Outcometree.oext_type_params = oext_type_params; + Ast_409.Outcometree.oext_args = oext_args; + Ast_409.Outcometree.oext_ret_type = oext_ret_type; + Ast_409.Outcometree.oext_private = oext_private } + -> + { + Ast_410.Outcometree.oext_name = oext_name; + Ast_410.Outcometree.oext_type_name = oext_type_name; + Ast_410.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_410.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_410.Outcometree.oext_ret_type = + (map_option copy_out_type oext_ret_type); + Ast_410.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_409.Outcometree.out_rec_status -> Ast_410.Outcometree.out_rec_status = + function + | Ast_409.Outcometree.Orec_not -> Ast_410.Outcometree.Orec_not + | Ast_409.Outcometree.Orec_first -> Ast_410.Outcometree.Orec_first + | Ast_409.Outcometree.Orec_next -> Ast_410.Outcometree.Orec_next +and copy_out_class_type : + Ast_409.Outcometree.out_class_type -> Ast_410.Outcometree.out_class_type = + function + | Ast_409.Outcometree.Octy_constr (x0, x1) -> + Ast_410.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_409.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_410.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_409.Outcometree.Octy_signature (x0, x1) -> + Ast_410.Outcometree.Octy_signature + ((map_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_409.Outcometree.out_class_sig_item -> + Ast_410.Outcometree.out_class_sig_item + = + function + | Ast_409.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_410.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_409.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_410.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_409.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_410.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_409.Outcometree.out_type -> Ast_410.Outcometree.out_type = + function + | Ast_409.Outcometree.Otyp_abstract -> Ast_410.Outcometree.Otyp_abstract + | Ast_409.Outcometree.Otyp_open -> Ast_410.Outcometree.Otyp_open + | Ast_409.Outcometree.Otyp_alias (x0, x1) -> + Ast_410.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_409.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_409.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_409.Outcometree.Otyp_constr (x0, x1) -> + Ast_410.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_409.Outcometree.Otyp_manifest (x0, x1) -> + Ast_410.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_409.Outcometree.Otyp_object (x0, x1) -> + Ast_410.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (map_option (fun x -> x) x1)) + | Ast_409.Outcometree.Otyp_record x0 -> + Ast_410.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_409.Outcometree.Otyp_stuff x0 -> Ast_410.Outcometree.Otyp_stuff x0 + | Ast_409.Outcometree.Otyp_sum x0 -> + Ast_410.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (map_option copy_out_type x2))) x0) + | Ast_409.Outcometree.Otyp_tuple x0 -> + Ast_410.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_409.Outcometree.Otyp_var (x0, x1) -> + Ast_410.Outcometree.Otyp_var (x0, x1) + | Ast_409.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_410.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (map_option (fun x -> List.map (fun x -> x) x) x3)) + | Ast_409.Outcometree.Otyp_poly (x0, x1) -> + Ast_410.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_409.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_409.Outcometree.Otyp_attribute (x0, x1) -> + Ast_410.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_409.Outcometree.out_attribute -> Ast_410.Outcometree.out_attribute = + fun { Ast_409.Outcometree.oattr_name = oattr_name } -> + { Ast_410.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_409.Outcometree.out_variant -> Ast_410.Outcometree.out_variant = + function + | Ast_409.Outcometree.Ovar_fields x0 -> + Ast_410.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_409.Outcometree.Ovar_typ x0 -> + Ast_410.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_409.Outcometree.out_value -> Ast_410.Outcometree.out_value = + function + | Ast_409.Outcometree.Oval_array x0 -> + Ast_410.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_char x0 -> Ast_410.Outcometree.Oval_char x0 + | Ast_409.Outcometree.Oval_constr (x0, x1) -> + Ast_410.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_409.Outcometree.Oval_ellipsis -> Ast_410.Outcometree.Oval_ellipsis + | Ast_409.Outcometree.Oval_float x0 -> Ast_410.Outcometree.Oval_float x0 + | Ast_409.Outcometree.Oval_int x0 -> Ast_410.Outcometree.Oval_int x0 + | Ast_409.Outcometree.Oval_int32 x0 -> Ast_410.Outcometree.Oval_int32 x0 + | Ast_409.Outcometree.Oval_int64 x0 -> Ast_410.Outcometree.Oval_int64 x0 + | Ast_409.Outcometree.Oval_nativeint x0 -> + Ast_410.Outcometree.Oval_nativeint x0 + | Ast_409.Outcometree.Oval_list x0 -> + Ast_410.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_printer x0 -> + Ast_410.Outcometree.Oval_printer x0 + | Ast_409.Outcometree.Oval_record x0 -> + Ast_410.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_409.Outcometree.Oval_string (x0, x1, x2) -> + Ast_410.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_409.Outcometree.Oval_stuff x0 -> Ast_410.Outcometree.Oval_stuff x0 + | Ast_409.Outcometree.Oval_tuple x0 -> + Ast_410.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_409.Outcometree.Oval_variant (x0, x1) -> + Ast_410.Outcometree.Oval_variant (x0, (map_option copy_out_value x1)) +and copy_out_string : + Ast_409.Outcometree.out_string -> Ast_410.Outcometree.out_string = + function + | Ast_409.Outcometree.Ostr_string -> Ast_410.Outcometree.Ostr_string + | Ast_409.Outcometree.Ostr_bytes -> Ast_410.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_409.Outcometree.out_ident -> Ast_410.Outcometree.out_ident = + function + | Ast_409.Outcometree.Oide_apply (x0, x1) -> + Ast_410.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_409.Outcometree.Oide_dot (x0, x1) -> + Ast_410.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_409.Outcometree.Oide_ident x0 -> + Ast_410.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_409.Outcometree.out_name -> Ast_410.Outcometree.out_name = + fun { Ast_409.Outcometree.printed_name = printed_name } -> + { Ast_410.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_409.Parsetree.toplevel_phrase -> Ast_410.Parsetree.toplevel_phrase = + function + | Ast_409.Parsetree.Ptop_def x0 -> + Ast_410.Parsetree.Ptop_def (copy_structure x0) + | Ast_409.Parsetree.Ptop_dir x0 -> + Ast_410.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_409.Parsetree.toplevel_directive -> + Ast_410.Parsetree.toplevel_directive + = + fun + { Ast_409.Parsetree.pdir_name = pdir_name; + Ast_409.Parsetree.pdir_arg = pdir_arg; + Ast_409.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_410.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_410.Parsetree.pdir_arg = + (map_option copy_directive_argument pdir_arg); + Ast_410.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_409.Parsetree.directive_argument -> + Ast_410.Parsetree.directive_argument + = + fun + { Ast_409.Parsetree.pdira_desc = pdira_desc; + Ast_409.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_410.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_410.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_409.Parsetree.directive_argument_desc -> + Ast_410.Parsetree.directive_argument_desc + = + function + | Ast_409.Parsetree.Pdir_string x0 -> Ast_410.Parsetree.Pdir_string x0 + | Ast_409.Parsetree.Pdir_int (x0, x1) -> + Ast_410.Parsetree.Pdir_int (x0, (map_option (fun x -> x) x1)) + | Ast_409.Parsetree.Pdir_ident x0 -> + Ast_410.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_409.Parsetree.Pdir_bool x0 -> Ast_410.Parsetree.Pdir_bool x0 +and copy_expression : + Ast_409.Parsetree.expression -> Ast_410.Parsetree.expression = + fun + { Ast_409.Parsetree.pexp_desc = pexp_desc; + Ast_409.Parsetree.pexp_loc = pexp_loc; + Ast_409.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_409.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_410.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_410.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_410.Parsetree.pexp_loc_stack = + (List.map copy_location pexp_loc_stack); + Ast_410.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expression_desc : + Ast_409.Parsetree.expression_desc -> Ast_410.Parsetree.expression_desc = + function + | Ast_409.Parsetree.Pexp_ident x0 -> + Ast_410.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pexp_constant x0 -> + Ast_410.Parsetree.Pexp_constant (copy_constant x0) + | Ast_409.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_function x0 -> + Ast_410.Parsetree.Pexp_function (copy_cases x0) + | Ast_409.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_410.Parsetree.Pexp_fun + ((copy_arg_label x0), (map_option copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_409.Parsetree.Pexp_apply (x0, x1) -> + Ast_410.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_409.Parsetree.Pexp_match (x0, x1) -> + Ast_410.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) + | Ast_409.Parsetree.Pexp_try (x0, x1) -> + Ast_410.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) + | Ast_409.Parsetree.Pexp_tuple x0 -> + Ast_410.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_409.Parsetree.Pexp_construct (x0, x1) -> + Ast_410.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (map_option copy_expression x1)) + | Ast_409.Parsetree.Pexp_variant (x0, x1) -> + Ast_410.Parsetree.Pexp_variant + ((copy_label x0), (map_option copy_expression x1)) + | Ast_409.Parsetree.Pexp_record (x0, x1) -> + Ast_410.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), + (map_option copy_expression x1)) + | Ast_409.Parsetree.Pexp_field (x0, x1) -> + Ast_410.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_409.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_array x0 -> + Ast_410.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_409.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (map_option copy_expression x2)) + | Ast_409.Parsetree.Pexp_sequence (x0, x1) -> + Ast_410.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_while (x0, x1) -> + Ast_410.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_410.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_409.Parsetree.Pexp_constraint (x0, x1) -> + Ast_410.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_409.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_coerce + ((copy_expression x0), (map_option copy_core_type x1), + (copy_core_type x2)) + | Ast_409.Parsetree.Pexp_send (x0, x1) -> + Ast_410.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_409.Parsetree.Pexp_new x0 -> + Ast_410.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_410.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_override x0 -> + Ast_410.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_409.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> Some x) x0), (copy_module_expr x1), + (copy_expression x2)) + | Ast_409.Parsetree.Pexp_letexception (x0, x1) -> + Ast_410.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_assert x0 -> + Ast_410.Parsetree.Pexp_assert (copy_expression x0) + | Ast_409.Parsetree.Pexp_lazy x0 -> + Ast_410.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_409.Parsetree.Pexp_poly (x0, x1) -> + Ast_410.Parsetree.Pexp_poly + ((copy_expression x0), (map_option copy_core_type x1)) + | Ast_409.Parsetree.Pexp_object x0 -> + Ast_410.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_409.Parsetree.Pexp_newtype (x0, x1) -> + Ast_410.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_pack x0 -> + Ast_410.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_409.Parsetree.Pexp_open (x0, x1) -> + Ast_410.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_409.Parsetree.Pexp_letop x0 -> + Ast_410.Parsetree.Pexp_letop (copy_letop x0) + | Ast_409.Parsetree.Pexp_extension x0 -> + Ast_410.Parsetree.Pexp_extension (copy_extension x0) + | Ast_409.Parsetree.Pexp_unreachable -> Ast_410.Parsetree.Pexp_unreachable +and copy_letop : Ast_409.Parsetree.letop -> Ast_410.Parsetree.letop = + fun + { Ast_409.Parsetree.let_ = let_; Ast_409.Parsetree.ands = ands; + Ast_409.Parsetree.body = body } + -> + { + Ast_410.Parsetree.let_ = (copy_binding_op let_); + Ast_410.Parsetree.ands = (List.map copy_binding_op ands); + Ast_410.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_409.Parsetree.binding_op -> Ast_410.Parsetree.binding_op = + fun + { Ast_409.Parsetree.pbop_op = pbop_op; + Ast_409.Parsetree.pbop_pat = pbop_pat; + Ast_409.Parsetree.pbop_exp = pbop_exp; + Ast_409.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_410.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_410.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_410.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_410.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_409.Asttypes.direction_flag -> Ast_410.Asttypes.direction_flag = + function + | Ast_409.Asttypes.Upto -> Ast_410.Asttypes.Upto + | Ast_409.Asttypes.Downto -> Ast_410.Asttypes.Downto +and copy_cases : Ast_409.Parsetree.cases -> Ast_410.Parsetree.case list = + fun x -> List.map copy_case x +and copy_case : Ast_409.Parsetree.case -> Ast_410.Parsetree.case = + fun + { Ast_409.Parsetree.pc_lhs = pc_lhs; + Ast_409.Parsetree.pc_guard = pc_guard; + Ast_409.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_410.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_410.Parsetree.pc_guard = (map_option copy_expression pc_guard); + Ast_410.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_value_binding : + Ast_409.Parsetree.value_binding -> Ast_410.Parsetree.value_binding = + fun + { Ast_409.Parsetree.pvb_pat = pvb_pat; + Ast_409.Parsetree.pvb_expr = pvb_expr; + Ast_409.Parsetree.pvb_attributes = pvb_attributes; + Ast_409.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_410.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_410.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_410.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_410.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_409.Parsetree.pattern -> Ast_410.Parsetree.pattern = + fun + { Ast_409.Parsetree.ppat_desc = ppat_desc; + Ast_409.Parsetree.ppat_loc = ppat_loc; + Ast_409.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_409.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_410.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_410.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_410.Parsetree.ppat_loc_stack = + (List.map copy_location ppat_loc_stack); + Ast_410.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pattern_desc : + Ast_409.Parsetree.pattern_desc -> Ast_410.Parsetree.pattern_desc = + function + | Ast_409.Parsetree.Ppat_any -> Ast_410.Parsetree.Ppat_any + | Ast_409.Parsetree.Ppat_var x0 -> + Ast_410.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_409.Parsetree.Ppat_alias (x0, x1) -> + Ast_410.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_409.Parsetree.Ppat_constant x0 -> + Ast_410.Parsetree.Ppat_constant (copy_constant x0) + | Ast_409.Parsetree.Ppat_interval (x0, x1) -> + Ast_410.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_409.Parsetree.Ppat_tuple x0 -> + Ast_410.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_409.Parsetree.Ppat_construct (x0, x1) -> + Ast_410.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (map_option copy_pattern x1)) + | Ast_409.Parsetree.Ppat_variant (x0, x1) -> + Ast_410.Parsetree.Ppat_variant + ((copy_label x0), (map_option copy_pattern x1)) + | Ast_409.Parsetree.Ppat_record (x0, x1) -> + Ast_410.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_409.Parsetree.Ppat_array x0 -> + Ast_410.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_409.Parsetree.Ppat_or (x0, x1) -> + Ast_410.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_409.Parsetree.Ppat_constraint (x0, x1) -> + Ast_410.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_409.Parsetree.Ppat_type x0 -> + Ast_410.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Ppat_lazy x0 -> + Ast_410.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_409.Parsetree.Ppat_unpack x0 -> + Ast_410.Parsetree.Ppat_unpack (copy_loc (fun x -> Some x) x0) + | Ast_409.Parsetree.Ppat_exception x0 -> + Ast_410.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_409.Parsetree.Ppat_extension x0 -> + Ast_410.Parsetree.Ppat_extension (copy_extension x0) + | Ast_409.Parsetree.Ppat_open (x0, x1) -> + Ast_410.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_409.Parsetree.core_type -> Ast_410.Parsetree.core_type = + fun + { Ast_409.Parsetree.ptyp_desc = ptyp_desc; + Ast_409.Parsetree.ptyp_loc = ptyp_loc; + Ast_409.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_409.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_410.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_410.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_410.Parsetree.ptyp_loc_stack = + (List.map copy_location ptyp_loc_stack); + Ast_410.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_core_type_desc : + Ast_409.Parsetree.core_type_desc -> Ast_410.Parsetree.core_type_desc = + function + | Ast_409.Parsetree.Ptyp_any -> Ast_410.Parsetree.Ptyp_any + | Ast_409.Parsetree.Ptyp_var x0 -> Ast_410.Parsetree.Ptyp_var x0 + | Ast_409.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_410.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_409.Parsetree.Ptyp_tuple x0 -> + Ast_410.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_409.Parsetree.Ptyp_constr (x0, x1) -> + Ast_410.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_object (x0, x1) -> + Ast_410.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_409.Parsetree.Ptyp_class (x0, x1) -> + Ast_410.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_alias (x0, x1) -> + Ast_410.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_409.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_410.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (map_option (fun x -> List.map copy_label x) x2)) + | Ast_409.Parsetree.Ptyp_poly (x0, x1) -> + Ast_410.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_409.Parsetree.Ptyp_package x0 -> + Ast_410.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_409.Parsetree.Ptyp_extension x0 -> + Ast_410.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_409.Parsetree.package_type -> Ast_410.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_409.Parsetree.row_field -> Ast_410.Parsetree.row_field = + fun + { Ast_409.Parsetree.prf_desc = prf_desc; + Ast_409.Parsetree.prf_loc = prf_loc; + Ast_409.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_410.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_410.Parsetree.prf_loc = (copy_location prf_loc); + Ast_410.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_409.Parsetree.row_field_desc -> Ast_410.Parsetree.row_field_desc = + function + | Ast_409.Parsetree.Rtag (x0, x1, x2) -> + Ast_410.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_409.Parsetree.Rinherit x0 -> + Ast_410.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_409.Parsetree.object_field -> Ast_410.Parsetree.object_field = + fun + { Ast_409.Parsetree.pof_desc = pof_desc; + Ast_409.Parsetree.pof_loc = pof_loc; + Ast_409.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_410.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_410.Parsetree.pof_loc = (copy_location pof_loc); + Ast_410.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_409.Parsetree.attributes -> Ast_410.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_409.Parsetree.attribute -> Ast_410.Parsetree.attribute = + fun + { Ast_409.Parsetree.attr_name = attr_name; + Ast_409.Parsetree.attr_payload = attr_payload; + Ast_409.Parsetree.attr_loc = attr_loc } + -> + { + Ast_410.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_410.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_410.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_409.Parsetree.payload -> Ast_410.Parsetree.payload = + function + | Ast_409.Parsetree.PStr x0 -> Ast_410.Parsetree.PStr (copy_structure x0) + | Ast_409.Parsetree.PSig x0 -> Ast_410.Parsetree.PSig (copy_signature x0) + | Ast_409.Parsetree.PTyp x0 -> Ast_410.Parsetree.PTyp (copy_core_type x0) + | Ast_409.Parsetree.PPat (x0, x1) -> + Ast_410.Parsetree.PPat + ((copy_pattern x0), (map_option copy_expression x1)) +and copy_structure : + Ast_409.Parsetree.structure -> Ast_410.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_409.Parsetree.structure_item -> Ast_410.Parsetree.structure_item = + fun + { Ast_409.Parsetree.pstr_desc = pstr_desc; + Ast_409.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_410.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_410.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_409.Parsetree.structure_item_desc -> + Ast_410.Parsetree.structure_item_desc + = + function + | Ast_409.Parsetree.Pstr_eval (x0, x1) -> + Ast_410.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_409.Parsetree.Pstr_value (x0, x1) -> + Ast_410.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_409.Parsetree.Pstr_primitive x0 -> + Ast_410.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_409.Parsetree.Pstr_type (x0, x1) -> + Ast_410.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_409.Parsetree.Pstr_typext x0 -> + Ast_410.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_409.Parsetree.Pstr_exception x0 -> + Ast_410.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_409.Parsetree.Pstr_module x0 -> + Ast_410.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_409.Parsetree.Pstr_recmodule x0 -> + Ast_410.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_409.Parsetree.Pstr_modtype x0 -> + Ast_410.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_409.Parsetree.Pstr_open x0 -> + Ast_410.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_409.Parsetree.Pstr_class x0 -> + Ast_410.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_409.Parsetree.Pstr_class_type x0 -> + Ast_410.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_409.Parsetree.Pstr_include x0 -> + Ast_410.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_409.Parsetree.Pstr_attribute x0 -> + Ast_410.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pstr_extension (x0, x1) -> + Ast_410.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_409.Parsetree.include_declaration -> + Ast_410.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_409.Parsetree.class_declaration -> Ast_410.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_409.Parsetree.class_expr -> Ast_410.Parsetree.class_expr = + fun + { Ast_409.Parsetree.pcl_desc = pcl_desc; + Ast_409.Parsetree.pcl_loc = pcl_loc; + Ast_409.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_410.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_410.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_410.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_409.Parsetree.class_expr_desc -> Ast_410.Parsetree.class_expr_desc = + function + | Ast_409.Parsetree.Pcl_constr (x0, x1) -> + Ast_410.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Pcl_structure x0 -> + Ast_410.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_409.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_410.Parsetree.Pcl_fun + ((copy_arg_label x0), (map_option copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_409.Parsetree.Pcl_apply (x0, x1) -> + Ast_410.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_409.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_410.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_409.Parsetree.Pcl_constraint (x0, x1) -> + Ast_410.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_409.Parsetree.Pcl_extension x0 -> + Ast_410.Parsetree.Pcl_extension (copy_extension x0) + | Ast_409.Parsetree.Pcl_open (x0, x1) -> + Ast_410.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_409.Parsetree.class_structure -> Ast_410.Parsetree.class_structure = + fun + { Ast_409.Parsetree.pcstr_self = pcstr_self; + Ast_409.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_410.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_410.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_409.Parsetree.class_field -> Ast_410.Parsetree.class_field = + fun + { Ast_409.Parsetree.pcf_desc = pcf_desc; + Ast_409.Parsetree.pcf_loc = pcf_loc; + Ast_409.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_410.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_410.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_410.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_409.Parsetree.class_field_desc -> Ast_410.Parsetree.class_field_desc = + function + | Ast_409.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_410.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (map_option (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_409.Parsetree.Pcf_val x0 -> + Ast_410.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_409.Parsetree.Pcf_method x0 -> + Ast_410.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_409.Parsetree.Pcf_constraint x0 -> + Ast_410.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_409.Parsetree.Pcf_initializer x0 -> + Ast_410.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_409.Parsetree.Pcf_attribute x0 -> + Ast_410.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pcf_extension x0 -> + Ast_410.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_409.Parsetree.class_field_kind -> Ast_410.Parsetree.class_field_kind = + function + | Ast_409.Parsetree.Cfk_virtual x0 -> + Ast_410.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_409.Parsetree.Cfk_concrete (x0, x1) -> + Ast_410.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_409.Parsetree.open_declaration -> Ast_410.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_409.Parsetree.module_binding -> Ast_410.Parsetree.module_binding = + fun + { Ast_409.Parsetree.pmb_name = pmb_name; + Ast_409.Parsetree.pmb_expr = pmb_expr; + Ast_409.Parsetree.pmb_attributes = pmb_attributes; + Ast_409.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_410.Parsetree.pmb_name = (copy_loc (fun x -> Some x) pmb_name); + Ast_410.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_410.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_410.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_409.Parsetree.module_expr -> Ast_410.Parsetree.module_expr = + fun + { Ast_409.Parsetree.pmod_desc = pmod_desc; + Ast_409.Parsetree.pmod_loc = pmod_loc; + Ast_409.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_410.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_410.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_410.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_409.Parsetree.module_expr_desc -> Ast_410.Parsetree.module_expr_desc = + function + | Ast_409.Parsetree.Pmod_ident x0 -> + Ast_410.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pmod_structure x0 -> + Ast_410.Parsetree.Pmod_structure (copy_structure x0) + | Ast_409.Parsetree.Pmod_functor (x0, x1, x2) -> + Ast_410.Parsetree.Pmod_functor + ((match x0.txt, x1 with + | "*", None -> Unit + | "_", Some mt -> Named (copy_loc (fun _ -> None) x0, copy_module_type mt) + | _, Some mt -> Named (copy_loc (fun x -> Some x) x0, copy_module_type mt) + |_ -> assert false), + (copy_module_expr x2)) + | Ast_409.Parsetree.Pmod_apply (x0, x1) -> + Ast_410.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_409.Parsetree.Pmod_constraint (x0, x1) -> + Ast_410.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_409.Parsetree.Pmod_unpack x0 -> + Ast_410.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_409.Parsetree.Pmod_extension x0 -> + Ast_410.Parsetree.Pmod_extension (copy_extension x0) +and copy_module_type : + Ast_409.Parsetree.module_type -> Ast_410.Parsetree.module_type = + fun + { Ast_409.Parsetree.pmty_desc = pmty_desc; + Ast_409.Parsetree.pmty_loc = pmty_loc; + Ast_409.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_410.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_410.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_410.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_409.Parsetree.module_type_desc -> Ast_410.Parsetree.module_type_desc = + function + | Ast_409.Parsetree.Pmty_ident x0 -> + Ast_410.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_409.Parsetree.Pmty_signature x0 -> + Ast_410.Parsetree.Pmty_signature (copy_signature x0) + | Ast_409.Parsetree.Pmty_functor (x0, x1, x2) -> + Ast_410.Parsetree.Pmty_functor + ((match x0.txt, x1 with + | "*", None -> Unit + | "_", Some mt -> Named (copy_loc (fun _ -> None) x0, copy_module_type mt) + | _, Some mt -> Named (copy_loc (fun x -> Some x) x0, copy_module_type mt) + |_ -> assert false), + (copy_module_type x2)) + | Ast_409.Parsetree.Pmty_with (x0, x1) -> + Ast_410.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_409.Parsetree.Pmty_typeof x0 -> + Ast_410.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_409.Parsetree.Pmty_extension x0 -> + Ast_410.Parsetree.Pmty_extension (copy_extension x0) + | Ast_409.Parsetree.Pmty_alias x0 -> + Ast_410.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_409.Parsetree.with_constraint -> Ast_410.Parsetree.with_constraint = + function + | Ast_409.Parsetree.Pwith_type (x0, x1) -> + Ast_410.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_409.Parsetree.Pwith_module (x0, x1) -> + Ast_410.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_409.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_410.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_409.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_410.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_409.Parsetree.signature -> Ast_410.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_409.Parsetree.signature_item -> Ast_410.Parsetree.signature_item = + fun + { Ast_409.Parsetree.psig_desc = psig_desc; + Ast_409.Parsetree.psig_loc = psig_loc } + -> + { + Ast_410.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_410.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_409.Parsetree.signature_item_desc -> + Ast_410.Parsetree.signature_item_desc + = + function + | Ast_409.Parsetree.Psig_value x0 -> + Ast_410.Parsetree.Psig_value (copy_value_description x0) + | Ast_409.Parsetree.Psig_type (x0, x1) -> + Ast_410.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_409.Parsetree.Psig_typesubst x0 -> + Ast_410.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_409.Parsetree.Psig_typext x0 -> + Ast_410.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_409.Parsetree.Psig_exception x0 -> + Ast_410.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_409.Parsetree.Psig_module x0 -> + Ast_410.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_409.Parsetree.Psig_modsubst x0 -> + Ast_410.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_409.Parsetree.Psig_recmodule x0 -> + Ast_410.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_409.Parsetree.Psig_modtype x0 -> + Ast_410.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_409.Parsetree.Psig_open x0 -> + Ast_410.Parsetree.Psig_open (copy_open_description x0) + | Ast_409.Parsetree.Psig_include x0 -> + Ast_410.Parsetree.Psig_include (copy_include_description x0) + | Ast_409.Parsetree.Psig_class x0 -> + Ast_410.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_409.Parsetree.Psig_class_type x0 -> + Ast_410.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_409.Parsetree.Psig_attribute x0 -> + Ast_410.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_409.Parsetree.Psig_extension (x0, x1) -> + Ast_410.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_409.Parsetree.class_type_declaration -> + Ast_410.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_409.Parsetree.class_description -> Ast_410.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_409.Parsetree.class_type -> Ast_410.Parsetree.class_type = + fun + { Ast_409.Parsetree.pcty_desc = pcty_desc; + Ast_409.Parsetree.pcty_loc = pcty_loc; + Ast_409.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_410.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_410.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_410.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_409.Parsetree.class_type_desc -> Ast_410.Parsetree.class_type_desc = + function + | Ast_409.Parsetree.Pcty_constr (x0, x1) -> + Ast_410.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_409.Parsetree.Pcty_signature x0 -> + Ast_410.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_409.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_410.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_409.Parsetree.Pcty_extension x0 -> + Ast_410.Parsetree.Pcty_extension (copy_extension x0) + | Ast_409.Parsetree.Pcty_open (x0, x1) -> + Ast_410.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_409.Parsetree.class_signature -> Ast_410.Parsetree.class_signature = + fun + { Ast_409.Parsetree.pcsig_self = pcsig_self; + Ast_409.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_410.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_410.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_409.Parsetree.class_type_field -> Ast_410.Parsetree.class_type_field = + fun + { Ast_409.Parsetree.pctf_desc = pctf_desc; + Ast_409.Parsetree.pctf_loc = pctf_loc; + Ast_409.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_410.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_410.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_410.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_409.Parsetree.class_type_field_desc -> + Ast_410.Parsetree.class_type_field_desc + = + function + | Ast_409.Parsetree.Pctf_inherit x0 -> + Ast_410.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_409.Parsetree.Pctf_val x0 -> + Ast_410.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_409.Parsetree.Pctf_method x0 -> + Ast_410.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_409.Parsetree.Pctf_constraint x0 -> + Ast_410.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_409.Parsetree.Pctf_attribute x0 -> + Ast_410.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_409.Parsetree.Pctf_extension x0 -> + Ast_410.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_409.Parsetree.extension -> Ast_410.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_409.Parsetree.class_infos -> 'g0 Ast_410.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.pci_virt = pci_virt; + Ast_409.Parsetree.pci_params = pci_params; + Ast_409.Parsetree.pci_name = pci_name; + Ast_409.Parsetree.pci_expr = pci_expr; + Ast_409.Parsetree.pci_loc = pci_loc; + Ast_409.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_410.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_410.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_410.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_410.Parsetree.pci_expr = (f0 pci_expr); + Ast_410.Parsetree.pci_loc = (copy_location pci_loc); + Ast_410.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_409.Asttypes.virtual_flag -> Ast_410.Asttypes.virtual_flag = + function + | Ast_409.Asttypes.Virtual -> Ast_410.Asttypes.Virtual + | Ast_409.Asttypes.Concrete -> Ast_410.Asttypes.Concrete +and copy_include_description : + Ast_409.Parsetree.include_description -> + Ast_410.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_409.Parsetree.include_infos -> + 'g0 Ast_410.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.pincl_mod = pincl_mod; + Ast_409.Parsetree.pincl_loc = pincl_loc; + Ast_409.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_410.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_410.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_410.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_409.Parsetree.open_description -> Ast_410.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_409.Parsetree.open_infos -> 'g0 Ast_410.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_409.Parsetree.popen_expr = popen_expr; + Ast_409.Parsetree.popen_override = popen_override; + Ast_409.Parsetree.popen_loc = popen_loc; + Ast_409.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_410.Parsetree.popen_expr = (f0 popen_expr); + Ast_410.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_410.Parsetree.popen_loc = (copy_location popen_loc); + Ast_410.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_409.Asttypes.override_flag -> Ast_410.Asttypes.override_flag = + function + | Ast_409.Asttypes.Override -> Ast_410.Asttypes.Override + | Ast_409.Asttypes.Fresh -> Ast_410.Asttypes.Fresh +and copy_module_type_declaration : + Ast_409.Parsetree.module_type_declaration -> + Ast_410.Parsetree.module_type_declaration + = + fun + { Ast_409.Parsetree.pmtd_name = pmtd_name; + Ast_409.Parsetree.pmtd_type = pmtd_type; + Ast_409.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_409.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_410.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_410.Parsetree.pmtd_type = (map_option copy_module_type pmtd_type); + Ast_410.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_410.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_409.Parsetree.module_substitution -> + Ast_410.Parsetree.module_substitution + = + fun + { Ast_409.Parsetree.pms_name = pms_name; + Ast_409.Parsetree.pms_manifest = pms_manifest; + Ast_409.Parsetree.pms_attributes = pms_attributes; + Ast_409.Parsetree.pms_loc = pms_loc } + -> + { + Ast_410.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_410.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_410.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_410.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_409.Parsetree.module_declaration -> + Ast_410.Parsetree.module_declaration + = + fun + { Ast_409.Parsetree.pmd_name = pmd_name; + Ast_409.Parsetree.pmd_type = pmd_type; + Ast_409.Parsetree.pmd_attributes = pmd_attributes; + Ast_409.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_410.Parsetree.pmd_name = (copy_loc (fun x -> Some x) pmd_name); + Ast_410.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_410.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_410.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_409.Parsetree.type_exception -> Ast_410.Parsetree.type_exception = + fun + { Ast_409.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_409.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_409.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_410.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_410.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_410.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_409.Parsetree.type_extension -> Ast_410.Parsetree.type_extension = + fun + { Ast_409.Parsetree.ptyext_path = ptyext_path; + Ast_409.Parsetree.ptyext_params = ptyext_params; + Ast_409.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_409.Parsetree.ptyext_private = ptyext_private; + Ast_409.Parsetree.ptyext_loc = ptyext_loc; + Ast_409.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_410.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_410.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_410.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_410.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_410.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_410.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_409.Parsetree.extension_constructor -> + Ast_410.Parsetree.extension_constructor + = + fun + { Ast_409.Parsetree.pext_name = pext_name; + Ast_409.Parsetree.pext_kind = pext_kind; + Ast_409.Parsetree.pext_loc = pext_loc; + Ast_409.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_410.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_410.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_410.Parsetree.pext_loc = (copy_location pext_loc); + Ast_410.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_409.Parsetree.extension_constructor_kind -> + Ast_410.Parsetree.extension_constructor_kind + = + function + | Ast_409.Parsetree.Pext_decl (x0, x1) -> + Ast_410.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (map_option copy_core_type x1)) + | Ast_409.Parsetree.Pext_rebind x0 -> + Ast_410.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_409.Parsetree.type_declaration -> Ast_410.Parsetree.type_declaration = + fun + { Ast_409.Parsetree.ptype_name = ptype_name; + Ast_409.Parsetree.ptype_params = ptype_params; + Ast_409.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_409.Parsetree.ptype_kind = ptype_kind; + Ast_409.Parsetree.ptype_private = ptype_private; + Ast_409.Parsetree.ptype_manifest = ptype_manifest; + Ast_409.Parsetree.ptype_attributes = ptype_attributes; + Ast_409.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_410.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_410.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_410.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_410.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_410.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_410.Parsetree.ptype_manifest = + (map_option copy_core_type ptype_manifest); + Ast_410.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_410.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_409.Asttypes.private_flag -> Ast_410.Asttypes.private_flag = + function + | Ast_409.Asttypes.Private -> Ast_410.Asttypes.Private + | Ast_409.Asttypes.Public -> Ast_410.Asttypes.Public +and copy_type_kind : + Ast_409.Parsetree.type_kind -> Ast_410.Parsetree.type_kind = + function + | Ast_409.Parsetree.Ptype_abstract -> Ast_410.Parsetree.Ptype_abstract + | Ast_409.Parsetree.Ptype_variant x0 -> + Ast_410.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_409.Parsetree.Ptype_record x0 -> + Ast_410.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_409.Parsetree.Ptype_open -> Ast_410.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_409.Parsetree.constructor_declaration -> + Ast_410.Parsetree.constructor_declaration + = + fun + { Ast_409.Parsetree.pcd_name = pcd_name; + Ast_409.Parsetree.pcd_args = pcd_args; + Ast_409.Parsetree.pcd_res = pcd_res; + Ast_409.Parsetree.pcd_loc = pcd_loc; + Ast_409.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_410.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_410.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_410.Parsetree.pcd_res = (map_option copy_core_type pcd_res); + Ast_410.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_410.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_409.Parsetree.constructor_arguments -> + Ast_410.Parsetree.constructor_arguments + = + function + | Ast_409.Parsetree.Pcstr_tuple x0 -> + Ast_410.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_409.Parsetree.Pcstr_record x0 -> + Ast_410.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_409.Parsetree.label_declaration -> Ast_410.Parsetree.label_declaration + = + fun + { Ast_409.Parsetree.pld_name = pld_name; + Ast_409.Parsetree.pld_mutable = pld_mutable; + Ast_409.Parsetree.pld_type = pld_type; + Ast_409.Parsetree.pld_loc = pld_loc; + Ast_409.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_410.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_410.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_410.Parsetree.pld_type = (copy_core_type pld_type); + Ast_410.Parsetree.pld_loc = (copy_location pld_loc); + Ast_410.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_409.Asttypes.mutable_flag -> Ast_410.Asttypes.mutable_flag = + function + | Ast_409.Asttypes.Immutable -> Ast_410.Asttypes.Immutable + | Ast_409.Asttypes.Mutable -> Ast_410.Asttypes.Mutable +and copy_variance : Ast_409.Asttypes.variance -> Ast_410.Asttypes.variance = + function + | Ast_409.Asttypes.Covariant -> Ast_410.Asttypes.Covariant + | Ast_409.Asttypes.Contravariant -> Ast_410.Asttypes.Contravariant + | Ast_409.Asttypes.Invariant -> Ast_410.Asttypes.Invariant +and copy_value_description : + Ast_409.Parsetree.value_description -> Ast_410.Parsetree.value_description + = + fun + { Ast_409.Parsetree.pval_name = pval_name; + Ast_409.Parsetree.pval_type = pval_type; + Ast_409.Parsetree.pval_prim = pval_prim; + Ast_409.Parsetree.pval_attributes = pval_attributes; + Ast_409.Parsetree.pval_loc = pval_loc } + -> + { + Ast_410.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_410.Parsetree.pval_type = (copy_core_type pval_type); + Ast_410.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_410.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_410.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_409.Parsetree.object_field_desc -> Ast_410.Parsetree.object_field_desc + = + function + | Ast_409.Parsetree.Otag (x0, x1) -> + Ast_410.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_409.Parsetree.Oinherit x0 -> + Ast_410.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_409.Asttypes.arg_label -> Ast_410.Asttypes.arg_label + = + function + | Ast_409.Asttypes.Nolabel -> Ast_410.Asttypes.Nolabel + | Ast_409.Asttypes.Labelled x0 -> Ast_410.Asttypes.Labelled x0 + | Ast_409.Asttypes.Optional x0 -> Ast_410.Asttypes.Optional x0 +and copy_closed_flag : + Ast_409.Asttypes.closed_flag -> Ast_410.Asttypes.closed_flag = + function + | Ast_409.Asttypes.Closed -> Ast_410.Asttypes.Closed + | Ast_409.Asttypes.Open -> Ast_410.Asttypes.Open +and copy_label : Ast_409.Asttypes.label -> Ast_410.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_409.Asttypes.rec_flag -> Ast_410.Asttypes.rec_flag = + function + | Ast_409.Asttypes.Nonrecursive -> Ast_410.Asttypes.Nonrecursive + | Ast_409.Asttypes.Recursive -> Ast_410.Asttypes.Recursive +and copy_constant : Ast_409.Parsetree.constant -> Ast_410.Parsetree.constant + = + function + | Ast_409.Parsetree.Pconst_integer (x0, x1) -> + Ast_410.Parsetree.Pconst_integer (x0, (map_option (fun x -> x) x1)) + | Ast_409.Parsetree.Pconst_char x0 -> Ast_410.Parsetree.Pconst_char x0 + | Ast_409.Parsetree.Pconst_string (x0, x1) -> + Ast_410.Parsetree.Pconst_string (x0, (map_option (fun x -> x) x1)) + | Ast_409.Parsetree.Pconst_float (x0, x1) -> + Ast_410.Parsetree.Pconst_float (x0, (map_option (fun x -> x) x1)) +and copy_Longident_t : Ast_409.Longident.t -> Ast_410.Longident.t = + function + | Ast_409.Longident.Lident x0 -> Ast_410.Longident.Lident x0 + | Ast_409.Longident.Ldot (x0, x1) -> + Ast_410.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_409.Longident.Lapply (x0, x1) -> + Ast_410.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_409.Asttypes.loc -> 'g0 Ast_410.Asttypes.loc + = + fun f0 -> + fun { Ast_409.Asttypes.txt = txt; Ast_409.Asttypes.loc = loc } -> + { + Ast_410.Asttypes.txt = (f0 txt); + Ast_410.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_409.Location.t -> Ast_410.Location.t = + fun + { Ast_409.Location.loc_start = loc_start; + Ast_409.Location.loc_end = loc_end; + Ast_409.Location.loc_ghost = loc_ghost } + -> + { + Ast_410.Location.loc_start = (copy_position loc_start); + Ast_410.Location.loc_end = (copy_position loc_end); + Ast_410.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } +let copy_expr = copy_expression +let copy_pat = copy_pattern +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409.ml new file mode 100644 index 000000000..ec7aae543 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409.ml @@ -0,0 +1,140 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_410_409_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_409_410_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409_migrate.ml new file mode 100644 index 000000000..b57a859d2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_409_migrate.ml @@ -0,0 +1,1543 @@ +module From = Ast_410 +module To = Ast_409 + +module Def = Migrate_parsetree_def + +let migration_error location feature = + raise (Def.Migration_error (feature, location)) + +let map_option f x = + match x with + | None -> None + | Some x -> Some (f x) + +let rec copy_out_type_extension : + Ast_410.Outcometree.out_type_extension -> + Ast_409.Outcometree.out_type_extension + = + fun + { Ast_410.Outcometree.otyext_name = otyext_name; + Ast_410.Outcometree.otyext_params = otyext_params; + Ast_410.Outcometree.otyext_constructors = otyext_constructors; + Ast_410.Outcometree.otyext_private = otyext_private } + -> + { + Ast_409.Outcometree.otyext_name = otyext_name; + Ast_409.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_409.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (map_option copy_out_type x2))) otyext_constructors); + Ast_409.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_410.Outcometree.out_phrase -> Ast_409.Outcometree.out_phrase = + function + | Ast_410.Outcometree.Ophr_eval (x0, x1) -> + Ast_409.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_410.Outcometree.Ophr_signature x0 -> + Ast_409.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) + | Ast_410.Outcometree.Ophr_exception x0 -> + Ast_409.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_410.Outcometree.out_sig_item -> Ast_409.Outcometree.out_sig_item = + function + | Ast_410.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_409.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_410.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_409.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_410.Outcometree.Osig_typext (x0, x1) -> + Ast_409.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_410.Outcometree.Osig_modtype (x0, x1) -> + Ast_409.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_410.Outcometree.Osig_module (x0, x1, x2) -> + Ast_409.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_410.Outcometree.Osig_type (x0, x1) -> + Ast_409.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_410.Outcometree.Osig_value x0 -> + Ast_409.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_410.Outcometree.Osig_ellipsis -> Ast_409.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_410.Outcometree.out_val_decl -> Ast_409.Outcometree.out_val_decl = + fun + { Ast_410.Outcometree.oval_name = oval_name; + Ast_410.Outcometree.oval_type = oval_type; + Ast_410.Outcometree.oval_prims = oval_prims; + Ast_410.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_409.Outcometree.oval_name = oval_name; + Ast_409.Outcometree.oval_type = (copy_out_type oval_type); + Ast_409.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_409.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_410.Outcometree.out_type_decl -> Ast_409.Outcometree.out_type_decl = + fun + { Ast_410.Outcometree.otype_name = otype_name; + Ast_410.Outcometree.otype_params = otype_params; + Ast_410.Outcometree.otype_type = otype_type; + Ast_410.Outcometree.otype_private = otype_private; + Ast_410.Outcometree.otype_immediate = otype_immediate; + Ast_410.Outcometree.otype_unboxed = otype_unboxed; + Ast_410.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_409.Outcometree.otype_name = otype_name; + Ast_409.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_409.Outcometree.otype_type = (copy_out_type otype_type); + Ast_409.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_409.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_409.Outcometree.otype_unboxed = otype_unboxed; + Ast_409.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_Type_immediacy_t : + Ast_410.Type_immediacy.t -> bool = + function + | Ast_410.Type_immediacy.Unknown -> false + | Ast_410.Type_immediacy.Always -> true + | Ast_410.Type_immediacy.Always_on_64bits -> migration_error Location.none Immediate64 +and copy_out_module_type : + Ast_410.Outcometree.out_module_type -> Ast_409.Outcometree.out_module_type + = + function + | Ast_410.Outcometree.Omty_abstract -> Ast_409.Outcometree.Omty_abstract + | Ast_410.Outcometree.Omty_functor (x0, x1) -> + let name, mt = + match x0 with + | None -> "*", None + | Some (None, mt) -> "_", Some (copy_out_module_type mt) + | Some (Some s, mt) -> s, Some (copy_out_module_type mt) + in + Ast_409.Outcometree.Omty_functor + (name, mt, copy_out_module_type x1) + | Ast_410.Outcometree.Omty_ident x0 -> + Ast_409.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_410.Outcometree.Omty_signature x0 -> + Ast_409.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_410.Outcometree.Omty_alias x0 -> + Ast_409.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_410.Outcometree.out_ext_status -> Ast_409.Outcometree.out_ext_status = + function + | Ast_410.Outcometree.Oext_first -> Ast_409.Outcometree.Oext_first + | Ast_410.Outcometree.Oext_next -> Ast_409.Outcometree.Oext_next + | Ast_410.Outcometree.Oext_exception -> Ast_409.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_410.Outcometree.out_extension_constructor -> + Ast_409.Outcometree.out_extension_constructor + = + fun + { Ast_410.Outcometree.oext_name = oext_name; + Ast_410.Outcometree.oext_type_name = oext_type_name; + Ast_410.Outcometree.oext_type_params = oext_type_params; + Ast_410.Outcometree.oext_args = oext_args; + Ast_410.Outcometree.oext_ret_type = oext_ret_type; + Ast_410.Outcometree.oext_private = oext_private } + -> + { + Ast_409.Outcometree.oext_name = oext_name; + Ast_409.Outcometree.oext_type_name = oext_type_name; + Ast_409.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_409.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_409.Outcometree.oext_ret_type = + (map_option copy_out_type oext_ret_type); + Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_410.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = + function + | Ast_410.Outcometree.Orec_not -> Ast_409.Outcometree.Orec_not + | Ast_410.Outcometree.Orec_first -> Ast_409.Outcometree.Orec_first + | Ast_410.Outcometree.Orec_next -> Ast_409.Outcometree.Orec_next +and copy_out_class_type : + Ast_410.Outcometree.out_class_type -> Ast_409.Outcometree.out_class_type = + function + | Ast_410.Outcometree.Octy_constr (x0, x1) -> + Ast_409.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_410.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_409.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_410.Outcometree.Octy_signature (x0, x1) -> + Ast_409.Outcometree.Octy_signature + ((map_option copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_410.Outcometree.out_class_sig_item -> + Ast_409.Outcometree.out_class_sig_item + = + function + | Ast_410.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_409.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_410.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_409.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_410.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_409.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_410.Outcometree.out_type -> Ast_409.Outcometree.out_type = + function + | Ast_410.Outcometree.Otyp_abstract -> Ast_409.Outcometree.Otyp_abstract + | Ast_410.Outcometree.Otyp_open -> Ast_409.Outcometree.Otyp_open + | Ast_410.Outcometree.Otyp_alias (x0, x1) -> + Ast_409.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_410.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_410.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_410.Outcometree.Otyp_constr (x0, x1) -> + Ast_409.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_410.Outcometree.Otyp_manifest (x0, x1) -> + Ast_409.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_410.Outcometree.Otyp_object (x0, x1) -> + Ast_409.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (map_option (fun x -> x) x1)) + | Ast_410.Outcometree.Otyp_record x0 -> + Ast_409.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_410.Outcometree.Otyp_stuff x0 -> Ast_409.Outcometree.Otyp_stuff x0 + | Ast_410.Outcometree.Otyp_sum x0 -> + Ast_409.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (map_option copy_out_type x2))) x0) + | Ast_410.Outcometree.Otyp_tuple x0 -> + Ast_409.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_410.Outcometree.Otyp_var (x0, x1) -> + Ast_409.Outcometree.Otyp_var (x0, x1) + | Ast_410.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_409.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (map_option (fun x -> List.map (fun x -> x) x) x3)) + | Ast_410.Outcometree.Otyp_poly (x0, x1) -> + Ast_409.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_410.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_409.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_410.Outcometree.Otyp_attribute (x0, x1) -> + Ast_409.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_410.Outcometree.out_attribute -> Ast_409.Outcometree.out_attribute = + fun { Ast_410.Outcometree.oattr_name = oattr_name } -> + { Ast_409.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_410.Outcometree.out_variant -> Ast_409.Outcometree.out_variant = + function + | Ast_410.Outcometree.Ovar_fields x0 -> + Ast_409.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_410.Outcometree.Ovar_typ x0 -> + Ast_409.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_410.Outcometree.out_value -> Ast_409.Outcometree.out_value = + function + | Ast_410.Outcometree.Oval_array x0 -> + Ast_409.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_char x0 -> Ast_409.Outcometree.Oval_char x0 + | Ast_410.Outcometree.Oval_constr (x0, x1) -> + Ast_409.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_410.Outcometree.Oval_ellipsis -> Ast_409.Outcometree.Oval_ellipsis + | Ast_410.Outcometree.Oval_float x0 -> Ast_409.Outcometree.Oval_float x0 + | Ast_410.Outcometree.Oval_int x0 -> Ast_409.Outcometree.Oval_int x0 + | Ast_410.Outcometree.Oval_int32 x0 -> Ast_409.Outcometree.Oval_int32 x0 + | Ast_410.Outcometree.Oval_int64 x0 -> Ast_409.Outcometree.Oval_int64 x0 + | Ast_410.Outcometree.Oval_nativeint x0 -> + Ast_409.Outcometree.Oval_nativeint x0 + | Ast_410.Outcometree.Oval_list x0 -> + Ast_409.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_printer x0 -> + Ast_409.Outcometree.Oval_printer x0 + | Ast_410.Outcometree.Oval_record x0 -> + Ast_409.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_410.Outcometree.Oval_string (x0, x1, x2) -> + Ast_409.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_410.Outcometree.Oval_stuff x0 -> Ast_409.Outcometree.Oval_stuff x0 + | Ast_410.Outcometree.Oval_tuple x0 -> + Ast_409.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_variant (x0, x1) -> + Ast_409.Outcometree.Oval_variant (x0, (map_option copy_out_value x1)) +and copy_out_string : + Ast_410.Outcometree.out_string -> Ast_409.Outcometree.out_string = + function + | Ast_410.Outcometree.Ostr_string -> Ast_409.Outcometree.Ostr_string + | Ast_410.Outcometree.Ostr_bytes -> Ast_409.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_410.Outcometree.out_ident -> Ast_409.Outcometree.out_ident = + function + | Ast_410.Outcometree.Oide_apply (x0, x1) -> + Ast_409.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_410.Outcometree.Oide_dot (x0, x1) -> + Ast_409.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_410.Outcometree.Oide_ident x0 -> + Ast_409.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_410.Outcometree.out_name -> Ast_409.Outcometree.out_name = + fun { Ast_410.Outcometree.printed_name = printed_name } -> + { Ast_409.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_410.Parsetree.toplevel_phrase -> Ast_409.Parsetree.toplevel_phrase = + function + | Ast_410.Parsetree.Ptop_def x0 -> + Ast_409.Parsetree.Ptop_def (copy_structure x0) + | Ast_410.Parsetree.Ptop_dir x0 -> + Ast_409.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_410.Parsetree.toplevel_directive -> + Ast_409.Parsetree.toplevel_directive + = + fun + { Ast_410.Parsetree.pdir_name = pdir_name; + Ast_410.Parsetree.pdir_arg = pdir_arg; + Ast_410.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_409.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_409.Parsetree.pdir_arg = + (map_option copy_directive_argument pdir_arg); + Ast_409.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_410.Parsetree.directive_argument -> + Ast_409.Parsetree.directive_argument + = + fun + { Ast_410.Parsetree.pdira_desc = pdira_desc; + Ast_410.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_409.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_409.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_410.Parsetree.directive_argument_desc -> + Ast_409.Parsetree.directive_argument_desc + = + function + | Ast_410.Parsetree.Pdir_string x0 -> Ast_409.Parsetree.Pdir_string x0 + | Ast_410.Parsetree.Pdir_int (x0, x1) -> + Ast_409.Parsetree.Pdir_int (x0, (map_option (fun x -> x) x1)) + | Ast_410.Parsetree.Pdir_ident x0 -> + Ast_409.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_410.Parsetree.Pdir_bool x0 -> Ast_409.Parsetree.Pdir_bool x0 +and copy_expression : + Ast_410.Parsetree.expression -> Ast_409.Parsetree.expression = + fun + { Ast_410.Parsetree.pexp_desc = pexp_desc; + Ast_410.Parsetree.pexp_loc = pexp_loc; + Ast_410.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_410.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_409.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_409.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_409.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); + Ast_409.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expression_desc : + Ast_410.Parsetree.expression_desc -> Ast_409.Parsetree.expression_desc = + function + | Ast_410.Parsetree.Pexp_ident x0 -> + Ast_409.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pexp_constant x0 -> + Ast_409.Parsetree.Pexp_constant (copy_constant x0) + | Ast_410.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_410.Parsetree.Pexp_function x0 -> + Ast_409.Parsetree.Pexp_function (List.map copy_case x0) + | Ast_410.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_409.Parsetree.Pexp_fun + ((copy_arg_label x0), (map_option copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_410.Parsetree.Pexp_apply (x0, x1) -> + Ast_409.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_410.Parsetree.Pexp_match (x0, x1) -> + Ast_409.Parsetree.Pexp_match + ((copy_expression x0), (List.map copy_case x1)) + | Ast_410.Parsetree.Pexp_try (x0, x1) -> + Ast_409.Parsetree.Pexp_try + ((copy_expression x0), (List.map copy_case x1)) + | Ast_410.Parsetree.Pexp_tuple x0 -> + Ast_409.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_410.Parsetree.Pexp_construct (x0, x1) -> + Ast_409.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (map_option copy_expression x1)) + | Ast_410.Parsetree.Pexp_variant (x0, x1) -> + Ast_409.Parsetree.Pexp_variant + ((copy_label x0), (map_option copy_expression x1)) + | Ast_410.Parsetree.Pexp_record (x0, x1) -> + Ast_409.Parsetree.Pexp_record + ((List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), + (map_option copy_expression x1)) + | Ast_410.Parsetree.Pexp_field (x0, x1) -> + Ast_409.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_410.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_410.Parsetree.Pexp_array x0 -> + Ast_409.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_410.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (map_option copy_expression x2)) + | Ast_410.Parsetree.Pexp_sequence (x0, x1) -> + Ast_409.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_while (x0, x1) -> + Ast_409.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_409.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_410.Parsetree.Pexp_constraint (x0, x1) -> + Ast_409.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_410.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_coerce + ((copy_expression x0), (map_option copy_core_type x1), + (copy_core_type x2)) + | Ast_410.Parsetree.Pexp_send (x0, x1) -> + Ast_409.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_410.Parsetree.Pexp_new x0 -> + Ast_409.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_409.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_override x0 -> + Ast_409.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_410.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_409.Parsetree.Pexp_letmodule + ((copy_loc (function + | None -> migration_error x0.loc Anonymous_let_module + | Some x -> x) x0), + (copy_module_expr x1), (copy_expression x2)) + | Ast_410.Parsetree.Pexp_letexception (x0, x1) -> + Ast_409.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_assert x0 -> + Ast_409.Parsetree.Pexp_assert (copy_expression x0) + | Ast_410.Parsetree.Pexp_lazy x0 -> + Ast_409.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_410.Parsetree.Pexp_poly (x0, x1) -> + Ast_409.Parsetree.Pexp_poly + ((copy_expression x0), (map_option copy_core_type x1)) + | Ast_410.Parsetree.Pexp_object x0 -> + Ast_409.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_410.Parsetree.Pexp_newtype (x0, x1) -> + Ast_409.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_pack x0 -> + Ast_409.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_410.Parsetree.Pexp_open (x0, x1) -> + Ast_409.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_letop x0 -> + Ast_409.Parsetree.Pexp_letop (copy_letop x0) + | Ast_410.Parsetree.Pexp_extension x0 -> + Ast_409.Parsetree.Pexp_extension (copy_extension x0) + | Ast_410.Parsetree.Pexp_unreachable -> Ast_409.Parsetree.Pexp_unreachable +and copy_letop : Ast_410.Parsetree.letop -> Ast_409.Parsetree.letop = + fun + { Ast_410.Parsetree.let_ = let_; Ast_410.Parsetree.ands = ands; + Ast_410.Parsetree.body = body } + -> + { + Ast_409.Parsetree.let_ = (copy_binding_op let_); + Ast_409.Parsetree.ands = (List.map copy_binding_op ands); + Ast_409.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_410.Parsetree.binding_op -> Ast_409.Parsetree.binding_op = + fun + { Ast_410.Parsetree.pbop_op = pbop_op; + Ast_410.Parsetree.pbop_pat = pbop_pat; + Ast_410.Parsetree.pbop_exp = pbop_exp; + Ast_410.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_409.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_409.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_409.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_409.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_410.Asttypes.direction_flag -> Ast_409.Asttypes.direction_flag = + function + | Ast_410.Asttypes.Upto -> Ast_409.Asttypes.Upto + | Ast_410.Asttypes.Downto -> Ast_409.Asttypes.Downto +and copy_case : Ast_410.Parsetree.case -> Ast_409.Parsetree.case = + fun + { Ast_410.Parsetree.pc_lhs = pc_lhs; + Ast_410.Parsetree.pc_guard = pc_guard; + Ast_410.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_409.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_409.Parsetree.pc_guard = (map_option copy_expression pc_guard); + Ast_409.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_cases : Ast_410.Parsetree.case list -> Ast_409.Parsetree.cases + = fun x -> List.map copy_case x +and copy_value_binding : + Ast_410.Parsetree.value_binding -> Ast_409.Parsetree.value_binding = + fun + { Ast_410.Parsetree.pvb_pat = pvb_pat; + Ast_410.Parsetree.pvb_expr = pvb_expr; + Ast_410.Parsetree.pvb_attributes = pvb_attributes; + Ast_410.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_409.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_409.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_409.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_409.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_410.Parsetree.pattern -> Ast_409.Parsetree.pattern = + fun + { Ast_410.Parsetree.ppat_desc = ppat_desc; + Ast_410.Parsetree.ppat_loc = ppat_loc; + Ast_410.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_410.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_409.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_409.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_409.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); + Ast_409.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pattern_desc : + Ast_410.Parsetree.pattern_desc -> Ast_409.Parsetree.pattern_desc = + function + | Ast_410.Parsetree.Ppat_any -> Ast_409.Parsetree.Ppat_any + | Ast_410.Parsetree.Ppat_var x0 -> + Ast_409.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_410.Parsetree.Ppat_alias (x0, x1) -> + Ast_409.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_410.Parsetree.Ppat_constant x0 -> + Ast_409.Parsetree.Ppat_constant (copy_constant x0) + | Ast_410.Parsetree.Ppat_interval (x0, x1) -> + Ast_409.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_410.Parsetree.Ppat_tuple x0 -> + Ast_409.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_410.Parsetree.Ppat_construct (x0, x1) -> + Ast_409.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (map_option copy_pattern x1)) + | Ast_410.Parsetree.Ppat_variant (x0, x1) -> + Ast_409.Parsetree.Ppat_variant + ((copy_label x0), (map_option copy_pattern x1)) + | Ast_410.Parsetree.Ppat_record (x0, x1) -> + Ast_409.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_410.Parsetree.Ppat_array x0 -> + Ast_409.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_410.Parsetree.Ppat_or (x0, x1) -> + Ast_409.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_410.Parsetree.Ppat_constraint (x0, x1) -> + Ast_409.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_410.Parsetree.Ppat_type x0 -> + Ast_409.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Ppat_lazy x0 -> + Ast_409.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_410.Parsetree.Ppat_unpack x0 -> + Ast_409.Parsetree.Ppat_unpack + (copy_loc (function + | None -> migration_error x0.loc Anonymous_unpack + | Some x -> x) x0) + | Ast_410.Parsetree.Ppat_exception x0 -> + Ast_409.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_410.Parsetree.Ppat_extension x0 -> + Ast_409.Parsetree.Ppat_extension (copy_extension x0) + | Ast_410.Parsetree.Ppat_open (x0, x1) -> + Ast_409.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_410.Parsetree.core_type -> Ast_409.Parsetree.core_type = + fun + { Ast_410.Parsetree.ptyp_desc = ptyp_desc; + Ast_410.Parsetree.ptyp_loc = ptyp_loc; + Ast_410.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_410.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_409.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_409.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_409.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); + Ast_409.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_location_stack : + Ast_410.Parsetree.location_stack -> Ast_409.Location.t list = + fun x -> List.map copy_location x +and copy_core_type_desc : + Ast_410.Parsetree.core_type_desc -> Ast_409.Parsetree.core_type_desc = + function + | Ast_410.Parsetree.Ptyp_any -> Ast_409.Parsetree.Ptyp_any + | Ast_410.Parsetree.Ptyp_var x0 -> Ast_409.Parsetree.Ptyp_var x0 + | Ast_410.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_409.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_410.Parsetree.Ptyp_tuple x0 -> + Ast_409.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_410.Parsetree.Ptyp_constr (x0, x1) -> + Ast_409.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_object (x0, x1) -> + Ast_409.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_410.Parsetree.Ptyp_class (x0, x1) -> + Ast_409.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_alias (x0, x1) -> + Ast_409.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_410.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_409.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (map_option (fun x -> List.map copy_label x) x2)) + | Ast_410.Parsetree.Ptyp_poly (x0, x1) -> + Ast_409.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_package x0 -> + Ast_409.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_410.Parsetree.Ptyp_extension x0 -> + Ast_409.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_410.Parsetree.package_type -> Ast_409.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_410.Parsetree.row_field -> Ast_409.Parsetree.row_field = + fun + { Ast_410.Parsetree.prf_desc = prf_desc; + Ast_410.Parsetree.prf_loc = prf_loc; + Ast_410.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_409.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_409.Parsetree.prf_loc = (copy_location prf_loc); + Ast_409.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_410.Parsetree.row_field_desc -> Ast_409.Parsetree.row_field_desc = + function + | Ast_410.Parsetree.Rtag (x0, x1, x2) -> + Ast_409.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_410.Parsetree.Rinherit x0 -> + Ast_409.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_410.Parsetree.object_field -> Ast_409.Parsetree.object_field = + fun + { Ast_410.Parsetree.pof_desc = pof_desc; + Ast_410.Parsetree.pof_loc = pof_loc; + Ast_410.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_409.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_409.Parsetree.pof_loc = (copy_location pof_loc); + Ast_409.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_410.Parsetree.attributes -> Ast_409.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_410.Parsetree.attribute -> Ast_409.Parsetree.attribute = + fun + { Ast_410.Parsetree.attr_name = attr_name; + Ast_410.Parsetree.attr_payload = attr_payload; + Ast_410.Parsetree.attr_loc = attr_loc } + -> + { + Ast_409.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_409.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_409.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_410.Parsetree.payload -> Ast_409.Parsetree.payload = + function + | Ast_410.Parsetree.PStr x0 -> Ast_409.Parsetree.PStr (copy_structure x0) + | Ast_410.Parsetree.PSig x0 -> Ast_409.Parsetree.PSig (copy_signature x0) + | Ast_410.Parsetree.PTyp x0 -> Ast_409.Parsetree.PTyp (copy_core_type x0) + | Ast_410.Parsetree.PPat (x0, x1) -> + Ast_409.Parsetree.PPat + ((copy_pattern x0), (map_option copy_expression x1)) +and copy_structure : + Ast_410.Parsetree.structure -> Ast_409.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_410.Parsetree.structure_item -> Ast_409.Parsetree.structure_item = + fun + { Ast_410.Parsetree.pstr_desc = pstr_desc; + Ast_410.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_409.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_409.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_410.Parsetree.structure_item_desc -> + Ast_409.Parsetree.structure_item_desc + = + function + | Ast_410.Parsetree.Pstr_eval (x0, x1) -> + Ast_409.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_410.Parsetree.Pstr_value (x0, x1) -> + Ast_409.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_410.Parsetree.Pstr_primitive x0 -> + Ast_409.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_410.Parsetree.Pstr_type (x0, x1) -> + Ast_409.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_410.Parsetree.Pstr_typext x0 -> + Ast_409.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_410.Parsetree.Pstr_exception x0 -> + Ast_409.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_410.Parsetree.Pstr_module x0 -> + Ast_409.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_410.Parsetree.Pstr_recmodule x0 -> + Ast_409.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_410.Parsetree.Pstr_modtype x0 -> + Ast_409.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_410.Parsetree.Pstr_open x0 -> + Ast_409.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_410.Parsetree.Pstr_class x0 -> + Ast_409.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_410.Parsetree.Pstr_class_type x0 -> + Ast_409.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_410.Parsetree.Pstr_include x0 -> + Ast_409.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_410.Parsetree.Pstr_attribute x0 -> + Ast_409.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pstr_extension (x0, x1) -> + Ast_409.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_410.Parsetree.include_declaration -> + Ast_409.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_410.Parsetree.class_declaration -> Ast_409.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_410.Parsetree.class_expr -> Ast_409.Parsetree.class_expr = + fun + { Ast_410.Parsetree.pcl_desc = pcl_desc; + Ast_410.Parsetree.pcl_loc = pcl_loc; + Ast_410.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_409.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_409.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_409.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_410.Parsetree.class_expr_desc -> Ast_409.Parsetree.class_expr_desc = + function + | Ast_410.Parsetree.Pcl_constr (x0, x1) -> + Ast_409.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Pcl_structure x0 -> + Ast_409.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_410.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_409.Parsetree.Pcl_fun + ((copy_arg_label x0), (map_option copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_410.Parsetree.Pcl_apply (x0, x1) -> + Ast_409.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_410.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_409.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_410.Parsetree.Pcl_constraint (x0, x1) -> + Ast_409.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_410.Parsetree.Pcl_extension x0 -> + Ast_409.Parsetree.Pcl_extension (copy_extension x0) + | Ast_410.Parsetree.Pcl_open (x0, x1) -> + Ast_409.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_410.Parsetree.class_structure -> Ast_409.Parsetree.class_structure = + fun + { Ast_410.Parsetree.pcstr_self = pcstr_self; + Ast_410.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_409.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_409.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_410.Parsetree.class_field -> Ast_409.Parsetree.class_field = + fun + { Ast_410.Parsetree.pcf_desc = pcf_desc; + Ast_410.Parsetree.pcf_loc = pcf_loc; + Ast_410.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_409.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_409.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_409.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_410.Parsetree.class_field_desc -> Ast_409.Parsetree.class_field_desc = + function + | Ast_410.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_409.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (map_option (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_410.Parsetree.Pcf_val x0 -> + Ast_409.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_410.Parsetree.Pcf_method x0 -> + Ast_409.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_410.Parsetree.Pcf_constraint x0 -> + Ast_409.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_410.Parsetree.Pcf_initializer x0 -> + Ast_409.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_410.Parsetree.Pcf_attribute x0 -> + Ast_409.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pcf_extension x0 -> + Ast_409.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_410.Parsetree.class_field_kind -> Ast_409.Parsetree.class_field_kind = + function + | Ast_410.Parsetree.Cfk_virtual x0 -> + Ast_409.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_410.Parsetree.Cfk_concrete (x0, x1) -> + Ast_409.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_410.Parsetree.open_declaration -> Ast_409.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_410.Parsetree.module_binding -> Ast_409.Parsetree.module_binding = + fun + { Ast_410.Parsetree.pmb_name = pmb_name; + Ast_410.Parsetree.pmb_expr = pmb_expr; + Ast_410.Parsetree.pmb_attributes = pmb_attributes; + Ast_410.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_409.Parsetree.pmb_name = + (copy_loc (function Some x -> x + | None -> migration_error pmb_name.loc Anonymous_module_binding) pmb_name); + Ast_409.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_409.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_409.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_410.Parsetree.module_expr -> Ast_409.Parsetree.module_expr = + fun + { Ast_410.Parsetree.pmod_desc = pmod_desc; + Ast_410.Parsetree.pmod_loc = pmod_loc; + Ast_410.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_409.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_409.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_409.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_410.Parsetree.module_expr_desc -> Ast_409.Parsetree.module_expr_desc = + function + | Ast_410.Parsetree.Pmod_ident x0 -> + Ast_409.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pmod_structure x0 -> + Ast_409.Parsetree.Pmod_structure (copy_structure x0) + | Ast_410.Parsetree.Pmod_functor (x0, x1) -> + let x, y = copy_functor_parameter x0 in + Ast_409.Parsetree.Pmod_functor + (x, y, (copy_module_expr x1)) + | Ast_410.Parsetree.Pmod_apply (x0, x1) -> + Ast_409.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_410.Parsetree.Pmod_constraint (x0, x1) -> + Ast_409.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_410.Parsetree.Pmod_unpack x0 -> + Ast_409.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_410.Parsetree.Pmod_extension x0 -> + Ast_409.Parsetree.Pmod_extension (copy_extension x0) +and copy_functor_parameter : + Ast_410.Parsetree.functor_parameter -> string Ast_409.Asttypes.loc * Ast_409.Parsetree.module_type option + = + function + | Ast_410.Parsetree.Unit -> ({ loc = Location.none; txt = "*" }, None) + | Ast_410.Parsetree.Named (x0, x1) -> + ((copy_loc (function + | None -> "_" + | Some x -> x) x0, + Some (copy_module_type x1))) +and copy_module_type : + Ast_410.Parsetree.module_type -> Ast_409.Parsetree.module_type = + fun + { Ast_410.Parsetree.pmty_desc = pmty_desc; + Ast_410.Parsetree.pmty_loc = pmty_loc; + Ast_410.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_409.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_409.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_409.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_410.Parsetree.module_type_desc -> Ast_409.Parsetree.module_type_desc = + function + | Ast_410.Parsetree.Pmty_ident x0 -> + Ast_409.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pmty_signature x0 -> + Ast_409.Parsetree.Pmty_signature (copy_signature x0) + | Ast_410.Parsetree.Pmty_functor (x0, x1) -> + let x, y = copy_functor_parameter x0 in + Ast_409.Parsetree.Pmty_functor + (x, y, (copy_module_type x1)) + | Ast_410.Parsetree.Pmty_with (x0, x1) -> + Ast_409.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_410.Parsetree.Pmty_typeof x0 -> + Ast_409.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_410.Parsetree.Pmty_extension x0 -> + Ast_409.Parsetree.Pmty_extension (copy_extension x0) + | Ast_410.Parsetree.Pmty_alias x0 -> + Ast_409.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_410.Parsetree.with_constraint -> Ast_409.Parsetree.with_constraint = + function + | Ast_410.Parsetree.Pwith_type (x0, x1) -> + Ast_409.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_410.Parsetree.Pwith_module (x0, x1) -> + Ast_409.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_410.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_409.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_410.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_409.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_410.Parsetree.signature -> Ast_409.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_410.Parsetree.signature_item -> Ast_409.Parsetree.signature_item = + fun + { Ast_410.Parsetree.psig_desc = psig_desc; + Ast_410.Parsetree.psig_loc = psig_loc } + -> + { + Ast_409.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_409.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_410.Parsetree.signature_item_desc -> + Ast_409.Parsetree.signature_item_desc + = + function + | Ast_410.Parsetree.Psig_value x0 -> + Ast_409.Parsetree.Psig_value (copy_value_description x0) + | Ast_410.Parsetree.Psig_type (x0, x1) -> + Ast_409.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_410.Parsetree.Psig_typesubst x0 -> + Ast_409.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_410.Parsetree.Psig_typext x0 -> + Ast_409.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_410.Parsetree.Psig_exception x0 -> + Ast_409.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_410.Parsetree.Psig_module x0 -> + Ast_409.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_410.Parsetree.Psig_modsubst x0 -> + Ast_409.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_410.Parsetree.Psig_recmodule x0 -> + Ast_409.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_410.Parsetree.Psig_modtype x0 -> + Ast_409.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_410.Parsetree.Psig_open x0 -> + Ast_409.Parsetree.Psig_open (copy_open_description x0) + | Ast_410.Parsetree.Psig_include x0 -> + Ast_409.Parsetree.Psig_include (copy_include_description x0) + | Ast_410.Parsetree.Psig_class x0 -> + Ast_409.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_410.Parsetree.Psig_class_type x0 -> + Ast_409.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_410.Parsetree.Psig_attribute x0 -> + Ast_409.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_410.Parsetree.Psig_extension (x0, x1) -> + Ast_409.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_410.Parsetree.class_type_declaration -> + Ast_409.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_410.Parsetree.class_description -> Ast_409.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_410.Parsetree.class_type -> Ast_409.Parsetree.class_type = + fun + { Ast_410.Parsetree.pcty_desc = pcty_desc; + Ast_410.Parsetree.pcty_loc = pcty_loc; + Ast_410.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_409.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_409.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_409.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_410.Parsetree.class_type_desc -> Ast_409.Parsetree.class_type_desc = + function + | Ast_410.Parsetree.Pcty_constr (x0, x1) -> + Ast_409.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Pcty_signature x0 -> + Ast_409.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_410.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_409.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_410.Parsetree.Pcty_extension x0 -> + Ast_409.Parsetree.Pcty_extension (copy_extension x0) + | Ast_410.Parsetree.Pcty_open (x0, x1) -> + Ast_409.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_410.Parsetree.class_signature -> Ast_409.Parsetree.class_signature = + fun + { Ast_410.Parsetree.pcsig_self = pcsig_self; + Ast_410.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_409.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_409.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_410.Parsetree.class_type_field -> Ast_409.Parsetree.class_type_field = + fun + { Ast_410.Parsetree.pctf_desc = pctf_desc; + Ast_410.Parsetree.pctf_loc = pctf_loc; + Ast_410.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_409.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_409.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_409.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_410.Parsetree.class_type_field_desc -> + Ast_409.Parsetree.class_type_field_desc + = + function + | Ast_410.Parsetree.Pctf_inherit x0 -> + Ast_409.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_410.Parsetree.Pctf_val x0 -> + Ast_409.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_410.Parsetree.Pctf_method x0 -> + Ast_409.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_410.Parsetree.Pctf_constraint x0 -> + Ast_409.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_410.Parsetree.Pctf_attribute x0 -> + Ast_409.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pctf_extension x0 -> + Ast_409.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_410.Parsetree.extension -> Ast_409.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_410.Parsetree.class_infos -> 'g0 Ast_409.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.pci_virt = pci_virt; + Ast_410.Parsetree.pci_params = pci_params; + Ast_410.Parsetree.pci_name = pci_name; + Ast_410.Parsetree.pci_expr = pci_expr; + Ast_410.Parsetree.pci_loc = pci_loc; + Ast_410.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_409.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_409.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_409.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_409.Parsetree.pci_expr = (f0 pci_expr); + Ast_409.Parsetree.pci_loc = (copy_location pci_loc); + Ast_409.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_410.Asttypes.virtual_flag -> Ast_409.Asttypes.virtual_flag = + function + | Ast_410.Asttypes.Virtual -> Ast_409.Asttypes.Virtual + | Ast_410.Asttypes.Concrete -> Ast_409.Asttypes.Concrete +and copy_include_description : + Ast_410.Parsetree.include_description -> + Ast_409.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_410.Parsetree.include_infos -> + 'g0 Ast_409.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.pincl_mod = pincl_mod; + Ast_410.Parsetree.pincl_loc = pincl_loc; + Ast_410.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_409.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_409.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_409.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_410.Parsetree.open_description -> Ast_409.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_410.Parsetree.open_infos -> 'g0 Ast_409.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.popen_expr = popen_expr; + Ast_410.Parsetree.popen_override = popen_override; + Ast_410.Parsetree.popen_loc = popen_loc; + Ast_410.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_409.Parsetree.popen_expr = (f0 popen_expr); + Ast_409.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_409.Parsetree.popen_loc = (copy_location popen_loc); + Ast_409.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_410.Asttypes.override_flag -> Ast_409.Asttypes.override_flag = + function + | Ast_410.Asttypes.Override -> Ast_409.Asttypes.Override + | Ast_410.Asttypes.Fresh -> Ast_409.Asttypes.Fresh +and copy_module_type_declaration : + Ast_410.Parsetree.module_type_declaration -> + Ast_409.Parsetree.module_type_declaration + = + fun + { Ast_410.Parsetree.pmtd_name = pmtd_name; + Ast_410.Parsetree.pmtd_type = pmtd_type; + Ast_410.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_410.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_409.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_409.Parsetree.pmtd_type = (map_option copy_module_type pmtd_type); + Ast_409.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_409.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_410.Parsetree.module_substitution -> + Ast_409.Parsetree.module_substitution + = + fun + { Ast_410.Parsetree.pms_name = pms_name; + Ast_410.Parsetree.pms_manifest = pms_manifest; + Ast_410.Parsetree.pms_attributes = pms_attributes; + Ast_410.Parsetree.pms_loc = pms_loc } + -> + { + Ast_409.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_409.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_409.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_409.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_410.Parsetree.module_declaration -> + Ast_409.Parsetree.module_declaration + = + fun + { Ast_410.Parsetree.pmd_name = pmd_name; + Ast_410.Parsetree.pmd_type = pmd_type; + Ast_410.Parsetree.pmd_attributes = pmd_attributes; + Ast_410.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_409.Parsetree.pmd_name = + (copy_loc (function + | None -> migration_error pmd_name.loc Anonymous_module_declaration + | Some x -> x) pmd_name); + Ast_409.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_409.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_409.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_410.Parsetree.type_exception -> Ast_409.Parsetree.type_exception = + fun + { Ast_410.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_410.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_410.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_409.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_409.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_409.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_410.Parsetree.type_extension -> Ast_409.Parsetree.type_extension = + fun + { Ast_410.Parsetree.ptyext_path = ptyext_path; + Ast_410.Parsetree.ptyext_params = ptyext_params; + Ast_410.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_410.Parsetree.ptyext_private = ptyext_private; + Ast_410.Parsetree.ptyext_loc = ptyext_loc; + Ast_410.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_409.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_409.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_409.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_409.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_409.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_409.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_410.Parsetree.extension_constructor -> + Ast_409.Parsetree.extension_constructor + = + fun + { Ast_410.Parsetree.pext_name = pext_name; + Ast_410.Parsetree.pext_kind = pext_kind; + Ast_410.Parsetree.pext_loc = pext_loc; + Ast_410.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_409.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_409.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_409.Parsetree.pext_loc = (copy_location pext_loc); + Ast_409.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_410.Parsetree.extension_constructor_kind -> + Ast_409.Parsetree.extension_constructor_kind + = + function + | Ast_410.Parsetree.Pext_decl (x0, x1) -> + Ast_409.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (map_option copy_core_type x1)) + | Ast_410.Parsetree.Pext_rebind x0 -> + Ast_409.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_410.Parsetree.type_declaration -> Ast_409.Parsetree.type_declaration = + fun + { Ast_410.Parsetree.ptype_name = ptype_name; + Ast_410.Parsetree.ptype_params = ptype_params; + Ast_410.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_410.Parsetree.ptype_kind = ptype_kind; + Ast_410.Parsetree.ptype_private = ptype_private; + Ast_410.Parsetree.ptype_manifest = ptype_manifest; + Ast_410.Parsetree.ptype_attributes = ptype_attributes; + Ast_410.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_409.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_409.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_409.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_409.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_409.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_409.Parsetree.ptype_manifest = + (map_option copy_core_type ptype_manifest); + Ast_409.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_409.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_410.Asttypes.private_flag -> Ast_409.Asttypes.private_flag = + function + | Ast_410.Asttypes.Private -> Ast_409.Asttypes.Private + | Ast_410.Asttypes.Public -> Ast_409.Asttypes.Public +and copy_type_kind : + Ast_410.Parsetree.type_kind -> Ast_409.Parsetree.type_kind = + function + | Ast_410.Parsetree.Ptype_abstract -> Ast_409.Parsetree.Ptype_abstract + | Ast_410.Parsetree.Ptype_variant x0 -> + Ast_409.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_410.Parsetree.Ptype_record x0 -> + Ast_409.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_410.Parsetree.Ptype_open -> Ast_409.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_410.Parsetree.constructor_declaration -> + Ast_409.Parsetree.constructor_declaration + = + fun + { Ast_410.Parsetree.pcd_name = pcd_name; + Ast_410.Parsetree.pcd_args = pcd_args; + Ast_410.Parsetree.pcd_res = pcd_res; + Ast_410.Parsetree.pcd_loc = pcd_loc; + Ast_410.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_409.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_409.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_409.Parsetree.pcd_res = (map_option copy_core_type pcd_res); + Ast_409.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_409.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_410.Parsetree.constructor_arguments -> + Ast_409.Parsetree.constructor_arguments + = + function + | Ast_410.Parsetree.Pcstr_tuple x0 -> + Ast_409.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_410.Parsetree.Pcstr_record x0 -> + Ast_409.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_410.Parsetree.label_declaration -> Ast_409.Parsetree.label_declaration + = + fun + { Ast_410.Parsetree.pld_name = pld_name; + Ast_410.Parsetree.pld_mutable = pld_mutable; + Ast_410.Parsetree.pld_type = pld_type; + Ast_410.Parsetree.pld_loc = pld_loc; + Ast_410.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_409.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_409.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_409.Parsetree.pld_type = (copy_core_type pld_type); + Ast_409.Parsetree.pld_loc = (copy_location pld_loc); + Ast_409.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_410.Asttypes.mutable_flag -> Ast_409.Asttypes.mutable_flag = + function + | Ast_410.Asttypes.Immutable -> Ast_409.Asttypes.Immutable + | Ast_410.Asttypes.Mutable -> Ast_409.Asttypes.Mutable +and copy_variance : Ast_410.Asttypes.variance -> Ast_409.Asttypes.variance = + function + | Ast_410.Asttypes.Covariant -> Ast_409.Asttypes.Covariant + | Ast_410.Asttypes.Contravariant -> Ast_409.Asttypes.Contravariant + | Ast_410.Asttypes.Invariant -> Ast_409.Asttypes.Invariant +and copy_value_description : + Ast_410.Parsetree.value_description -> Ast_409.Parsetree.value_description + = + fun + { Ast_410.Parsetree.pval_name = pval_name; + Ast_410.Parsetree.pval_type = pval_type; + Ast_410.Parsetree.pval_prim = pval_prim; + Ast_410.Parsetree.pval_attributes = pval_attributes; + Ast_410.Parsetree.pval_loc = pval_loc } + -> + { + Ast_409.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_409.Parsetree.pval_type = (copy_core_type pval_type); + Ast_409.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_409.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_409.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_410.Parsetree.object_field_desc -> Ast_409.Parsetree.object_field_desc + = + function + | Ast_410.Parsetree.Otag (x0, x1) -> + Ast_409.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_410.Parsetree.Oinherit x0 -> + Ast_409.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_410.Asttypes.arg_label -> Ast_409.Asttypes.arg_label + = + function + | Ast_410.Asttypes.Nolabel -> Ast_409.Asttypes.Nolabel + | Ast_410.Asttypes.Labelled x0 -> Ast_409.Asttypes.Labelled x0 + | Ast_410.Asttypes.Optional x0 -> Ast_409.Asttypes.Optional x0 +and copy_closed_flag : + Ast_410.Asttypes.closed_flag -> Ast_409.Asttypes.closed_flag = + function + | Ast_410.Asttypes.Closed -> Ast_409.Asttypes.Closed + | Ast_410.Asttypes.Open -> Ast_409.Asttypes.Open +and copy_label : Ast_410.Asttypes.label -> Ast_409.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_410.Asttypes.rec_flag -> Ast_409.Asttypes.rec_flag = + function + | Ast_410.Asttypes.Nonrecursive -> Ast_409.Asttypes.Nonrecursive + | Ast_410.Asttypes.Recursive -> Ast_409.Asttypes.Recursive +and copy_constant : Ast_410.Parsetree.constant -> Ast_409.Parsetree.constant + = + function + | Ast_410.Parsetree.Pconst_integer (x0, x1) -> + Ast_409.Parsetree.Pconst_integer (x0, (map_option (fun x -> x) x1)) + | Ast_410.Parsetree.Pconst_char x0 -> Ast_409.Parsetree.Pconst_char x0 + | Ast_410.Parsetree.Pconst_string (x0, x1) -> + Ast_409.Parsetree.Pconst_string (x0, (map_option (fun x -> x) x1)) + | Ast_410.Parsetree.Pconst_float (x0, x1) -> + Ast_409.Parsetree.Pconst_float (x0, (map_option (fun x -> x) x1)) +and copy_Longident_t : Ast_410.Longident.t -> Ast_409.Longident.t = + function + | Ast_410.Longident.Lident x0 -> Ast_409.Longident.Lident x0 + | Ast_410.Longident.Ldot (x0, x1) -> + Ast_409.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_410.Longident.Lapply (x0, x1) -> + Ast_409.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_410.Asttypes.loc -> 'g0 Ast_409.Asttypes.loc + = + fun f0 -> + fun { Ast_410.Asttypes.txt = txt; Ast_410.Asttypes.loc = loc } -> + { + Ast_409.Asttypes.txt = (f0 txt); + Ast_409.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_410.Location.t -> Ast_409.Location.t = + fun + { Ast_410.Location.loc_start = loc_start; + Ast_410.Location.loc_end = loc_end; + Ast_410.Location.loc_ghost = loc_ghost } + -> + { + Ast_409.Location.loc_start = (copy_position loc_start); + Ast_409.Location.loc_end = (copy_position loc_end); + Ast_409.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } +let copy_expr = copy_expression +let copy_pat = copy_pattern +let copy_typ = copy_core_type diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411.ml new file mode 100644 index 000000000..2c8775243 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411.ml @@ -0,0 +1,141 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_410_411_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + (*$*) + } as mapper) -> + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_411_410_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + constant = (fun _ x -> x) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411_migrate.ml new file mode 100644 index 000000000..c807845bf --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_410_411_migrate.ml @@ -0,0 +1,1522 @@ +open Stdlib0 +module From = Ast_410 +module To = Ast_411 +let rec copy_out_type_extension : + Ast_410.Outcometree.out_type_extension -> + Ast_411.Outcometree.out_type_extension + = + fun + { Ast_410.Outcometree.otyext_name = otyext_name; + Ast_410.Outcometree.otyext_params = otyext_params; + Ast_410.Outcometree.otyext_constructors = otyext_constructors; + Ast_410.Outcometree.otyext_private = otyext_private } + -> + { + Ast_411.Outcometree.otyext_name = otyext_name; + Ast_411.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_411.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_411.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_410.Outcometree.out_phrase -> Ast_411.Outcometree.out_phrase = + function + | Ast_410.Outcometree.Ophr_eval (x0, x1) -> + Ast_411.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_410.Outcometree.Ophr_signature x0 -> + Ast_411.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_410.Outcometree.Ophr_exception x0 -> + Ast_411.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_410.Outcometree.out_sig_item -> Ast_411.Outcometree.out_sig_item = + function + | Ast_410.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_411.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_410.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_411.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_410.Outcometree.Osig_typext (x0, x1) -> + Ast_411.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_410.Outcometree.Osig_modtype (x0, x1) -> + Ast_411.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_410.Outcometree.Osig_module (x0, x1, x2) -> + Ast_411.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_410.Outcometree.Osig_type (x0, x1) -> + Ast_411.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_410.Outcometree.Osig_value x0 -> + Ast_411.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_410.Outcometree.Osig_ellipsis -> Ast_411.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_410.Outcometree.out_val_decl -> Ast_411.Outcometree.out_val_decl = + fun + { Ast_410.Outcometree.oval_name = oval_name; + Ast_410.Outcometree.oval_type = oval_type; + Ast_410.Outcometree.oval_prims = oval_prims; + Ast_410.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_411.Outcometree.oval_name = oval_name; + Ast_411.Outcometree.oval_type = (copy_out_type oval_type); + Ast_411.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_411.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_410.Outcometree.out_type_decl -> Ast_411.Outcometree.out_type_decl = + fun + { Ast_410.Outcometree.otype_name = otype_name; + Ast_410.Outcometree.otype_params = otype_params; + Ast_410.Outcometree.otype_type = otype_type; + Ast_410.Outcometree.otype_private = otype_private; + Ast_410.Outcometree.otype_immediate = otype_immediate; + Ast_410.Outcometree.otype_unboxed = otype_unboxed; + Ast_410.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_411.Outcometree.otype_name = otype_name; + Ast_411.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_411.Outcometree.otype_type = (copy_out_type otype_type); + Ast_411.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_411.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_411.Outcometree.otype_unboxed = otype_unboxed; + Ast_411.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_Type_immediacy_t : + Ast_410.Type_immediacy.t -> Ast_411.Type_immediacy.t = + function + | Ast_410.Type_immediacy.Unknown -> Ast_411.Type_immediacy.Unknown + | Ast_410.Type_immediacy.Always -> Ast_411.Type_immediacy.Always + | Ast_410.Type_immediacy.Always_on_64bits -> + Ast_411.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_410.Outcometree.out_module_type -> Ast_411.Outcometree.out_module_type + = + function + | Ast_410.Outcometree.Omty_abstract -> Ast_411.Outcometree.Omty_abstract + | Ast_410.Outcometree.Omty_functor (x0, x1) -> + Ast_411.Outcometree.Omty_functor + ((Option.map + (fun x -> + let (x0, x1) = x in + ((Option.map (fun x -> x) x0), (copy_out_module_type x1))) x0), + (copy_out_module_type x1)) + | Ast_410.Outcometree.Omty_ident x0 -> + Ast_411.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_410.Outcometree.Omty_signature x0 -> + Ast_411.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_410.Outcometree.Omty_alias x0 -> + Ast_411.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_410.Outcometree.out_ext_status -> Ast_411.Outcometree.out_ext_status = + function + | Ast_410.Outcometree.Oext_first -> Ast_411.Outcometree.Oext_first + | Ast_410.Outcometree.Oext_next -> Ast_411.Outcometree.Oext_next + | Ast_410.Outcometree.Oext_exception -> Ast_411.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_410.Outcometree.out_extension_constructor -> + Ast_411.Outcometree.out_extension_constructor + = + fun + { Ast_410.Outcometree.oext_name = oext_name; + Ast_410.Outcometree.oext_type_name = oext_type_name; + Ast_410.Outcometree.oext_type_params = oext_type_params; + Ast_410.Outcometree.oext_args = oext_args; + Ast_410.Outcometree.oext_ret_type = oext_ret_type; + Ast_410.Outcometree.oext_private = oext_private } + -> + { + Ast_411.Outcometree.oext_name = oext_name; + Ast_411.Outcometree.oext_type_name = oext_type_name; + Ast_411.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_411.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_411.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_411.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_410.Outcometree.out_rec_status -> Ast_411.Outcometree.out_rec_status = + function + | Ast_410.Outcometree.Orec_not -> Ast_411.Outcometree.Orec_not + | Ast_410.Outcometree.Orec_first -> Ast_411.Outcometree.Orec_first + | Ast_410.Outcometree.Orec_next -> Ast_411.Outcometree.Orec_next +and copy_out_class_type : + Ast_410.Outcometree.out_class_type -> Ast_411.Outcometree.out_class_type = + function + | Ast_410.Outcometree.Octy_constr (x0, x1) -> + Ast_411.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_410.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_411.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_410.Outcometree.Octy_signature (x0, x1) -> + Ast_411.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_410.Outcometree.out_class_sig_item -> + Ast_411.Outcometree.out_class_sig_item + = + function + | Ast_410.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_411.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_410.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_411.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_410.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_411.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_410.Outcometree.out_type -> Ast_411.Outcometree.out_type = + function + | Ast_410.Outcometree.Otyp_abstract -> Ast_411.Outcometree.Otyp_abstract + | Ast_410.Outcometree.Otyp_open -> Ast_411.Outcometree.Otyp_open + | Ast_410.Outcometree.Otyp_alias (x0, x1) -> + Ast_411.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_410.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_411.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_410.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_411.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_410.Outcometree.Otyp_constr (x0, x1) -> + Ast_411.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_410.Outcometree.Otyp_manifest (x0, x1) -> + Ast_411.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_410.Outcometree.Otyp_object (x0, x1) -> + Ast_411.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (Option.map (fun x -> x) x1)) + | Ast_410.Outcometree.Otyp_record x0 -> + Ast_411.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_410.Outcometree.Otyp_stuff x0 -> Ast_411.Outcometree.Otyp_stuff x0 + | Ast_410.Outcometree.Otyp_sum x0 -> + Ast_411.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) x0) + | Ast_410.Outcometree.Otyp_tuple x0 -> + Ast_411.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_410.Outcometree.Otyp_var (x0, x1) -> + Ast_411.Outcometree.Otyp_var (x0, x1) + | Ast_410.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_411.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_410.Outcometree.Otyp_poly (x0, x1) -> + Ast_411.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_410.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_411.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_410.Outcometree.Otyp_attribute (x0, x1) -> + Ast_411.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_410.Outcometree.out_attribute -> Ast_411.Outcometree.out_attribute = + fun { Ast_410.Outcometree.oattr_name = oattr_name } -> + { Ast_411.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_410.Outcometree.out_variant -> Ast_411.Outcometree.out_variant = + function + | Ast_410.Outcometree.Ovar_fields x0 -> + Ast_411.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_410.Outcometree.Ovar_typ x0 -> + Ast_411.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_410.Outcometree.out_value -> Ast_411.Outcometree.out_value = + function + | Ast_410.Outcometree.Oval_array x0 -> + Ast_411.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_char x0 -> Ast_411.Outcometree.Oval_char x0 + | Ast_410.Outcometree.Oval_constr (x0, x1) -> + Ast_411.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_410.Outcometree.Oval_ellipsis -> Ast_411.Outcometree.Oval_ellipsis + | Ast_410.Outcometree.Oval_float x0 -> Ast_411.Outcometree.Oval_float x0 + | Ast_410.Outcometree.Oval_int x0 -> Ast_411.Outcometree.Oval_int x0 + | Ast_410.Outcometree.Oval_int32 x0 -> Ast_411.Outcometree.Oval_int32 x0 + | Ast_410.Outcometree.Oval_int64 x0 -> Ast_411.Outcometree.Oval_int64 x0 + | Ast_410.Outcometree.Oval_nativeint x0 -> + Ast_411.Outcometree.Oval_nativeint x0 + | Ast_410.Outcometree.Oval_list x0 -> + Ast_411.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_printer x0 -> + Ast_411.Outcometree.Oval_printer x0 + | Ast_410.Outcometree.Oval_record x0 -> + Ast_411.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_410.Outcometree.Oval_string (x0, x1, x2) -> + Ast_411.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_410.Outcometree.Oval_stuff x0 -> Ast_411.Outcometree.Oval_stuff x0 + | Ast_410.Outcometree.Oval_tuple x0 -> + Ast_411.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_410.Outcometree.Oval_variant (x0, x1) -> + Ast_411.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_410.Outcometree.out_string -> Ast_411.Outcometree.out_string = + function + | Ast_410.Outcometree.Ostr_string -> Ast_411.Outcometree.Ostr_string + | Ast_410.Outcometree.Ostr_bytes -> Ast_411.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_410.Outcometree.out_ident -> Ast_411.Outcometree.out_ident = + function + | Ast_410.Outcometree.Oide_apply (x0, x1) -> + Ast_411.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_410.Outcometree.Oide_dot (x0, x1) -> + Ast_411.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_410.Outcometree.Oide_ident x0 -> + Ast_411.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_410.Outcometree.out_name -> Ast_411.Outcometree.out_name = + fun { Ast_410.Outcometree.printed_name = printed_name } -> + { Ast_411.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_410.Parsetree.toplevel_phrase -> Ast_411.Parsetree.toplevel_phrase = + function + | Ast_410.Parsetree.Ptop_def x0 -> + Ast_411.Parsetree.Ptop_def (copy_structure x0) + | Ast_410.Parsetree.Ptop_dir x0 -> + Ast_411.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_410.Parsetree.toplevel_directive -> + Ast_411.Parsetree.toplevel_directive + = + fun + { Ast_410.Parsetree.pdir_name = pdir_name; + Ast_410.Parsetree.pdir_arg = pdir_arg; + Ast_410.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_411.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_411.Parsetree.pdir_arg = + (Option.map copy_directive_argument pdir_arg); + Ast_411.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_410.Parsetree.directive_argument -> + Ast_411.Parsetree.directive_argument + = + fun + { Ast_410.Parsetree.pdira_desc = pdira_desc; + Ast_410.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_411.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_411.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_410.Parsetree.directive_argument_desc -> + Ast_411.Parsetree.directive_argument_desc + = + function + | Ast_410.Parsetree.Pdir_string x0 -> Ast_411.Parsetree.Pdir_string x0 + | Ast_410.Parsetree.Pdir_int (x0, x1) -> + Ast_411.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) + | Ast_410.Parsetree.Pdir_ident x0 -> + Ast_411.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_410.Parsetree.Pdir_bool x0 -> Ast_411.Parsetree.Pdir_bool x0 +and copy_expression : + Ast_410.Parsetree.expression -> Ast_411.Parsetree.expression = + fun + { Ast_410.Parsetree.pexp_desc = pexp_desc; + Ast_410.Parsetree.pexp_loc = pexp_loc; + Ast_410.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_410.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_411.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_411.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_411.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); + Ast_411.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expr x = copy_expression x +and copy_expression_desc : + Ast_410.Parsetree.expression_desc -> Ast_411.Parsetree.expression_desc = + function + | Ast_410.Parsetree.Pexp_ident x0 -> + Ast_411.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pexp_constant x0 -> + Ast_411.Parsetree.Pexp_constant (copy_constant x0) + | Ast_410.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_411.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_410.Parsetree.Pexp_function x0 -> + Ast_411.Parsetree.Pexp_function (List.map copy_case x0) + | Ast_410.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_411.Parsetree.Pexp_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_410.Parsetree.Pexp_apply (x0, x1) -> + Ast_411.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_410.Parsetree.Pexp_match (x0, x1) -> + Ast_411.Parsetree.Pexp_match + ((copy_expression x0), (List.map copy_case x1)) + | Ast_410.Parsetree.Pexp_try (x0, x1) -> + Ast_411.Parsetree.Pexp_try + ((copy_expression x0), (List.map copy_case x1)) + | Ast_410.Parsetree.Pexp_tuple x0 -> + Ast_411.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_410.Parsetree.Pexp_construct (x0, x1) -> + Ast_411.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) + | Ast_410.Parsetree.Pexp_variant (x0, x1) -> + Ast_411.Parsetree.Pexp_variant + ((copy_label x0), (Option.map copy_expression x1)) + | Ast_410.Parsetree.Pexp_record (x0, x1) -> + Ast_411.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_410.Parsetree.Pexp_field (x0, x1) -> + Ast_411.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_410.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_411.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_410.Parsetree.Pexp_array x0 -> + Ast_411.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_410.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_411.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (Option.map copy_expression x2)) + | Ast_410.Parsetree.Pexp_sequence (x0, x1) -> + Ast_411.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_while (x0, x1) -> + Ast_411.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_411.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_410.Parsetree.Pexp_constraint (x0, x1) -> + Ast_411.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_410.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_411.Parsetree.Pexp_coerce + ((copy_expression x0), (Option.map copy_core_type x1), + (copy_core_type x2)) + | Ast_410.Parsetree.Pexp_send (x0, x1) -> + Ast_411.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_410.Parsetree.Pexp_new x0 -> + Ast_411.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_411.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_override x0 -> + Ast_411.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_410.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_411.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), + (copy_module_expr x1), (copy_expression x2)) + | Ast_410.Parsetree.Pexp_letexception (x0, x1) -> + Ast_411.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_assert x0 -> + Ast_411.Parsetree.Pexp_assert (copy_expression x0) + | Ast_410.Parsetree.Pexp_lazy x0 -> + Ast_411.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_410.Parsetree.Pexp_poly (x0, x1) -> + Ast_411.Parsetree.Pexp_poly + ((copy_expression x0), (Option.map copy_core_type x1)) + | Ast_410.Parsetree.Pexp_object x0 -> + Ast_411.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_410.Parsetree.Pexp_newtype (x0, x1) -> + Ast_411.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_pack x0 -> + Ast_411.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_410.Parsetree.Pexp_open (x0, x1) -> + Ast_411.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_410.Parsetree.Pexp_letop x0 -> + Ast_411.Parsetree.Pexp_letop (copy_letop x0) + | Ast_410.Parsetree.Pexp_extension x0 -> + Ast_411.Parsetree.Pexp_extension (copy_extension x0) + | Ast_410.Parsetree.Pexp_unreachable -> Ast_411.Parsetree.Pexp_unreachable +and copy_letop : Ast_410.Parsetree.letop -> Ast_411.Parsetree.letop = + fun + { Ast_410.Parsetree.let_ = let_; Ast_410.Parsetree.ands = ands; + Ast_410.Parsetree.body = body } + -> + { + Ast_411.Parsetree.let_ = (copy_binding_op let_); + Ast_411.Parsetree.ands = (List.map copy_binding_op ands); + Ast_411.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_410.Parsetree.binding_op -> Ast_411.Parsetree.binding_op = + fun + { Ast_410.Parsetree.pbop_op = pbop_op; + Ast_410.Parsetree.pbop_pat = pbop_pat; + Ast_410.Parsetree.pbop_exp = pbop_exp; + Ast_410.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_411.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_411.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_411.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_411.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_410.Asttypes.direction_flag -> Ast_411.Asttypes.direction_flag = + function + | Ast_410.Asttypes.Upto -> Ast_411.Asttypes.Upto + | Ast_410.Asttypes.Downto -> Ast_411.Asttypes.Downto +and copy_case : Ast_410.Parsetree.case -> Ast_411.Parsetree.case = + fun + { Ast_410.Parsetree.pc_lhs = pc_lhs; + Ast_410.Parsetree.pc_guard = pc_guard; + Ast_410.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_411.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_411.Parsetree.pc_guard = (Option.map copy_expression pc_guard); + Ast_411.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_cases : Ast_410.Parsetree.case list -> Ast_411.Parsetree.case list = + fun x -> List.map copy_case x +and copy_value_binding : + Ast_410.Parsetree.value_binding -> Ast_411.Parsetree.value_binding = + fun + { Ast_410.Parsetree.pvb_pat = pvb_pat; + Ast_410.Parsetree.pvb_expr = pvb_expr; + Ast_410.Parsetree.pvb_attributes = pvb_attributes; + Ast_410.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_411.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_411.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_411.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_411.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_410.Parsetree.pattern -> Ast_411.Parsetree.pattern = + fun + { Ast_410.Parsetree.ppat_desc = ppat_desc; + Ast_410.Parsetree.ppat_loc = ppat_loc; + Ast_410.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_410.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_411.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_411.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_411.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); + Ast_411.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pat x = copy_pattern x +and copy_pattern_desc : + Ast_410.Parsetree.pattern_desc -> Ast_411.Parsetree.pattern_desc = + function + | Ast_410.Parsetree.Ppat_any -> Ast_411.Parsetree.Ppat_any + | Ast_410.Parsetree.Ppat_var x0 -> + Ast_411.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_410.Parsetree.Ppat_alias (x0, x1) -> + Ast_411.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_410.Parsetree.Ppat_constant x0 -> + Ast_411.Parsetree.Ppat_constant (copy_constant x0) + | Ast_410.Parsetree.Ppat_interval (x0, x1) -> + Ast_411.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_410.Parsetree.Ppat_tuple x0 -> + Ast_411.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_410.Parsetree.Ppat_construct (x0, x1) -> + Ast_411.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) + | Ast_410.Parsetree.Ppat_variant (x0, x1) -> + Ast_411.Parsetree.Ppat_variant + ((copy_label x0), (Option.map copy_pattern x1)) + | Ast_410.Parsetree.Ppat_record (x0, x1) -> + Ast_411.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_410.Parsetree.Ppat_array x0 -> + Ast_411.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_410.Parsetree.Ppat_or (x0, x1) -> + Ast_411.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_410.Parsetree.Ppat_constraint (x0, x1) -> + Ast_411.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_410.Parsetree.Ppat_type x0 -> + Ast_411.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Ppat_lazy x0 -> + Ast_411.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_410.Parsetree.Ppat_unpack x0 -> + Ast_411.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_410.Parsetree.Ppat_exception x0 -> + Ast_411.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_410.Parsetree.Ppat_extension x0 -> + Ast_411.Parsetree.Ppat_extension (copy_extension x0) + | Ast_410.Parsetree.Ppat_open (x0, x1) -> + Ast_411.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_410.Parsetree.core_type -> Ast_411.Parsetree.core_type = + fun + { Ast_410.Parsetree.ptyp_desc = ptyp_desc; + Ast_410.Parsetree.ptyp_loc = ptyp_loc; + Ast_410.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_410.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_411.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_411.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_411.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); + Ast_411.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_typ x = copy_core_type x +and copy_location_stack : + Ast_410.Parsetree.location_stack -> Ast_411.Parsetree.location_stack = + fun x -> List.map copy_location x +and copy_core_type_desc : + Ast_410.Parsetree.core_type_desc -> Ast_411.Parsetree.core_type_desc = + function + | Ast_410.Parsetree.Ptyp_any -> Ast_411.Parsetree.Ptyp_any + | Ast_410.Parsetree.Ptyp_var x0 -> Ast_411.Parsetree.Ptyp_var x0 + | Ast_410.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_411.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_410.Parsetree.Ptyp_tuple x0 -> + Ast_411.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_410.Parsetree.Ptyp_constr (x0, x1) -> + Ast_411.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_object (x0, x1) -> + Ast_411.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_410.Parsetree.Ptyp_class (x0, x1) -> + Ast_411.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_alias (x0, x1) -> + Ast_411.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_410.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_411.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (Option.map (fun x -> List.map copy_label x) x2)) + | Ast_410.Parsetree.Ptyp_poly (x0, x1) -> + Ast_411.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_410.Parsetree.Ptyp_package x0 -> + Ast_411.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_410.Parsetree.Ptyp_extension x0 -> + Ast_411.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_410.Parsetree.package_type -> Ast_411.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_410.Parsetree.row_field -> Ast_411.Parsetree.row_field = + fun + { Ast_410.Parsetree.prf_desc = prf_desc; + Ast_410.Parsetree.prf_loc = prf_loc; + Ast_410.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_411.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_411.Parsetree.prf_loc = (copy_location prf_loc); + Ast_411.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_410.Parsetree.row_field_desc -> Ast_411.Parsetree.row_field_desc = + function + | Ast_410.Parsetree.Rtag (x0, x1, x2) -> + Ast_411.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_410.Parsetree.Rinherit x0 -> + Ast_411.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_410.Parsetree.object_field -> Ast_411.Parsetree.object_field = + fun + { Ast_410.Parsetree.pof_desc = pof_desc; + Ast_410.Parsetree.pof_loc = pof_loc; + Ast_410.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_411.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_411.Parsetree.pof_loc = (copy_location pof_loc); + Ast_411.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_410.Parsetree.attributes -> Ast_411.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_410.Parsetree.attribute -> Ast_411.Parsetree.attribute = + fun + { Ast_410.Parsetree.attr_name = attr_name; + Ast_410.Parsetree.attr_payload = attr_payload; + Ast_410.Parsetree.attr_loc = attr_loc } + -> + { + Ast_411.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_411.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_411.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_410.Parsetree.payload -> Ast_411.Parsetree.payload = + function + | Ast_410.Parsetree.PStr x0 -> Ast_411.Parsetree.PStr (copy_structure x0) + | Ast_410.Parsetree.PSig x0 -> Ast_411.Parsetree.PSig (copy_signature x0) + | Ast_410.Parsetree.PTyp x0 -> Ast_411.Parsetree.PTyp (copy_core_type x0) + | Ast_410.Parsetree.PPat (x0, x1) -> + Ast_411.Parsetree.PPat + ((copy_pattern x0), (Option.map copy_expression x1)) +and copy_structure : + Ast_410.Parsetree.structure -> Ast_411.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_410.Parsetree.structure_item -> Ast_411.Parsetree.structure_item = + fun + { Ast_410.Parsetree.pstr_desc = pstr_desc; + Ast_410.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_411.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_411.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_410.Parsetree.structure_item_desc -> + Ast_411.Parsetree.structure_item_desc + = + function + | Ast_410.Parsetree.Pstr_eval (x0, x1) -> + Ast_411.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_410.Parsetree.Pstr_value (x0, x1) -> + Ast_411.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_410.Parsetree.Pstr_primitive x0 -> + Ast_411.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_410.Parsetree.Pstr_type (x0, x1) -> + Ast_411.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_410.Parsetree.Pstr_typext x0 -> + Ast_411.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_410.Parsetree.Pstr_exception x0 -> + Ast_411.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_410.Parsetree.Pstr_module x0 -> + Ast_411.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_410.Parsetree.Pstr_recmodule x0 -> + Ast_411.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_410.Parsetree.Pstr_modtype x0 -> + Ast_411.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_410.Parsetree.Pstr_open x0 -> + Ast_411.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_410.Parsetree.Pstr_class x0 -> + Ast_411.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_410.Parsetree.Pstr_class_type x0 -> + Ast_411.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_410.Parsetree.Pstr_include x0 -> + Ast_411.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_410.Parsetree.Pstr_attribute x0 -> + Ast_411.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pstr_extension (x0, x1) -> + Ast_411.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_410.Parsetree.include_declaration -> + Ast_411.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_410.Parsetree.class_declaration -> Ast_411.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_410.Parsetree.class_expr -> Ast_411.Parsetree.class_expr = + fun + { Ast_410.Parsetree.pcl_desc = pcl_desc; + Ast_410.Parsetree.pcl_loc = pcl_loc; + Ast_410.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_411.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_411.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_411.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_410.Parsetree.class_expr_desc -> Ast_411.Parsetree.class_expr_desc = + function + | Ast_410.Parsetree.Pcl_constr (x0, x1) -> + Ast_411.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Pcl_structure x0 -> + Ast_411.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_410.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_411.Parsetree.Pcl_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_410.Parsetree.Pcl_apply (x0, x1) -> + Ast_411.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_410.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_411.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_410.Parsetree.Pcl_constraint (x0, x1) -> + Ast_411.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_410.Parsetree.Pcl_extension x0 -> + Ast_411.Parsetree.Pcl_extension (copy_extension x0) + | Ast_410.Parsetree.Pcl_open (x0, x1) -> + Ast_411.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_410.Parsetree.class_structure -> Ast_411.Parsetree.class_structure = + fun + { Ast_410.Parsetree.pcstr_self = pcstr_self; + Ast_410.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_411.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_411.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_410.Parsetree.class_field -> Ast_411.Parsetree.class_field = + fun + { Ast_410.Parsetree.pcf_desc = pcf_desc; + Ast_410.Parsetree.pcf_loc = pcf_loc; + Ast_410.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_411.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_411.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_411.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_410.Parsetree.class_field_desc -> Ast_411.Parsetree.class_field_desc = + function + | Ast_410.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_411.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_410.Parsetree.Pcf_val x0 -> + Ast_411.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_410.Parsetree.Pcf_method x0 -> + Ast_411.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_410.Parsetree.Pcf_constraint x0 -> + Ast_411.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_410.Parsetree.Pcf_initializer x0 -> + Ast_411.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_410.Parsetree.Pcf_attribute x0 -> + Ast_411.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pcf_extension x0 -> + Ast_411.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_410.Parsetree.class_field_kind -> Ast_411.Parsetree.class_field_kind = + function + | Ast_410.Parsetree.Cfk_virtual x0 -> + Ast_411.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_410.Parsetree.Cfk_concrete (x0, x1) -> + Ast_411.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_410.Parsetree.open_declaration -> Ast_411.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_410.Parsetree.module_binding -> Ast_411.Parsetree.module_binding = + fun + { Ast_410.Parsetree.pmb_name = pmb_name; + Ast_410.Parsetree.pmb_expr = pmb_expr; + Ast_410.Parsetree.pmb_attributes = pmb_attributes; + Ast_410.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_411.Parsetree.pmb_name = + (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); + Ast_411.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_411.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_411.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_410.Parsetree.module_expr -> Ast_411.Parsetree.module_expr = + fun + { Ast_410.Parsetree.pmod_desc = pmod_desc; + Ast_410.Parsetree.pmod_loc = pmod_loc; + Ast_410.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_411.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_411.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_411.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_410.Parsetree.module_expr_desc -> Ast_411.Parsetree.module_expr_desc = + function + | Ast_410.Parsetree.Pmod_ident x0 -> + Ast_411.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pmod_structure x0 -> + Ast_411.Parsetree.Pmod_structure (copy_structure x0) + | Ast_410.Parsetree.Pmod_functor (x0, x1) -> + Ast_411.Parsetree.Pmod_functor + ((copy_functor_parameter x0), (copy_module_expr x1)) + | Ast_410.Parsetree.Pmod_apply (x0, x1) -> + Ast_411.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_410.Parsetree.Pmod_constraint (x0, x1) -> + Ast_411.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_410.Parsetree.Pmod_unpack x0 -> + Ast_411.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_410.Parsetree.Pmod_extension x0 -> + Ast_411.Parsetree.Pmod_extension (copy_extension x0) +and copy_functor_parameter : + Ast_410.Parsetree.functor_parameter -> Ast_411.Parsetree.functor_parameter + = + function + | Ast_410.Parsetree.Unit -> Ast_411.Parsetree.Unit + | Ast_410.Parsetree.Named (x0, x1) -> + Ast_411.Parsetree.Named + ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), + (copy_module_type x1)) +and copy_module_type : + Ast_410.Parsetree.module_type -> Ast_411.Parsetree.module_type = + fun + { Ast_410.Parsetree.pmty_desc = pmty_desc; + Ast_410.Parsetree.pmty_loc = pmty_loc; + Ast_410.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_411.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_411.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_411.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_410.Parsetree.module_type_desc -> Ast_411.Parsetree.module_type_desc = + function + | Ast_410.Parsetree.Pmty_ident x0 -> + Ast_411.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_410.Parsetree.Pmty_signature x0 -> + Ast_411.Parsetree.Pmty_signature (copy_signature x0) + | Ast_410.Parsetree.Pmty_functor (x0, x1) -> + Ast_411.Parsetree.Pmty_functor + ((copy_functor_parameter x0), (copy_module_type x1)) + | Ast_410.Parsetree.Pmty_with (x0, x1) -> + Ast_411.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_410.Parsetree.Pmty_typeof x0 -> + Ast_411.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_410.Parsetree.Pmty_extension x0 -> + Ast_411.Parsetree.Pmty_extension (copy_extension x0) + | Ast_410.Parsetree.Pmty_alias x0 -> + Ast_411.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_410.Parsetree.with_constraint -> Ast_411.Parsetree.with_constraint = + function + | Ast_410.Parsetree.Pwith_type (x0, x1) -> + Ast_411.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_410.Parsetree.Pwith_module (x0, x1) -> + Ast_411.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_410.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_411.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_410.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_411.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_410.Parsetree.signature -> Ast_411.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_410.Parsetree.signature_item -> Ast_411.Parsetree.signature_item = + fun + { Ast_410.Parsetree.psig_desc = psig_desc; + Ast_410.Parsetree.psig_loc = psig_loc } + -> + { + Ast_411.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_411.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_410.Parsetree.signature_item_desc -> + Ast_411.Parsetree.signature_item_desc + = + function + | Ast_410.Parsetree.Psig_value x0 -> + Ast_411.Parsetree.Psig_value (copy_value_description x0) + | Ast_410.Parsetree.Psig_type (x0, x1) -> + Ast_411.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_410.Parsetree.Psig_typesubst x0 -> + Ast_411.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_410.Parsetree.Psig_typext x0 -> + Ast_411.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_410.Parsetree.Psig_exception x0 -> + Ast_411.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_410.Parsetree.Psig_module x0 -> + Ast_411.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_410.Parsetree.Psig_modsubst x0 -> + Ast_411.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_410.Parsetree.Psig_recmodule x0 -> + Ast_411.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_410.Parsetree.Psig_modtype x0 -> + Ast_411.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_410.Parsetree.Psig_open x0 -> + Ast_411.Parsetree.Psig_open (copy_open_description x0) + | Ast_410.Parsetree.Psig_include x0 -> + Ast_411.Parsetree.Psig_include (copy_include_description x0) + | Ast_410.Parsetree.Psig_class x0 -> + Ast_411.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_410.Parsetree.Psig_class_type x0 -> + Ast_411.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_410.Parsetree.Psig_attribute x0 -> + Ast_411.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_410.Parsetree.Psig_extension (x0, x1) -> + Ast_411.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_410.Parsetree.class_type_declaration -> + Ast_411.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_410.Parsetree.class_description -> Ast_411.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_410.Parsetree.class_type -> Ast_411.Parsetree.class_type = + fun + { Ast_410.Parsetree.pcty_desc = pcty_desc; + Ast_410.Parsetree.pcty_loc = pcty_loc; + Ast_410.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_411.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_411.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_411.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_410.Parsetree.class_type_desc -> Ast_411.Parsetree.class_type_desc = + function + | Ast_410.Parsetree.Pcty_constr (x0, x1) -> + Ast_411.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_410.Parsetree.Pcty_signature x0 -> + Ast_411.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_410.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_411.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_410.Parsetree.Pcty_extension x0 -> + Ast_411.Parsetree.Pcty_extension (copy_extension x0) + | Ast_410.Parsetree.Pcty_open (x0, x1) -> + Ast_411.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_410.Parsetree.class_signature -> Ast_411.Parsetree.class_signature = + fun + { Ast_410.Parsetree.pcsig_self = pcsig_self; + Ast_410.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_411.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_411.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_410.Parsetree.class_type_field -> Ast_411.Parsetree.class_type_field = + fun + { Ast_410.Parsetree.pctf_desc = pctf_desc; + Ast_410.Parsetree.pctf_loc = pctf_loc; + Ast_410.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_411.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_411.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_411.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_410.Parsetree.class_type_field_desc -> + Ast_411.Parsetree.class_type_field_desc + = + function + | Ast_410.Parsetree.Pctf_inherit x0 -> + Ast_411.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_410.Parsetree.Pctf_val x0 -> + Ast_411.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_410.Parsetree.Pctf_method x0 -> + Ast_411.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_410.Parsetree.Pctf_constraint x0 -> + Ast_411.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_410.Parsetree.Pctf_attribute x0 -> + Ast_411.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_410.Parsetree.Pctf_extension x0 -> + Ast_411.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_410.Parsetree.extension -> Ast_411.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_410.Parsetree.class_infos -> 'g0 Ast_411.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.pci_virt = pci_virt; + Ast_410.Parsetree.pci_params = pci_params; + Ast_410.Parsetree.pci_name = pci_name; + Ast_410.Parsetree.pci_expr = pci_expr; + Ast_410.Parsetree.pci_loc = pci_loc; + Ast_410.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_411.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_411.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_411.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_411.Parsetree.pci_expr = (f0 pci_expr); + Ast_411.Parsetree.pci_loc = (copy_location pci_loc); + Ast_411.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_410.Asttypes.virtual_flag -> Ast_411.Asttypes.virtual_flag = + function + | Ast_410.Asttypes.Virtual -> Ast_411.Asttypes.Virtual + | Ast_410.Asttypes.Concrete -> Ast_411.Asttypes.Concrete +and copy_include_description : + Ast_410.Parsetree.include_description -> + Ast_411.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_410.Parsetree.include_infos -> + 'g0 Ast_411.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.pincl_mod = pincl_mod; + Ast_410.Parsetree.pincl_loc = pincl_loc; + Ast_410.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_411.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_411.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_411.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_410.Parsetree.open_description -> Ast_411.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_410.Parsetree.open_infos -> 'g0 Ast_411.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_410.Parsetree.popen_expr = popen_expr; + Ast_410.Parsetree.popen_override = popen_override; + Ast_410.Parsetree.popen_loc = popen_loc; + Ast_410.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_411.Parsetree.popen_expr = (f0 popen_expr); + Ast_411.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_411.Parsetree.popen_loc = (copy_location popen_loc); + Ast_411.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_410.Asttypes.override_flag -> Ast_411.Asttypes.override_flag = + function + | Ast_410.Asttypes.Override -> Ast_411.Asttypes.Override + | Ast_410.Asttypes.Fresh -> Ast_411.Asttypes.Fresh +and copy_module_type_declaration : + Ast_410.Parsetree.module_type_declaration -> + Ast_411.Parsetree.module_type_declaration + = + fun + { Ast_410.Parsetree.pmtd_name = pmtd_name; + Ast_410.Parsetree.pmtd_type = pmtd_type; + Ast_410.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_410.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_411.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_411.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); + Ast_411.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_411.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_410.Parsetree.module_substitution -> + Ast_411.Parsetree.module_substitution + = + fun + { Ast_410.Parsetree.pms_name = pms_name; + Ast_410.Parsetree.pms_manifest = pms_manifest; + Ast_410.Parsetree.pms_attributes = pms_attributes; + Ast_410.Parsetree.pms_loc = pms_loc } + -> + { + Ast_411.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_411.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_411.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_411.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_410.Parsetree.module_declaration -> + Ast_411.Parsetree.module_declaration + = + fun + { Ast_410.Parsetree.pmd_name = pmd_name; + Ast_410.Parsetree.pmd_type = pmd_type; + Ast_410.Parsetree.pmd_attributes = pmd_attributes; + Ast_410.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_411.Parsetree.pmd_name = + (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); + Ast_411.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_411.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_411.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_410.Parsetree.type_exception -> Ast_411.Parsetree.type_exception = + fun + { Ast_410.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_410.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_410.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_411.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_411.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_411.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_410.Parsetree.type_extension -> Ast_411.Parsetree.type_extension = + fun + { Ast_410.Parsetree.ptyext_path = ptyext_path; + Ast_410.Parsetree.ptyext_params = ptyext_params; + Ast_410.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_410.Parsetree.ptyext_private = ptyext_private; + Ast_410.Parsetree.ptyext_loc = ptyext_loc; + Ast_410.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_411.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_411.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_411.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_411.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_411.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_411.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_410.Parsetree.extension_constructor -> + Ast_411.Parsetree.extension_constructor + = + fun + { Ast_410.Parsetree.pext_name = pext_name; + Ast_410.Parsetree.pext_kind = pext_kind; + Ast_410.Parsetree.pext_loc = pext_loc; + Ast_410.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_411.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_411.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_411.Parsetree.pext_loc = (copy_location pext_loc); + Ast_411.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_410.Parsetree.extension_constructor_kind -> + Ast_411.Parsetree.extension_constructor_kind + = + function + | Ast_410.Parsetree.Pext_decl (x0, x1) -> + Ast_411.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) + | Ast_410.Parsetree.Pext_rebind x0 -> + Ast_411.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_410.Parsetree.type_declaration -> Ast_411.Parsetree.type_declaration = + fun + { Ast_410.Parsetree.ptype_name = ptype_name; + Ast_410.Parsetree.ptype_params = ptype_params; + Ast_410.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_410.Parsetree.ptype_kind = ptype_kind; + Ast_410.Parsetree.ptype_private = ptype_private; + Ast_410.Parsetree.ptype_manifest = ptype_manifest; + Ast_410.Parsetree.ptype_attributes = ptype_attributes; + Ast_410.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_411.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_411.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_411.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_411.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_411.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_411.Parsetree.ptype_manifest = + (Option.map copy_core_type ptype_manifest); + Ast_411.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_411.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_410.Asttypes.private_flag -> Ast_411.Asttypes.private_flag = + function + | Ast_410.Asttypes.Private -> Ast_411.Asttypes.Private + | Ast_410.Asttypes.Public -> Ast_411.Asttypes.Public +and copy_type_kind : + Ast_410.Parsetree.type_kind -> Ast_411.Parsetree.type_kind = + function + | Ast_410.Parsetree.Ptype_abstract -> Ast_411.Parsetree.Ptype_abstract + | Ast_410.Parsetree.Ptype_variant x0 -> + Ast_411.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_410.Parsetree.Ptype_record x0 -> + Ast_411.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_410.Parsetree.Ptype_open -> Ast_411.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_410.Parsetree.constructor_declaration -> + Ast_411.Parsetree.constructor_declaration + = + fun + { Ast_410.Parsetree.pcd_name = pcd_name; + Ast_410.Parsetree.pcd_args = pcd_args; + Ast_410.Parsetree.pcd_res = pcd_res; + Ast_410.Parsetree.pcd_loc = pcd_loc; + Ast_410.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_411.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_411.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_411.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); + Ast_411.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_411.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_410.Parsetree.constructor_arguments -> + Ast_411.Parsetree.constructor_arguments + = + function + | Ast_410.Parsetree.Pcstr_tuple x0 -> + Ast_411.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_410.Parsetree.Pcstr_record x0 -> + Ast_411.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_410.Parsetree.label_declaration -> Ast_411.Parsetree.label_declaration + = + fun + { Ast_410.Parsetree.pld_name = pld_name; + Ast_410.Parsetree.pld_mutable = pld_mutable; + Ast_410.Parsetree.pld_type = pld_type; + Ast_410.Parsetree.pld_loc = pld_loc; + Ast_410.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_411.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_411.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_411.Parsetree.pld_type = (copy_core_type pld_type); + Ast_411.Parsetree.pld_loc = (copy_location pld_loc); + Ast_411.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_410.Asttypes.mutable_flag -> Ast_411.Asttypes.mutable_flag = + function + | Ast_410.Asttypes.Immutable -> Ast_411.Asttypes.Immutable + | Ast_410.Asttypes.Mutable -> Ast_411.Asttypes.Mutable +and copy_variance : Ast_410.Asttypes.variance -> Ast_411.Asttypes.variance = + function + | Ast_410.Asttypes.Covariant -> Ast_411.Asttypes.Covariant + | Ast_410.Asttypes.Contravariant -> Ast_411.Asttypes.Contravariant + | Ast_410.Asttypes.Invariant -> Ast_411.Asttypes.Invariant +and copy_value_description : + Ast_410.Parsetree.value_description -> Ast_411.Parsetree.value_description + = + fun + { Ast_410.Parsetree.pval_name = pval_name; + Ast_410.Parsetree.pval_type = pval_type; + Ast_410.Parsetree.pval_prim = pval_prim; + Ast_410.Parsetree.pval_attributes = pval_attributes; + Ast_410.Parsetree.pval_loc = pval_loc } + -> + { + Ast_411.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_411.Parsetree.pval_type = (copy_core_type pval_type); + Ast_411.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_411.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_411.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_410.Parsetree.object_field_desc -> Ast_411.Parsetree.object_field_desc + = + function + | Ast_410.Parsetree.Otag (x0, x1) -> + Ast_411.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_410.Parsetree.Oinherit x0 -> + Ast_411.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_410.Asttypes.arg_label -> Ast_411.Asttypes.arg_label + = + function + | Ast_410.Asttypes.Nolabel -> Ast_411.Asttypes.Nolabel + | Ast_410.Asttypes.Labelled x0 -> Ast_411.Asttypes.Labelled x0 + | Ast_410.Asttypes.Optional x0 -> Ast_411.Asttypes.Optional x0 +and copy_closed_flag : + Ast_410.Asttypes.closed_flag -> Ast_411.Asttypes.closed_flag = + function + | Ast_410.Asttypes.Closed -> Ast_411.Asttypes.Closed + | Ast_410.Asttypes.Open -> Ast_411.Asttypes.Open +and copy_label : Ast_410.Asttypes.label -> Ast_411.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_410.Asttypes.rec_flag -> Ast_411.Asttypes.rec_flag = + function + | Ast_410.Asttypes.Nonrecursive -> Ast_411.Asttypes.Nonrecursive + | Ast_410.Asttypes.Recursive -> Ast_411.Asttypes.Recursive +and copy_constant : Ast_410.Parsetree.constant -> Ast_411.Parsetree.constant + = + function + | Ast_410.Parsetree.Pconst_integer (x0, x1) -> + Ast_411.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) + | Ast_410.Parsetree.Pconst_char x0 -> Ast_411.Parsetree.Pconst_char x0 + | Ast_410.Parsetree.Pconst_string (x0, x1) -> + Ast_411.Parsetree.Pconst_string (x0, Location.none, (Option.map (fun x -> x) x1)) + | Ast_410.Parsetree.Pconst_float (x0, x1) -> + Ast_411.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) +and copy_Longident_t : Ast_410.Longident.t -> Ast_411.Longident.t = + function + | Ast_410.Longident.Lident x0 -> Ast_411.Longident.Lident x0 + | Ast_410.Longident.Ldot (x0, x1) -> + Ast_411.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_410.Longident.Lapply (x0, x1) -> + Ast_411.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_410.Asttypes.loc -> 'g0 Ast_411.Asttypes.loc + = + fun f0 -> + fun { Ast_410.Asttypes.txt = txt; Ast_410.Asttypes.loc = loc } -> + { + Ast_411.Asttypes.txt = (f0 txt); + Ast_411.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_410.Location.t -> Ast_411.Location.t = + fun + { Ast_410.Location.loc_start = loc_start; + Ast_410.Location.loc_end = loc_end; + Ast_410.Location.loc_ghost = loc_ghost } + -> + { + Ast_411.Location.loc_start = (copy_position loc_start); + Ast_411.Location.loc_end = (copy_position loc_end); + Ast_411.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410.ml new file mode 100644 index 000000000..b5fb04099 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410.ml @@ -0,0 +1,142 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +include Migrate_parsetree_411_410_migrate + +(*$ open Printf + let fields = [ + "attribute"; "attributes"; "case"; "cases"; "class_declaration"; + "class_description"; "class_expr"; "class_field"; "class_signature"; + "class_structure"; "class_type"; "class_type_declaration"; + "class_type_field"; "constructor_declaration"; "expr"; "extension"; + "extension_constructor"; "include_declaration"; "include_description"; + "label_declaration"; "location"; "module_binding"; "module_declaration"; + "module_expr"; "module_type"; "module_type_declaration"; + "open_description"; "pat"; "signature"; "signature_item"; "structure"; + "structure_item"; "typ"; "type_declaration"; "type_extension"; + "type_kind"; "value_binding"; "value_description"; + "with_constraint"; "payload"; + "binding_op"; "module_substitution"; "open_declaration"; "type_exception" + ] + let foreach_field f = + printf "\n"; + List.iter f fields +*)(*$*) + +let copy_mapper = fun + ({ From.Ast_mapper. + (*$ foreach_field (printf "%s;\n")*) + attribute; + attributes; + case; + cases; + class_declaration; + class_description; + class_expr; + class_field; + class_signature; + class_structure; + class_type; + class_type_declaration; + class_type_field; + constructor_declaration; + expr; + extension; + extension_constructor; + include_declaration; + include_description; + label_declaration; + location; + module_binding; + module_declaration; + module_expr; + module_type; + module_type_declaration; + open_description; + pat; + signature; + signature_item; + structure; + structure_item; + typ; + type_declaration; + type_extension; + type_kind; + value_binding; + value_description; + with_constraint; + payload; + binding_op; + module_substitution; + open_declaration; + type_exception; + constant; + (*$*) + } as mapper) -> + let _ = constant in + let module Def = Migrate_parsetree_def in + let module R = Migrate_parsetree_410_411_migrate in + { + To.Ast_mapper. + (*$ foreach_field (fun s -> + printf + "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) + *) + attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); + attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); + case = (fun _ x -> copy_case (case mapper (R.copy_case x))); + cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); + class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); + class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); + class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); + class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); + class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); + class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); + class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); + class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); + class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); + constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); + expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); + extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); + extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); + include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); + include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); + label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); + location = (fun _ x -> copy_location (location mapper (R.copy_location x))); + module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); + module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); + module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); + module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); + module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); + open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); + pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); + signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); + signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); + structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); + structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); + typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); + type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); + type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); + type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); + value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); + value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); + with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); + payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); + binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); + module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); + open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); + type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); + (*$*) + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410_migrate.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410_migrate.ml new file mode 100644 index 000000000..b0687a92f --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_411_410_migrate.ml @@ -0,0 +1,1523 @@ +open Stdlib0 +module From = Ast_411 +module To = Ast_410 +let rec copy_out_type_extension : + Ast_411.Outcometree.out_type_extension -> + Ast_410.Outcometree.out_type_extension + = + fun + { Ast_411.Outcometree.otyext_name = otyext_name; + Ast_411.Outcometree.otyext_params = otyext_params; + Ast_411.Outcometree.otyext_constructors = otyext_constructors; + Ast_411.Outcometree.otyext_private = otyext_private } + -> + { + Ast_410.Outcometree.otyext_name = otyext_name; + Ast_410.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_410.Outcometree.otyext_constructors = + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_410.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_411.Outcometree.out_phrase -> Ast_410.Outcometree.out_phrase = + function + | Ast_411.Outcometree.Ophr_eval (x0, x1) -> + Ast_410.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_411.Outcometree.Ophr_signature x0 -> + Ast_410.Outcometree.Ophr_signature + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_411.Outcometree.Ophr_exception x0 -> + Ast_410.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_411.Outcometree.out_sig_item -> Ast_410.Outcometree.out_sig_item = + function + | Ast_411.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_410.Outcometree.Osig_class + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_411.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_410.Outcometree.Osig_class_type + (x0, x1, + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), + (copy_out_class_type x3), (copy_out_rec_status x4)) + | Ast_411.Outcometree.Osig_typext (x0, x1) -> + Ast_410.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_411.Outcometree.Osig_modtype (x0, x1) -> + Ast_410.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_411.Outcometree.Osig_module (x0, x1, x2) -> + Ast_410.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_411.Outcometree.Osig_type (x0, x1) -> + Ast_410.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_411.Outcometree.Osig_value x0 -> + Ast_410.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_411.Outcometree.Osig_ellipsis -> Ast_410.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_411.Outcometree.out_val_decl -> Ast_410.Outcometree.out_val_decl = + fun + { Ast_411.Outcometree.oval_name = oval_name; + Ast_411.Outcometree.oval_type = oval_type; + Ast_411.Outcometree.oval_prims = oval_prims; + Ast_411.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_410.Outcometree.oval_name = oval_name; + Ast_410.Outcometree.oval_type = (copy_out_type oval_type); + Ast_410.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_410.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_411.Outcometree.out_type_decl -> Ast_410.Outcometree.out_type_decl = + fun + { Ast_411.Outcometree.otype_name = otype_name; + Ast_411.Outcometree.otype_params = otype_params; + Ast_411.Outcometree.otype_type = otype_type; + Ast_411.Outcometree.otype_private = otype_private; + Ast_411.Outcometree.otype_immediate = otype_immediate; + Ast_411.Outcometree.otype_unboxed = otype_unboxed; + Ast_411.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_410.Outcometree.otype_name = otype_name; + Ast_410.Outcometree.otype_params = + (List.map + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) + otype_params); + Ast_410.Outcometree.otype_type = (copy_out_type otype_type); + Ast_410.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_410.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_410.Outcometree.otype_unboxed = otype_unboxed; + Ast_410.Outcometree.otype_cstrs = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) + otype_cstrs) + } +and copy_Type_immediacy_t : + Ast_411.Type_immediacy.t -> Ast_410.Type_immediacy.t = + function + | Ast_411.Type_immediacy.Unknown -> Ast_410.Type_immediacy.Unknown + | Ast_411.Type_immediacy.Always -> Ast_410.Type_immediacy.Always + | Ast_411.Type_immediacy.Always_on_64bits -> + Ast_410.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_411.Outcometree.out_module_type -> Ast_410.Outcometree.out_module_type + = + function + | Ast_411.Outcometree.Omty_abstract -> Ast_410.Outcometree.Omty_abstract + | Ast_411.Outcometree.Omty_functor (x0, x1) -> + Ast_410.Outcometree.Omty_functor + ((Option.map + (fun x -> + let (x0, x1) = x in + ((Option.map (fun x -> x) x0), (copy_out_module_type x1))) x0), + (copy_out_module_type x1)) + | Ast_411.Outcometree.Omty_ident x0 -> + Ast_410.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_411.Outcometree.Omty_signature x0 -> + Ast_410.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_411.Outcometree.Omty_alias x0 -> + Ast_410.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_411.Outcometree.out_ext_status -> Ast_410.Outcometree.out_ext_status = + function + | Ast_411.Outcometree.Oext_first -> Ast_410.Outcometree.Oext_first + | Ast_411.Outcometree.Oext_next -> Ast_410.Outcometree.Oext_next + | Ast_411.Outcometree.Oext_exception -> Ast_410.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_411.Outcometree.out_extension_constructor -> + Ast_410.Outcometree.out_extension_constructor + = + fun + { Ast_411.Outcometree.oext_name = oext_name; + Ast_411.Outcometree.oext_type_name = oext_type_name; + Ast_411.Outcometree.oext_type_params = oext_type_params; + Ast_411.Outcometree.oext_args = oext_args; + Ast_411.Outcometree.oext_ret_type = oext_ret_type; + Ast_411.Outcometree.oext_private = oext_private } + -> + { + Ast_410.Outcometree.oext_name = oext_name; + Ast_410.Outcometree.oext_type_name = oext_type_name; + Ast_410.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_410.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_410.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_410.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_out_rec_status : + Ast_411.Outcometree.out_rec_status -> Ast_410.Outcometree.out_rec_status = + function + | Ast_411.Outcometree.Orec_not -> Ast_410.Outcometree.Orec_not + | Ast_411.Outcometree.Orec_first -> Ast_410.Outcometree.Orec_first + | Ast_411.Outcometree.Orec_next -> Ast_410.Outcometree.Orec_next +and copy_out_class_type : + Ast_411.Outcometree.out_class_type -> Ast_410.Outcometree.out_class_type = + function + | Ast_411.Outcometree.Octy_constr (x0, x1) -> + Ast_410.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_411.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_410.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_411.Outcometree.Octy_signature (x0, x1) -> + Ast_410.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_411.Outcometree.out_class_sig_item -> + Ast_410.Outcometree.out_class_sig_item + = + function + | Ast_411.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_410.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_411.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_410.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_411.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_410.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type : + Ast_411.Outcometree.out_type -> Ast_410.Outcometree.out_type = + function + | Ast_411.Outcometree.Otyp_abstract -> Ast_410.Outcometree.Otyp_abstract + | Ast_411.Outcometree.Otyp_open -> Ast_410.Outcometree.Otyp_open + | Ast_411.Outcometree.Otyp_alias (x0, x1) -> + Ast_410.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_411.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_411.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_411.Outcometree.Otyp_constr (x0, x1) -> + Ast_410.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_411.Outcometree.Otyp_manifest (x0, x1) -> + Ast_410.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_411.Outcometree.Otyp_object (x0, x1) -> + Ast_410.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), + (Option.map (fun x -> x) x1)) + | Ast_411.Outcometree.Otyp_record x0 -> + Ast_410.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_411.Outcometree.Otyp_stuff x0 -> Ast_410.Outcometree.Otyp_stuff x0 + | Ast_411.Outcometree.Otyp_sum x0 -> + Ast_410.Outcometree.Otyp_sum + (List.map + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) x0) + | Ast_411.Outcometree.Otyp_tuple x0 -> + Ast_410.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_411.Outcometree.Otyp_var (x0, x1) -> + Ast_410.Outcometree.Otyp_var (x0, x1) + | Ast_411.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_410.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_411.Outcometree.Otyp_poly (x0, x1) -> + Ast_410.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_411.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_410.Outcometree.Otyp_module + ((copy_out_ident x0), (List.map (fun x -> x) x1), + (List.map copy_out_type x2)) + | Ast_411.Outcometree.Otyp_attribute (x0, x1) -> + Ast_410.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_411.Outcometree.out_attribute -> Ast_410.Outcometree.out_attribute = + fun { Ast_411.Outcometree.oattr_name = oattr_name } -> + { Ast_410.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_411.Outcometree.out_variant -> Ast_410.Outcometree.out_variant = + function + | Ast_411.Outcometree.Ovar_fields x0 -> + Ast_410.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_411.Outcometree.Ovar_typ x0 -> + Ast_410.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_value : + Ast_411.Outcometree.out_value -> Ast_410.Outcometree.out_value = + function + | Ast_411.Outcometree.Oval_array x0 -> + Ast_410.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_411.Outcometree.Oval_char x0 -> Ast_410.Outcometree.Oval_char x0 + | Ast_411.Outcometree.Oval_constr (x0, x1) -> + Ast_410.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_411.Outcometree.Oval_ellipsis -> Ast_410.Outcometree.Oval_ellipsis + | Ast_411.Outcometree.Oval_float x0 -> Ast_410.Outcometree.Oval_float x0 + | Ast_411.Outcometree.Oval_int x0 -> Ast_410.Outcometree.Oval_int x0 + | Ast_411.Outcometree.Oval_int32 x0 -> Ast_410.Outcometree.Oval_int32 x0 + | Ast_411.Outcometree.Oval_int64 x0 -> Ast_410.Outcometree.Oval_int64 x0 + | Ast_411.Outcometree.Oval_nativeint x0 -> + Ast_410.Outcometree.Oval_nativeint x0 + | Ast_411.Outcometree.Oval_list x0 -> + Ast_410.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_411.Outcometree.Oval_printer x0 -> + Ast_410.Outcometree.Oval_printer x0 + | Ast_411.Outcometree.Oval_record x0 -> + Ast_410.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_411.Outcometree.Oval_string (x0, x1, x2) -> + Ast_410.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_411.Outcometree.Oval_stuff x0 -> Ast_410.Outcometree.Oval_stuff x0 + | Ast_411.Outcometree.Oval_tuple x0 -> + Ast_410.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_411.Outcometree.Oval_variant (x0, x1) -> + Ast_410.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_411.Outcometree.out_string -> Ast_410.Outcometree.out_string = + function + | Ast_411.Outcometree.Ostr_string -> Ast_410.Outcometree.Ostr_string + | Ast_411.Outcometree.Ostr_bytes -> Ast_410.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_411.Outcometree.out_ident -> Ast_410.Outcometree.out_ident = + function + | Ast_411.Outcometree.Oide_apply (x0, x1) -> + Ast_410.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_411.Outcometree.Oide_dot (x0, x1) -> + Ast_410.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_411.Outcometree.Oide_ident x0 -> + Ast_410.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_411.Outcometree.out_name -> Ast_410.Outcometree.out_name = + fun { Ast_411.Outcometree.printed_name = printed_name } -> + { Ast_410.Outcometree.printed_name = printed_name } +and copy_toplevel_phrase : + Ast_411.Parsetree.toplevel_phrase -> Ast_410.Parsetree.toplevel_phrase = + function + | Ast_411.Parsetree.Ptop_def x0 -> + Ast_410.Parsetree.Ptop_def (copy_structure x0) + | Ast_411.Parsetree.Ptop_dir x0 -> + Ast_410.Parsetree.Ptop_dir (copy_toplevel_directive x0) +and copy_toplevel_directive : + Ast_411.Parsetree.toplevel_directive -> + Ast_410.Parsetree.toplevel_directive + = + fun + { Ast_411.Parsetree.pdir_name = pdir_name; + Ast_411.Parsetree.pdir_arg = pdir_arg; + Ast_411.Parsetree.pdir_loc = pdir_loc } + -> + { + Ast_410.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); + Ast_410.Parsetree.pdir_arg = + (Option.map copy_directive_argument pdir_arg); + Ast_410.Parsetree.pdir_loc = (copy_location pdir_loc) + } +and copy_directive_argument : + Ast_411.Parsetree.directive_argument -> + Ast_410.Parsetree.directive_argument + = + fun + { Ast_411.Parsetree.pdira_desc = pdira_desc; + Ast_411.Parsetree.pdira_loc = pdira_loc } + -> + { + Ast_410.Parsetree.pdira_desc = + (copy_directive_argument_desc pdira_desc); + Ast_410.Parsetree.pdira_loc = (copy_location pdira_loc) + } +and copy_directive_argument_desc : + Ast_411.Parsetree.directive_argument_desc -> + Ast_410.Parsetree.directive_argument_desc + = + function + | Ast_411.Parsetree.Pdir_string x0 -> Ast_410.Parsetree.Pdir_string x0 + | Ast_411.Parsetree.Pdir_int (x0, x1) -> + Ast_410.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) + | Ast_411.Parsetree.Pdir_ident x0 -> + Ast_410.Parsetree.Pdir_ident (copy_Longident_t x0) + | Ast_411.Parsetree.Pdir_bool x0 -> Ast_410.Parsetree.Pdir_bool x0 +and copy_expression : + Ast_411.Parsetree.expression -> Ast_410.Parsetree.expression = + fun + { Ast_411.Parsetree.pexp_desc = pexp_desc; + Ast_411.Parsetree.pexp_loc = pexp_loc; + Ast_411.Parsetree.pexp_loc_stack = pexp_loc_stack; + Ast_411.Parsetree.pexp_attributes = pexp_attributes } + -> + { + Ast_410.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); + Ast_410.Parsetree.pexp_loc = (copy_location pexp_loc); + Ast_410.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); + Ast_410.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) + } +and copy_expr x = copy_expression x +and copy_expression_desc : + Ast_411.Parsetree.expression_desc -> Ast_410.Parsetree.expression_desc = + function + | Ast_411.Parsetree.Pexp_ident x0 -> + Ast_410.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) + | Ast_411.Parsetree.Pexp_constant x0 -> + Ast_410.Parsetree.Pexp_constant (copy_constant x0) + | Ast_411.Parsetree.Pexp_let (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_expression x2)) + | Ast_411.Parsetree.Pexp_function x0 -> + Ast_410.Parsetree.Pexp_function (List.map copy_case x0) + | Ast_411.Parsetree.Pexp_fun (x0, x1, x2, x3) -> + Ast_410.Parsetree.Pexp_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_expression x3)) + | Ast_411.Parsetree.Pexp_apply (x0, x1) -> + Ast_410.Parsetree.Pexp_apply + ((copy_expression x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_arg_label x0), (copy_expression x1))) x1)) + | Ast_411.Parsetree.Pexp_match (x0, x1) -> + Ast_410.Parsetree.Pexp_match + ((copy_expression x0), (List.map copy_case x1)) + | Ast_411.Parsetree.Pexp_try (x0, x1) -> + Ast_410.Parsetree.Pexp_try + ((copy_expression x0), (List.map copy_case x1)) + | Ast_411.Parsetree.Pexp_tuple x0 -> + Ast_410.Parsetree.Pexp_tuple (List.map copy_expression x0) + | Ast_411.Parsetree.Pexp_construct (x0, x1) -> + Ast_410.Parsetree.Pexp_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) + | Ast_411.Parsetree.Pexp_variant (x0, x1) -> + Ast_410.Parsetree.Pexp_variant + ((copy_label x0), (Option.map copy_expression x1)) + | Ast_411.Parsetree.Pexp_record (x0, x1) -> + Ast_410.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_411.Parsetree.Pexp_field (x0, x1) -> + Ast_410.Parsetree.Pexp_field + ((copy_expression x0), (copy_loc copy_Longident_t x1)) + | Ast_411.Parsetree.Pexp_setfield (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_setfield + ((copy_expression x0), (copy_loc copy_Longident_t x1), + (copy_expression x2)) + | Ast_411.Parsetree.Pexp_array x0 -> + Ast_410.Parsetree.Pexp_array (List.map copy_expression x0) + | Ast_411.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_ifthenelse + ((copy_expression x0), (copy_expression x1), + (Option.map copy_expression x2)) + | Ast_411.Parsetree.Pexp_sequence (x0, x1) -> + Ast_410.Parsetree.Pexp_sequence + ((copy_expression x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_while (x0, x1) -> + Ast_410.Parsetree.Pexp_while + ((copy_expression x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + Ast_410.Parsetree.Pexp_for + ((copy_pattern x0), (copy_expression x1), (copy_expression x2), + (copy_direction_flag x3), (copy_expression x4)) + | Ast_411.Parsetree.Pexp_constraint (x0, x1) -> + Ast_410.Parsetree.Pexp_constraint + ((copy_expression x0), (copy_core_type x1)) + | Ast_411.Parsetree.Pexp_coerce (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_coerce + ((copy_expression x0), (Option.map copy_core_type x1), + (copy_core_type x2)) + | Ast_411.Parsetree.Pexp_send (x0, x1) -> + Ast_410.Parsetree.Pexp_send + ((copy_expression x0), (copy_loc copy_label x1)) + | Ast_411.Parsetree.Pexp_new x0 -> + Ast_410.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) + | Ast_411.Parsetree.Pexp_setinstvar (x0, x1) -> + Ast_410.Parsetree.Pexp_setinstvar + ((copy_loc copy_label x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_override x0 -> + Ast_410.Parsetree.Pexp_override + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_label x0), (copy_expression x1))) x0) + | Ast_411.Parsetree.Pexp_letmodule (x0, x1, x2) -> + Ast_410.Parsetree.Pexp_letmodule + ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), + (copy_module_expr x1), (copy_expression x2)) + | Ast_411.Parsetree.Pexp_letexception (x0, x1) -> + Ast_410.Parsetree.Pexp_letexception + ((copy_extension_constructor x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_assert x0 -> + Ast_410.Parsetree.Pexp_assert (copy_expression x0) + | Ast_411.Parsetree.Pexp_lazy x0 -> + Ast_410.Parsetree.Pexp_lazy (copy_expression x0) + | Ast_411.Parsetree.Pexp_poly (x0, x1) -> + Ast_410.Parsetree.Pexp_poly + ((copy_expression x0), (Option.map copy_core_type x1)) + | Ast_411.Parsetree.Pexp_object x0 -> + Ast_410.Parsetree.Pexp_object (copy_class_structure x0) + | Ast_411.Parsetree.Pexp_newtype (x0, x1) -> + Ast_410.Parsetree.Pexp_newtype + ((copy_loc (fun x -> x) x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_pack x0 -> + Ast_410.Parsetree.Pexp_pack (copy_module_expr x0) + | Ast_411.Parsetree.Pexp_open (x0, x1) -> + Ast_410.Parsetree.Pexp_open + ((copy_open_declaration x0), (copy_expression x1)) + | Ast_411.Parsetree.Pexp_letop x0 -> + Ast_410.Parsetree.Pexp_letop (copy_letop x0) + | Ast_411.Parsetree.Pexp_extension x0 -> + Ast_410.Parsetree.Pexp_extension (copy_extension x0) + | Ast_411.Parsetree.Pexp_unreachable -> Ast_410.Parsetree.Pexp_unreachable +and copy_letop : Ast_411.Parsetree.letop -> Ast_410.Parsetree.letop = + fun + { Ast_411.Parsetree.let_ = let_; Ast_411.Parsetree.ands = ands; + Ast_411.Parsetree.body = body } + -> + { + Ast_410.Parsetree.let_ = (copy_binding_op let_); + Ast_410.Parsetree.ands = (List.map copy_binding_op ands); + Ast_410.Parsetree.body = (copy_expression body) + } +and copy_binding_op : + Ast_411.Parsetree.binding_op -> Ast_410.Parsetree.binding_op = + fun + { Ast_411.Parsetree.pbop_op = pbop_op; + Ast_411.Parsetree.pbop_pat = pbop_pat; + Ast_411.Parsetree.pbop_exp = pbop_exp; + Ast_411.Parsetree.pbop_loc = pbop_loc } + -> + { + Ast_410.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); + Ast_410.Parsetree.pbop_pat = (copy_pattern pbop_pat); + Ast_410.Parsetree.pbop_exp = (copy_expression pbop_exp); + Ast_410.Parsetree.pbop_loc = (copy_location pbop_loc) + } +and copy_direction_flag : + Ast_411.Asttypes.direction_flag -> Ast_410.Asttypes.direction_flag = + function + | Ast_411.Asttypes.Upto -> Ast_410.Asttypes.Upto + | Ast_411.Asttypes.Downto -> Ast_410.Asttypes.Downto +and copy_case : Ast_411.Parsetree.case -> Ast_410.Parsetree.case = + fun + { Ast_411.Parsetree.pc_lhs = pc_lhs; + Ast_411.Parsetree.pc_guard = pc_guard; + Ast_411.Parsetree.pc_rhs = pc_rhs } + -> + { + Ast_410.Parsetree.pc_lhs = (copy_pattern pc_lhs); + Ast_410.Parsetree.pc_guard = (Option.map copy_expression pc_guard); + Ast_410.Parsetree.pc_rhs = (copy_expression pc_rhs) + } +and copy_cases : Ast_411.Parsetree.case list -> Ast_410.Parsetree.case list = + fun x -> List.map copy_case x +and copy_value_binding : + Ast_411.Parsetree.value_binding -> Ast_410.Parsetree.value_binding = + fun + { Ast_411.Parsetree.pvb_pat = pvb_pat; + Ast_411.Parsetree.pvb_expr = pvb_expr; + Ast_411.Parsetree.pvb_attributes = pvb_attributes; + Ast_411.Parsetree.pvb_loc = pvb_loc } + -> + { + Ast_410.Parsetree.pvb_pat = (copy_pattern pvb_pat); + Ast_410.Parsetree.pvb_expr = (copy_expression pvb_expr); + Ast_410.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); + Ast_410.Parsetree.pvb_loc = (copy_location pvb_loc) + } +and copy_pattern : Ast_411.Parsetree.pattern -> Ast_410.Parsetree.pattern = + fun + { Ast_411.Parsetree.ppat_desc = ppat_desc; + Ast_411.Parsetree.ppat_loc = ppat_loc; + Ast_411.Parsetree.ppat_loc_stack = ppat_loc_stack; + Ast_411.Parsetree.ppat_attributes = ppat_attributes } + -> + { + Ast_410.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); + Ast_410.Parsetree.ppat_loc = (copy_location ppat_loc); + Ast_410.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); + Ast_410.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) + } +and copy_pat x = copy_pattern x +and copy_pattern_desc : + Ast_411.Parsetree.pattern_desc -> Ast_410.Parsetree.pattern_desc = + function + | Ast_411.Parsetree.Ppat_any -> Ast_410.Parsetree.Ppat_any + | Ast_411.Parsetree.Ppat_var x0 -> + Ast_410.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) + | Ast_411.Parsetree.Ppat_alias (x0, x1) -> + Ast_410.Parsetree.Ppat_alias + ((copy_pattern x0), (copy_loc (fun x -> x) x1)) + | Ast_411.Parsetree.Ppat_constant x0 -> + Ast_410.Parsetree.Ppat_constant (copy_constant x0) + | Ast_411.Parsetree.Ppat_interval (x0, x1) -> + Ast_410.Parsetree.Ppat_interval + ((copy_constant x0), (copy_constant x1)) + | Ast_411.Parsetree.Ppat_tuple x0 -> + Ast_410.Parsetree.Ppat_tuple (List.map copy_pattern x0) + | Ast_411.Parsetree.Ppat_construct (x0, x1) -> + Ast_410.Parsetree.Ppat_construct + ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) + | Ast_411.Parsetree.Ppat_variant (x0, x1) -> + Ast_410.Parsetree.Ppat_variant + ((copy_label x0), (Option.map copy_pattern x1)) + | Ast_411.Parsetree.Ppat_record (x0, x1) -> + Ast_410.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_411.Parsetree.Ppat_array x0 -> + Ast_410.Parsetree.Ppat_array (List.map copy_pattern x0) + | Ast_411.Parsetree.Ppat_or (x0, x1) -> + Ast_410.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) + | Ast_411.Parsetree.Ppat_constraint (x0, x1) -> + Ast_410.Parsetree.Ppat_constraint + ((copy_pattern x0), (copy_core_type x1)) + | Ast_411.Parsetree.Ppat_type x0 -> + Ast_410.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) + | Ast_411.Parsetree.Ppat_lazy x0 -> + Ast_410.Parsetree.Ppat_lazy (copy_pattern x0) + | Ast_411.Parsetree.Ppat_unpack x0 -> + Ast_410.Parsetree.Ppat_unpack + (copy_loc (fun x -> Option.map (fun x -> x) x) x0) + | Ast_411.Parsetree.Ppat_exception x0 -> + Ast_410.Parsetree.Ppat_exception (copy_pattern x0) + | Ast_411.Parsetree.Ppat_extension x0 -> + Ast_410.Parsetree.Ppat_extension (copy_extension x0) + | Ast_411.Parsetree.Ppat_open (x0, x1) -> + Ast_410.Parsetree.Ppat_open + ((copy_loc copy_Longident_t x0), (copy_pattern x1)) +and copy_core_type : + Ast_411.Parsetree.core_type -> Ast_410.Parsetree.core_type = + fun + { Ast_411.Parsetree.ptyp_desc = ptyp_desc; + Ast_411.Parsetree.ptyp_loc = ptyp_loc; + Ast_411.Parsetree.ptyp_loc_stack = ptyp_loc_stack; + Ast_411.Parsetree.ptyp_attributes = ptyp_attributes } + -> + { + Ast_410.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); + Ast_410.Parsetree.ptyp_loc = (copy_location ptyp_loc); + Ast_410.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); + Ast_410.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) + } +and copy_typ x = copy_core_type x +and copy_location_stack : + Ast_411.Parsetree.location_stack -> Ast_410.Parsetree.location_stack = + fun x -> List.map copy_location x +and copy_core_type_desc : + Ast_411.Parsetree.core_type_desc -> Ast_410.Parsetree.core_type_desc = + function + | Ast_411.Parsetree.Ptyp_any -> Ast_410.Parsetree.Ptyp_any + | Ast_411.Parsetree.Ptyp_var x0 -> Ast_410.Parsetree.Ptyp_var x0 + | Ast_411.Parsetree.Ptyp_arrow (x0, x1, x2) -> + Ast_410.Parsetree.Ptyp_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) + | Ast_411.Parsetree.Ptyp_tuple x0 -> + Ast_410.Parsetree.Ptyp_tuple (List.map copy_core_type x0) + | Ast_411.Parsetree.Ptyp_constr (x0, x1) -> + Ast_410.Parsetree.Ptyp_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_411.Parsetree.Ptyp_object (x0, x1) -> + Ast_410.Parsetree.Ptyp_object + ((List.map copy_object_field x0), (copy_closed_flag x1)) + | Ast_411.Parsetree.Ptyp_class (x0, x1) -> + Ast_410.Parsetree.Ptyp_class + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_411.Parsetree.Ptyp_alias (x0, x1) -> + Ast_410.Parsetree.Ptyp_alias ((copy_core_type x0), x1) + | Ast_411.Parsetree.Ptyp_variant (x0, x1, x2) -> + Ast_410.Parsetree.Ptyp_variant + ((List.map copy_row_field x0), (copy_closed_flag x1), + (Option.map (fun x -> List.map copy_label x) x2)) + | Ast_411.Parsetree.Ptyp_poly (x0, x1) -> + Ast_410.Parsetree.Ptyp_poly + ((List.map (fun x -> copy_loc (fun x -> x) x) x0), + (copy_core_type x1)) + | Ast_411.Parsetree.Ptyp_package x0 -> + Ast_410.Parsetree.Ptyp_package (copy_package_type x0) + | Ast_411.Parsetree.Ptyp_extension x0 -> + Ast_410.Parsetree.Ptyp_extension (copy_extension x0) +and copy_package_type : + Ast_411.Parsetree.package_type -> Ast_410.Parsetree.package_type = + fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), + (List.map + (fun x -> + let (x0, x1) = x in + ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) +and copy_row_field : + Ast_411.Parsetree.row_field -> Ast_410.Parsetree.row_field = + fun + { Ast_411.Parsetree.prf_desc = prf_desc; + Ast_411.Parsetree.prf_loc = prf_loc; + Ast_411.Parsetree.prf_attributes = prf_attributes } + -> + { + Ast_410.Parsetree.prf_desc = (copy_row_field_desc prf_desc); + Ast_410.Parsetree.prf_loc = (copy_location prf_loc); + Ast_410.Parsetree.prf_attributes = (copy_attributes prf_attributes) + } +and copy_row_field_desc : + Ast_411.Parsetree.row_field_desc -> Ast_410.Parsetree.row_field_desc = + function + | Ast_411.Parsetree.Rtag (x0, x1, x2) -> + Ast_410.Parsetree.Rtag + ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) + | Ast_411.Parsetree.Rinherit x0 -> + Ast_410.Parsetree.Rinherit (copy_core_type x0) +and copy_object_field : + Ast_411.Parsetree.object_field -> Ast_410.Parsetree.object_field = + fun + { Ast_411.Parsetree.pof_desc = pof_desc; + Ast_411.Parsetree.pof_loc = pof_loc; + Ast_411.Parsetree.pof_attributes = pof_attributes } + -> + { + Ast_410.Parsetree.pof_desc = (copy_object_field_desc pof_desc); + Ast_410.Parsetree.pof_loc = (copy_location pof_loc); + Ast_410.Parsetree.pof_attributes = (copy_attributes pof_attributes) + } +and copy_attributes : + Ast_411.Parsetree.attributes -> Ast_410.Parsetree.attributes = + fun x -> List.map copy_attribute x +and copy_attribute : + Ast_411.Parsetree.attribute -> Ast_410.Parsetree.attribute = + fun + { Ast_411.Parsetree.attr_name = attr_name; + Ast_411.Parsetree.attr_payload = attr_payload; + Ast_411.Parsetree.attr_loc = attr_loc } + -> + { + Ast_410.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); + Ast_410.Parsetree.attr_payload = (copy_payload attr_payload); + Ast_410.Parsetree.attr_loc = (copy_location attr_loc) + } +and copy_payload : Ast_411.Parsetree.payload -> Ast_410.Parsetree.payload = + function + | Ast_411.Parsetree.PStr x0 -> Ast_410.Parsetree.PStr (copy_structure x0) + | Ast_411.Parsetree.PSig x0 -> Ast_410.Parsetree.PSig (copy_signature x0) + | Ast_411.Parsetree.PTyp x0 -> Ast_410.Parsetree.PTyp (copy_core_type x0) + | Ast_411.Parsetree.PPat (x0, x1) -> + Ast_410.Parsetree.PPat + ((copy_pattern x0), (Option.map copy_expression x1)) +and copy_structure : + Ast_411.Parsetree.structure -> Ast_410.Parsetree.structure = + fun x -> List.map copy_structure_item x +and copy_structure_item : + Ast_411.Parsetree.structure_item -> Ast_410.Parsetree.structure_item = + fun + { Ast_411.Parsetree.pstr_desc = pstr_desc; + Ast_411.Parsetree.pstr_loc = pstr_loc } + -> + { + Ast_410.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); + Ast_410.Parsetree.pstr_loc = (copy_location pstr_loc) + } +and copy_structure_item_desc : + Ast_411.Parsetree.structure_item_desc -> + Ast_410.Parsetree.structure_item_desc + = + function + | Ast_411.Parsetree.Pstr_eval (x0, x1) -> + Ast_410.Parsetree.Pstr_eval + ((copy_expression x0), (copy_attributes x1)) + | Ast_411.Parsetree.Pstr_value (x0, x1) -> + Ast_410.Parsetree.Pstr_value + ((copy_rec_flag x0), (List.map copy_value_binding x1)) + | Ast_411.Parsetree.Pstr_primitive x0 -> + Ast_410.Parsetree.Pstr_primitive (copy_value_description x0) + | Ast_411.Parsetree.Pstr_type (x0, x1) -> + Ast_410.Parsetree.Pstr_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_411.Parsetree.Pstr_typext x0 -> + Ast_410.Parsetree.Pstr_typext (copy_type_extension x0) + | Ast_411.Parsetree.Pstr_exception x0 -> + Ast_410.Parsetree.Pstr_exception (copy_type_exception x0) + | Ast_411.Parsetree.Pstr_module x0 -> + Ast_410.Parsetree.Pstr_module (copy_module_binding x0) + | Ast_411.Parsetree.Pstr_recmodule x0 -> + Ast_410.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) + | Ast_411.Parsetree.Pstr_modtype x0 -> + Ast_410.Parsetree.Pstr_modtype (copy_module_type_declaration x0) + | Ast_411.Parsetree.Pstr_open x0 -> + Ast_410.Parsetree.Pstr_open (copy_open_declaration x0) + | Ast_411.Parsetree.Pstr_class x0 -> + Ast_410.Parsetree.Pstr_class (List.map copy_class_declaration x0) + | Ast_411.Parsetree.Pstr_class_type x0 -> + Ast_410.Parsetree.Pstr_class_type + (List.map copy_class_type_declaration x0) + | Ast_411.Parsetree.Pstr_include x0 -> + Ast_410.Parsetree.Pstr_include (copy_include_declaration x0) + | Ast_411.Parsetree.Pstr_attribute x0 -> + Ast_410.Parsetree.Pstr_attribute (copy_attribute x0) + | Ast_411.Parsetree.Pstr_extension (x0, x1) -> + Ast_410.Parsetree.Pstr_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_include_declaration : + Ast_411.Parsetree.include_declaration -> + Ast_410.Parsetree.include_declaration + = fun x -> copy_include_infos copy_module_expr x +and copy_class_declaration : + Ast_411.Parsetree.class_declaration -> Ast_410.Parsetree.class_declaration + = fun x -> copy_class_infos copy_class_expr x +and copy_class_expr : + Ast_411.Parsetree.class_expr -> Ast_410.Parsetree.class_expr = + fun + { Ast_411.Parsetree.pcl_desc = pcl_desc; + Ast_411.Parsetree.pcl_loc = pcl_loc; + Ast_411.Parsetree.pcl_attributes = pcl_attributes } + -> + { + Ast_410.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); + Ast_410.Parsetree.pcl_loc = (copy_location pcl_loc); + Ast_410.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) + } +and copy_class_expr_desc : + Ast_411.Parsetree.class_expr_desc -> Ast_410.Parsetree.class_expr_desc = + function + | Ast_411.Parsetree.Pcl_constr (x0, x1) -> + Ast_410.Parsetree.Pcl_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_411.Parsetree.Pcl_structure x0 -> + Ast_410.Parsetree.Pcl_structure (copy_class_structure x0) + | Ast_411.Parsetree.Pcl_fun (x0, x1, x2, x3) -> + Ast_410.Parsetree.Pcl_fun + ((copy_arg_label x0), (Option.map copy_expression x1), + (copy_pattern x2), (copy_class_expr x3)) + | Ast_411.Parsetree.Pcl_apply (x0, x1) -> + Ast_410.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_411.Parsetree.Pcl_let (x0, x1, x2) -> + Ast_410.Parsetree.Pcl_let + ((copy_rec_flag x0), (List.map copy_value_binding x1), + (copy_class_expr x2)) + | Ast_411.Parsetree.Pcl_constraint (x0, x1) -> + Ast_410.Parsetree.Pcl_constraint + ((copy_class_expr x0), (copy_class_type x1)) + | Ast_411.Parsetree.Pcl_extension x0 -> + Ast_410.Parsetree.Pcl_extension (copy_extension x0) + | Ast_411.Parsetree.Pcl_open (x0, x1) -> + Ast_410.Parsetree.Pcl_open + ((copy_open_description x0), (copy_class_expr x1)) +and copy_class_structure : + Ast_411.Parsetree.class_structure -> Ast_410.Parsetree.class_structure = + fun + { Ast_411.Parsetree.pcstr_self = pcstr_self; + Ast_411.Parsetree.pcstr_fields = pcstr_fields } + -> + { + Ast_410.Parsetree.pcstr_self = (copy_pattern pcstr_self); + Ast_410.Parsetree.pcstr_fields = + (List.map copy_class_field pcstr_fields) + } +and copy_class_field : + Ast_411.Parsetree.class_field -> Ast_410.Parsetree.class_field = + fun + { Ast_411.Parsetree.pcf_desc = pcf_desc; + Ast_411.Parsetree.pcf_loc = pcf_loc; + Ast_411.Parsetree.pcf_attributes = pcf_attributes } + -> + { + Ast_410.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); + Ast_410.Parsetree.pcf_loc = (copy_location pcf_loc); + Ast_410.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) + } +and copy_class_field_desc : + Ast_411.Parsetree.class_field_desc -> Ast_410.Parsetree.class_field_desc = + function + | Ast_411.Parsetree.Pcf_inherit (x0, x1, x2) -> + Ast_410.Parsetree.Pcf_inherit + ((copy_override_flag x0), (copy_class_expr x1), + (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) + | Ast_411.Parsetree.Pcf_val x0 -> + Ast_410.Parsetree.Pcf_val + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_mutable_flag x1), + (copy_class_field_kind x2))) + | Ast_411.Parsetree.Pcf_method x0 -> + Ast_410.Parsetree.Pcf_method + (let (x0, x1, x2) = x0 in + ((copy_loc copy_label x0), (copy_private_flag x1), + (copy_class_field_kind x2))) + | Ast_411.Parsetree.Pcf_constraint x0 -> + Ast_410.Parsetree.Pcf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_411.Parsetree.Pcf_initializer x0 -> + Ast_410.Parsetree.Pcf_initializer (copy_expression x0) + | Ast_411.Parsetree.Pcf_attribute x0 -> + Ast_410.Parsetree.Pcf_attribute (copy_attribute x0) + | Ast_411.Parsetree.Pcf_extension x0 -> + Ast_410.Parsetree.Pcf_extension (copy_extension x0) +and copy_class_field_kind : + Ast_411.Parsetree.class_field_kind -> Ast_410.Parsetree.class_field_kind = + function + | Ast_411.Parsetree.Cfk_virtual x0 -> + Ast_410.Parsetree.Cfk_virtual (copy_core_type x0) + | Ast_411.Parsetree.Cfk_concrete (x0, x1) -> + Ast_410.Parsetree.Cfk_concrete + ((copy_override_flag x0), (copy_expression x1)) +and copy_open_declaration : + Ast_411.Parsetree.open_declaration -> Ast_410.Parsetree.open_declaration = + fun x -> copy_open_infos copy_module_expr x +and copy_module_binding : + Ast_411.Parsetree.module_binding -> Ast_410.Parsetree.module_binding = + fun + { Ast_411.Parsetree.pmb_name = pmb_name; + Ast_411.Parsetree.pmb_expr = pmb_expr; + Ast_411.Parsetree.pmb_attributes = pmb_attributes; + Ast_411.Parsetree.pmb_loc = pmb_loc } + -> + { + Ast_410.Parsetree.pmb_name = + (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); + Ast_410.Parsetree.pmb_expr = (copy_module_expr pmb_expr); + Ast_410.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); + Ast_410.Parsetree.pmb_loc = (copy_location pmb_loc) + } +and copy_module_expr : + Ast_411.Parsetree.module_expr -> Ast_410.Parsetree.module_expr = + fun + { Ast_411.Parsetree.pmod_desc = pmod_desc; + Ast_411.Parsetree.pmod_loc = pmod_loc; + Ast_411.Parsetree.pmod_attributes = pmod_attributes } + -> + { + Ast_410.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); + Ast_410.Parsetree.pmod_loc = (copy_location pmod_loc); + Ast_410.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) + } +and copy_module_expr_desc : + Ast_411.Parsetree.module_expr_desc -> Ast_410.Parsetree.module_expr_desc = + function + | Ast_411.Parsetree.Pmod_ident x0 -> + Ast_410.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) + | Ast_411.Parsetree.Pmod_structure x0 -> + Ast_410.Parsetree.Pmod_structure (copy_structure x0) + | Ast_411.Parsetree.Pmod_functor (x0, x1) -> + Ast_410.Parsetree.Pmod_functor + ((copy_functor_parameter x0), (copy_module_expr x1)) + | Ast_411.Parsetree.Pmod_apply (x0, x1) -> + Ast_410.Parsetree.Pmod_apply + ((copy_module_expr x0), (copy_module_expr x1)) + | Ast_411.Parsetree.Pmod_constraint (x0, x1) -> + Ast_410.Parsetree.Pmod_constraint + ((copy_module_expr x0), (copy_module_type x1)) + | Ast_411.Parsetree.Pmod_unpack x0 -> + Ast_410.Parsetree.Pmod_unpack (copy_expression x0) + | Ast_411.Parsetree.Pmod_extension x0 -> + Ast_410.Parsetree.Pmod_extension (copy_extension x0) +and copy_functor_parameter : + Ast_411.Parsetree.functor_parameter -> Ast_410.Parsetree.functor_parameter + = + function + | Ast_411.Parsetree.Unit -> Ast_410.Parsetree.Unit + | Ast_411.Parsetree.Named (x0, x1) -> + Ast_410.Parsetree.Named + ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), + (copy_module_type x1)) +and copy_module_type : + Ast_411.Parsetree.module_type -> Ast_410.Parsetree.module_type = + fun + { Ast_411.Parsetree.pmty_desc = pmty_desc; + Ast_411.Parsetree.pmty_loc = pmty_loc; + Ast_411.Parsetree.pmty_attributes = pmty_attributes } + -> + { + Ast_410.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); + Ast_410.Parsetree.pmty_loc = (copy_location pmty_loc); + Ast_410.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) + } +and copy_module_type_desc : + Ast_411.Parsetree.module_type_desc -> Ast_410.Parsetree.module_type_desc = + function + | Ast_411.Parsetree.Pmty_ident x0 -> + Ast_410.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) + | Ast_411.Parsetree.Pmty_signature x0 -> + Ast_410.Parsetree.Pmty_signature (copy_signature x0) + | Ast_411.Parsetree.Pmty_functor (x0, x1) -> + Ast_410.Parsetree.Pmty_functor + ((copy_functor_parameter x0), (copy_module_type x1)) + | Ast_411.Parsetree.Pmty_with (x0, x1) -> + Ast_410.Parsetree.Pmty_with + ((copy_module_type x0), (List.map copy_with_constraint x1)) + | Ast_411.Parsetree.Pmty_typeof x0 -> + Ast_410.Parsetree.Pmty_typeof (copy_module_expr x0) + | Ast_411.Parsetree.Pmty_extension x0 -> + Ast_410.Parsetree.Pmty_extension (copy_extension x0) + | Ast_411.Parsetree.Pmty_alias x0 -> + Ast_410.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) +and copy_with_constraint : + Ast_411.Parsetree.with_constraint -> Ast_410.Parsetree.with_constraint = + function + | Ast_411.Parsetree.Pwith_type (x0, x1) -> + Ast_410.Parsetree.Pwith_type + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_411.Parsetree.Pwith_module (x0, x1) -> + Ast_410.Parsetree.Pwith_module + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) + | Ast_411.Parsetree.Pwith_typesubst (x0, x1) -> + Ast_410.Parsetree.Pwith_typesubst + ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) + | Ast_411.Parsetree.Pwith_modsubst (x0, x1) -> + Ast_410.Parsetree.Pwith_modsubst + ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) +and copy_signature : + Ast_411.Parsetree.signature -> Ast_410.Parsetree.signature = + fun x -> List.map copy_signature_item x +and copy_signature_item : + Ast_411.Parsetree.signature_item -> Ast_410.Parsetree.signature_item = + fun + { Ast_411.Parsetree.psig_desc = psig_desc; + Ast_411.Parsetree.psig_loc = psig_loc } + -> + { + Ast_410.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); + Ast_410.Parsetree.psig_loc = (copy_location psig_loc) + } +and copy_signature_item_desc : + Ast_411.Parsetree.signature_item_desc -> + Ast_410.Parsetree.signature_item_desc + = + function + | Ast_411.Parsetree.Psig_value x0 -> + Ast_410.Parsetree.Psig_value (copy_value_description x0) + | Ast_411.Parsetree.Psig_type (x0, x1) -> + Ast_410.Parsetree.Psig_type + ((copy_rec_flag x0), (List.map copy_type_declaration x1)) + | Ast_411.Parsetree.Psig_typesubst x0 -> + Ast_410.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) + | Ast_411.Parsetree.Psig_typext x0 -> + Ast_410.Parsetree.Psig_typext (copy_type_extension x0) + | Ast_411.Parsetree.Psig_exception x0 -> + Ast_410.Parsetree.Psig_exception (copy_type_exception x0) + | Ast_411.Parsetree.Psig_module x0 -> + Ast_410.Parsetree.Psig_module (copy_module_declaration x0) + | Ast_411.Parsetree.Psig_modsubst x0 -> + Ast_410.Parsetree.Psig_modsubst (copy_module_substitution x0) + | Ast_411.Parsetree.Psig_recmodule x0 -> + Ast_410.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) + | Ast_411.Parsetree.Psig_modtype x0 -> + Ast_410.Parsetree.Psig_modtype (copy_module_type_declaration x0) + | Ast_411.Parsetree.Psig_open x0 -> + Ast_410.Parsetree.Psig_open (copy_open_description x0) + | Ast_411.Parsetree.Psig_include x0 -> + Ast_410.Parsetree.Psig_include (copy_include_description x0) + | Ast_411.Parsetree.Psig_class x0 -> + Ast_410.Parsetree.Psig_class (List.map copy_class_description x0) + | Ast_411.Parsetree.Psig_class_type x0 -> + Ast_410.Parsetree.Psig_class_type + (List.map copy_class_type_declaration x0) + | Ast_411.Parsetree.Psig_attribute x0 -> + Ast_410.Parsetree.Psig_attribute (copy_attribute x0) + | Ast_411.Parsetree.Psig_extension (x0, x1) -> + Ast_410.Parsetree.Psig_extension + ((copy_extension x0), (copy_attributes x1)) +and copy_class_type_declaration : + Ast_411.Parsetree.class_type_declaration -> + Ast_410.Parsetree.class_type_declaration + = fun x -> copy_class_infos copy_class_type x +and copy_class_description : + Ast_411.Parsetree.class_description -> Ast_410.Parsetree.class_description + = fun x -> copy_class_infos copy_class_type x +and copy_class_type : + Ast_411.Parsetree.class_type -> Ast_410.Parsetree.class_type = + fun + { Ast_411.Parsetree.pcty_desc = pcty_desc; + Ast_411.Parsetree.pcty_loc = pcty_loc; + Ast_411.Parsetree.pcty_attributes = pcty_attributes } + -> + { + Ast_410.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); + Ast_410.Parsetree.pcty_loc = (copy_location pcty_loc); + Ast_410.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) + } +and copy_class_type_desc : + Ast_411.Parsetree.class_type_desc -> Ast_410.Parsetree.class_type_desc = + function + | Ast_411.Parsetree.Pcty_constr (x0, x1) -> + Ast_410.Parsetree.Pcty_constr + ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) + | Ast_411.Parsetree.Pcty_signature x0 -> + Ast_410.Parsetree.Pcty_signature (copy_class_signature x0) + | Ast_411.Parsetree.Pcty_arrow (x0, x1, x2) -> + Ast_410.Parsetree.Pcty_arrow + ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) + | Ast_411.Parsetree.Pcty_extension x0 -> + Ast_410.Parsetree.Pcty_extension (copy_extension x0) + | Ast_411.Parsetree.Pcty_open (x0, x1) -> + Ast_410.Parsetree.Pcty_open + ((copy_open_description x0), (copy_class_type x1)) +and copy_class_signature : + Ast_411.Parsetree.class_signature -> Ast_410.Parsetree.class_signature = + fun + { Ast_411.Parsetree.pcsig_self = pcsig_self; + Ast_411.Parsetree.pcsig_fields = pcsig_fields } + -> + { + Ast_410.Parsetree.pcsig_self = (copy_core_type pcsig_self); + Ast_410.Parsetree.pcsig_fields = + (List.map copy_class_type_field pcsig_fields) + } +and copy_class_type_field : + Ast_411.Parsetree.class_type_field -> Ast_410.Parsetree.class_type_field = + fun + { Ast_411.Parsetree.pctf_desc = pctf_desc; + Ast_411.Parsetree.pctf_loc = pctf_loc; + Ast_411.Parsetree.pctf_attributes = pctf_attributes } + -> + { + Ast_410.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); + Ast_410.Parsetree.pctf_loc = (copy_location pctf_loc); + Ast_410.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) + } +and copy_class_type_field_desc : + Ast_411.Parsetree.class_type_field_desc -> + Ast_410.Parsetree.class_type_field_desc + = + function + | Ast_411.Parsetree.Pctf_inherit x0 -> + Ast_410.Parsetree.Pctf_inherit (copy_class_type x0) + | Ast_411.Parsetree.Pctf_val x0 -> + Ast_410.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_411.Parsetree.Pctf_method x0 -> + Ast_410.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_411.Parsetree.Pctf_constraint x0 -> + Ast_410.Parsetree.Pctf_constraint + (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) + | Ast_411.Parsetree.Pctf_attribute x0 -> + Ast_410.Parsetree.Pctf_attribute (copy_attribute x0) + | Ast_411.Parsetree.Pctf_extension x0 -> + Ast_410.Parsetree.Pctf_extension (copy_extension x0) +and copy_extension : + Ast_411.Parsetree.extension -> Ast_410.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_411.Parsetree.class_infos -> 'g0 Ast_410.Parsetree.class_infos + = + fun f0 -> + fun + { Ast_411.Parsetree.pci_virt = pci_virt; + Ast_411.Parsetree.pci_params = pci_params; + Ast_411.Parsetree.pci_name = pci_name; + Ast_411.Parsetree.pci_expr = pci_expr; + Ast_411.Parsetree.pci_loc = pci_loc; + Ast_411.Parsetree.pci_attributes = pci_attributes } + -> + { + Ast_410.Parsetree.pci_virt = (copy_virtual_flag pci_virt); + Ast_410.Parsetree.pci_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + pci_params); + Ast_410.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); + Ast_410.Parsetree.pci_expr = (f0 pci_expr); + Ast_410.Parsetree.pci_loc = (copy_location pci_loc); + Ast_410.Parsetree.pci_attributes = (copy_attributes pci_attributes) + } +and copy_virtual_flag : + Ast_411.Asttypes.virtual_flag -> Ast_410.Asttypes.virtual_flag = + function + | Ast_411.Asttypes.Virtual -> Ast_410.Asttypes.Virtual + | Ast_411.Asttypes.Concrete -> Ast_410.Asttypes.Concrete +and copy_include_description : + Ast_411.Parsetree.include_description -> + Ast_410.Parsetree.include_description + = fun x -> copy_include_infos copy_module_type x +and copy_include_infos : + 'f0 'g0 . + ('f0 -> 'g0) -> + 'f0 Ast_411.Parsetree.include_infos -> + 'g0 Ast_410.Parsetree.include_infos + = + fun f0 -> + fun + { Ast_411.Parsetree.pincl_mod = pincl_mod; + Ast_411.Parsetree.pincl_loc = pincl_loc; + Ast_411.Parsetree.pincl_attributes = pincl_attributes } + -> + { + Ast_410.Parsetree.pincl_mod = (f0 pincl_mod); + Ast_410.Parsetree.pincl_loc = (copy_location pincl_loc); + Ast_410.Parsetree.pincl_attributes = + (copy_attributes pincl_attributes) + } +and copy_open_description : + Ast_411.Parsetree.open_description -> Ast_410.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_411.Parsetree.open_infos -> 'g0 Ast_410.Parsetree.open_infos + = + fun f0 -> + fun + { Ast_411.Parsetree.popen_expr = popen_expr; + Ast_411.Parsetree.popen_override = popen_override; + Ast_411.Parsetree.popen_loc = popen_loc; + Ast_411.Parsetree.popen_attributes = popen_attributes } + -> + { + Ast_410.Parsetree.popen_expr = (f0 popen_expr); + Ast_410.Parsetree.popen_override = + (copy_override_flag popen_override); + Ast_410.Parsetree.popen_loc = (copy_location popen_loc); + Ast_410.Parsetree.popen_attributes = + (copy_attributes popen_attributes) + } +and copy_override_flag : + Ast_411.Asttypes.override_flag -> Ast_410.Asttypes.override_flag = + function + | Ast_411.Asttypes.Override -> Ast_410.Asttypes.Override + | Ast_411.Asttypes.Fresh -> Ast_410.Asttypes.Fresh +and copy_module_type_declaration : + Ast_411.Parsetree.module_type_declaration -> + Ast_410.Parsetree.module_type_declaration + = + fun + { Ast_411.Parsetree.pmtd_name = pmtd_name; + Ast_411.Parsetree.pmtd_type = pmtd_type; + Ast_411.Parsetree.pmtd_attributes = pmtd_attributes; + Ast_411.Parsetree.pmtd_loc = pmtd_loc } + -> + { + Ast_410.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); + Ast_410.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); + Ast_410.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); + Ast_410.Parsetree.pmtd_loc = (copy_location pmtd_loc) + } +and copy_module_substitution : + Ast_411.Parsetree.module_substitution -> + Ast_410.Parsetree.module_substitution + = + fun + { Ast_411.Parsetree.pms_name = pms_name; + Ast_411.Parsetree.pms_manifest = pms_manifest; + Ast_411.Parsetree.pms_attributes = pms_attributes; + Ast_411.Parsetree.pms_loc = pms_loc } + -> + { + Ast_410.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); + Ast_410.Parsetree.pms_manifest = + (copy_loc copy_Longident_t pms_manifest); + Ast_410.Parsetree.pms_attributes = (copy_attributes pms_attributes); + Ast_410.Parsetree.pms_loc = (copy_location pms_loc) + } +and copy_module_declaration : + Ast_411.Parsetree.module_declaration -> + Ast_410.Parsetree.module_declaration + = + fun + { Ast_411.Parsetree.pmd_name = pmd_name; + Ast_411.Parsetree.pmd_type = pmd_type; + Ast_411.Parsetree.pmd_attributes = pmd_attributes; + Ast_411.Parsetree.pmd_loc = pmd_loc } + -> + { + Ast_410.Parsetree.pmd_name = + (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); + Ast_410.Parsetree.pmd_type = (copy_module_type pmd_type); + Ast_410.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); + Ast_410.Parsetree.pmd_loc = (copy_location pmd_loc) + } +and copy_type_exception : + Ast_411.Parsetree.type_exception -> Ast_410.Parsetree.type_exception = + fun + { Ast_411.Parsetree.ptyexn_constructor = ptyexn_constructor; + Ast_411.Parsetree.ptyexn_loc = ptyexn_loc; + Ast_411.Parsetree.ptyexn_attributes = ptyexn_attributes } + -> + { + Ast_410.Parsetree.ptyexn_constructor = + (copy_extension_constructor ptyexn_constructor); + Ast_410.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); + Ast_410.Parsetree.ptyexn_attributes = + (copy_attributes ptyexn_attributes) + } +and copy_type_extension : + Ast_411.Parsetree.type_extension -> Ast_410.Parsetree.type_extension = + fun + { Ast_411.Parsetree.ptyext_path = ptyext_path; + Ast_411.Parsetree.ptyext_params = ptyext_params; + Ast_411.Parsetree.ptyext_constructors = ptyext_constructors; + Ast_411.Parsetree.ptyext_private = ptyext_private; + Ast_411.Parsetree.ptyext_loc = ptyext_loc; + Ast_411.Parsetree.ptyext_attributes = ptyext_attributes } + -> + { + Ast_410.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); + Ast_410.Parsetree.ptyext_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptyext_params); + Ast_410.Parsetree.ptyext_constructors = + (List.map copy_extension_constructor ptyext_constructors); + Ast_410.Parsetree.ptyext_private = (copy_private_flag ptyext_private); + Ast_410.Parsetree.ptyext_loc = (copy_location ptyext_loc); + Ast_410.Parsetree.ptyext_attributes = + (copy_attributes ptyext_attributes) + } +and copy_extension_constructor : + Ast_411.Parsetree.extension_constructor -> + Ast_410.Parsetree.extension_constructor + = + fun + { Ast_411.Parsetree.pext_name = pext_name; + Ast_411.Parsetree.pext_kind = pext_kind; + Ast_411.Parsetree.pext_loc = pext_loc; + Ast_411.Parsetree.pext_attributes = pext_attributes } + -> + { + Ast_410.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); + Ast_410.Parsetree.pext_kind = + (copy_extension_constructor_kind pext_kind); + Ast_410.Parsetree.pext_loc = (copy_location pext_loc); + Ast_410.Parsetree.pext_attributes = (copy_attributes pext_attributes) + } +and copy_extension_constructor_kind : + Ast_411.Parsetree.extension_constructor_kind -> + Ast_410.Parsetree.extension_constructor_kind + = + function + | Ast_411.Parsetree.Pext_decl (x0, x1) -> + Ast_410.Parsetree.Pext_decl + ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) + | Ast_411.Parsetree.Pext_rebind x0 -> + Ast_410.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) +and copy_type_declaration : + Ast_411.Parsetree.type_declaration -> Ast_410.Parsetree.type_declaration = + fun + { Ast_411.Parsetree.ptype_name = ptype_name; + Ast_411.Parsetree.ptype_params = ptype_params; + Ast_411.Parsetree.ptype_cstrs = ptype_cstrs; + Ast_411.Parsetree.ptype_kind = ptype_kind; + Ast_411.Parsetree.ptype_private = ptype_private; + Ast_411.Parsetree.ptype_manifest = ptype_manifest; + Ast_411.Parsetree.ptype_attributes = ptype_attributes; + Ast_411.Parsetree.ptype_loc = ptype_loc } + -> + { + Ast_410.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); + Ast_410.Parsetree.ptype_params = + (List.map + (fun x -> + let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) + ptype_params); + Ast_410.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_410.Parsetree.ptype_kind = (copy_type_kind ptype_kind); + Ast_410.Parsetree.ptype_private = (copy_private_flag ptype_private); + Ast_410.Parsetree.ptype_manifest = + (Option.map copy_core_type ptype_manifest); + Ast_410.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); + Ast_410.Parsetree.ptype_loc = (copy_location ptype_loc) + } +and copy_private_flag : + Ast_411.Asttypes.private_flag -> Ast_410.Asttypes.private_flag = + function + | Ast_411.Asttypes.Private -> Ast_410.Asttypes.Private + | Ast_411.Asttypes.Public -> Ast_410.Asttypes.Public +and copy_type_kind : + Ast_411.Parsetree.type_kind -> Ast_410.Parsetree.type_kind = + function + | Ast_411.Parsetree.Ptype_abstract -> Ast_410.Parsetree.Ptype_abstract + | Ast_411.Parsetree.Ptype_variant x0 -> + Ast_410.Parsetree.Ptype_variant + (List.map copy_constructor_declaration x0) + | Ast_411.Parsetree.Ptype_record x0 -> + Ast_410.Parsetree.Ptype_record (List.map copy_label_declaration x0) + | Ast_411.Parsetree.Ptype_open -> Ast_410.Parsetree.Ptype_open +and copy_constructor_declaration : + Ast_411.Parsetree.constructor_declaration -> + Ast_410.Parsetree.constructor_declaration + = + fun + { Ast_411.Parsetree.pcd_name = pcd_name; + Ast_411.Parsetree.pcd_args = pcd_args; + Ast_411.Parsetree.pcd_res = pcd_res; + Ast_411.Parsetree.pcd_loc = pcd_loc; + Ast_411.Parsetree.pcd_attributes = pcd_attributes } + -> + { + Ast_410.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); + Ast_410.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); + Ast_410.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); + Ast_410.Parsetree.pcd_loc = (copy_location pcd_loc); + Ast_410.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) + } +and copy_constructor_arguments : + Ast_411.Parsetree.constructor_arguments -> + Ast_410.Parsetree.constructor_arguments + = + function + | Ast_411.Parsetree.Pcstr_tuple x0 -> + Ast_410.Parsetree.Pcstr_tuple (List.map copy_core_type x0) + | Ast_411.Parsetree.Pcstr_record x0 -> + Ast_410.Parsetree.Pcstr_record (List.map copy_label_declaration x0) +and copy_label_declaration : + Ast_411.Parsetree.label_declaration -> Ast_410.Parsetree.label_declaration + = + fun + { Ast_411.Parsetree.pld_name = pld_name; + Ast_411.Parsetree.pld_mutable = pld_mutable; + Ast_411.Parsetree.pld_type = pld_type; + Ast_411.Parsetree.pld_loc = pld_loc; + Ast_411.Parsetree.pld_attributes = pld_attributes } + -> + { + Ast_410.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); + Ast_410.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); + Ast_410.Parsetree.pld_type = (copy_core_type pld_type); + Ast_410.Parsetree.pld_loc = (copy_location pld_loc); + Ast_410.Parsetree.pld_attributes = (copy_attributes pld_attributes) + } +and copy_mutable_flag : + Ast_411.Asttypes.mutable_flag -> Ast_410.Asttypes.mutable_flag = + function + | Ast_411.Asttypes.Immutable -> Ast_410.Asttypes.Immutable + | Ast_411.Asttypes.Mutable -> Ast_410.Asttypes.Mutable +and copy_variance : Ast_411.Asttypes.variance -> Ast_410.Asttypes.variance = + function + | Ast_411.Asttypes.Covariant -> Ast_410.Asttypes.Covariant + | Ast_411.Asttypes.Contravariant -> Ast_410.Asttypes.Contravariant + | Ast_411.Asttypes.Invariant -> Ast_410.Asttypes.Invariant +and copy_value_description : + Ast_411.Parsetree.value_description -> Ast_410.Parsetree.value_description + = + fun + { Ast_411.Parsetree.pval_name = pval_name; + Ast_411.Parsetree.pval_type = pval_type; + Ast_411.Parsetree.pval_prim = pval_prim; + Ast_411.Parsetree.pval_attributes = pval_attributes; + Ast_411.Parsetree.pval_loc = pval_loc } + -> + { + Ast_410.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); + Ast_410.Parsetree.pval_type = (copy_core_type pval_type); + Ast_410.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); + Ast_410.Parsetree.pval_attributes = (copy_attributes pval_attributes); + Ast_410.Parsetree.pval_loc = (copy_location pval_loc) + } +and copy_object_field_desc : + Ast_411.Parsetree.object_field_desc -> Ast_410.Parsetree.object_field_desc + = + function + | Ast_411.Parsetree.Otag (x0, x1) -> + Ast_410.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) + | Ast_411.Parsetree.Oinherit x0 -> + Ast_410.Parsetree.Oinherit (copy_core_type x0) +and copy_arg_label : Ast_411.Asttypes.arg_label -> Ast_410.Asttypes.arg_label + = + function + | Ast_411.Asttypes.Nolabel -> Ast_410.Asttypes.Nolabel + | Ast_411.Asttypes.Labelled x0 -> Ast_410.Asttypes.Labelled x0 + | Ast_411.Asttypes.Optional x0 -> Ast_410.Asttypes.Optional x0 +and copy_closed_flag : + Ast_411.Asttypes.closed_flag -> Ast_410.Asttypes.closed_flag = + function + | Ast_411.Asttypes.Closed -> Ast_410.Asttypes.Closed + | Ast_411.Asttypes.Open -> Ast_410.Asttypes.Open +and copy_label : Ast_411.Asttypes.label -> Ast_410.Asttypes.label = + fun x -> x +and copy_rec_flag : Ast_411.Asttypes.rec_flag -> Ast_410.Asttypes.rec_flag = + function + | Ast_411.Asttypes.Nonrecursive -> Ast_410.Asttypes.Nonrecursive + | Ast_411.Asttypes.Recursive -> Ast_410.Asttypes.Recursive +and copy_constant : Ast_411.Parsetree.constant -> Ast_410.Parsetree.constant + = + function + | Ast_411.Parsetree.Pconst_integer (x0, x1) -> + Ast_410.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) + | Ast_411.Parsetree.Pconst_char x0 -> Ast_410.Parsetree.Pconst_char x0 + | Ast_411.Parsetree.Pconst_string (x0, _, x2) -> + Ast_410.Parsetree.Pconst_string + (x0, (Option.map (fun x -> x) x2)) + | Ast_411.Parsetree.Pconst_float (x0, x1) -> + Ast_410.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) +and copy_Longident_t : Ast_411.Longident.t -> Ast_410.Longident.t = + function + | Ast_411.Longident.Lident x0 -> Ast_410.Longident.Lident x0 + | Ast_411.Longident.Ldot (x0, x1) -> + Ast_410.Longident.Ldot ((copy_Longident_t x0), x1) + | Ast_411.Longident.Lapply (x0, x1) -> + Ast_410.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) +and copy_loc : + 'f0 'g0 . + ('f0 -> 'g0) -> 'f0 Ast_411.Asttypes.loc -> 'g0 Ast_410.Asttypes.loc + = + fun f0 -> + fun { Ast_411.Asttypes.txt = txt; Ast_411.Asttypes.loc = loc } -> + { + Ast_410.Asttypes.txt = (f0 txt); + Ast_410.Asttypes.loc = (copy_location loc) + } +and copy_location : Ast_411.Location.t -> Ast_410.Location.t = + fun + { Ast_411.Location.loc_start = loc_start; + Ast_411.Location.loc_end = loc_end; + Ast_411.Location.loc_ghost = loc_ghost } + -> + { + Ast_410.Location.loc_start = (copy_position loc_start); + Ast_410.Location.loc_end = (copy_position loc_end); + Ast_410.Location.loc_ghost = loc_ghost + } +and copy_position : Lexing.position -> Lexing.position = + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + { + Lexing.pos_fname = pos_fname; + Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; + Lexing.pos_cnum = pos_cnum + } diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.ml new file mode 100644 index 000000000..2c5f47aa2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.ml @@ -0,0 +1,102 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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 Result + +type ast = + | Impl : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.structure = 'concrete) * 'concrete -> ast + | Intf : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.signature = 'concrete) * 'concrete -> ast + +type filename = string + +let magic_length = String.length Ast_402.Config.ast_impl_magic_number + +let read_magic ic = + let buf = Bytes.create magic_length in + let len = input ic buf 0 magic_length in + let s = Bytes.sub_string buf 0 len in + if len = magic_length then + Ok s + else + Error s + +type read_error = + | Not_a_binary_ast of string + | Unknown_version of string + +let find_magic magic = + let rec loop = function + | [] -> + let prefix = String.sub magic 0 9 in + if prefix = String.sub Ast_402.Config.ast_impl_magic_number 0 9 || + prefix = String.sub Ast_402.Config.ast_intf_magic_number 0 9 then + Error (Unknown_version magic) + else + Error (Not_a_binary_ast magic) + | (module Frontend : Migrate_parsetree_versions.OCaml_version) :: tail -> + if Frontend.Ast.Config.ast_impl_magic_number = magic then + Ok (fun x -> Impl ((module Frontend), Obj.obj x)) + else if Frontend.Ast.Config.ast_intf_magic_number = magic then + Ok (fun x -> Intf ((module Frontend), Obj.obj x)) + else + loop tail + in + loop Migrate_parsetree_versions.all_versions + +let from_channel ic = + match read_magic ic with + | Error s -> Error (Not_a_binary_ast s) + | Ok s -> + match find_magic s with + | Ok inj -> + let filename : filename = input_value ic in + let payload = inj (input_value ic) in + Ok (filename, payload) + | Error _ as e -> e + +let from_bytes bytes pos = + if Bytes.length bytes - pos < magic_length then + Error (Not_a_binary_ast "") + else + let magic = Bytes.to_string (Bytes.sub bytes pos magic_length) in + match find_magic magic with + | Ok inj -> + let filename_pos = pos + magic_length in + let filename : filename = Marshal.from_bytes bytes filename_pos in + let payload_pos = filename_pos + Marshal.total_size bytes filename_pos in + let payload = inj (Marshal.from_bytes bytes payload_pos) in + Ok (filename, payload) + | Error _ as e -> e + +let decompose_ast = function + | Impl ((module Frontend), tree) -> + (Frontend.Ast.Config.ast_impl_magic_number, Obj.repr tree) + | Intf ((module Frontend), tree) -> + (Frontend.Ast.Config.ast_intf_magic_number, Obj.repr tree) + +let to_channel oc (filename : filename) x = + let magic_number, payload = decompose_ast x in + output_string oc magic_number; + output_value oc filename; + output_value oc payload + +let to_bytes (filename : filename) x = + let magic_number, payload = decompose_ast x in + Bytes.cat ( + Bytes.cat + (Bytes.of_string magic_number) + (Marshal.to_bytes filename []) + ) (Marshal.to_bytes payload []) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.mli new file mode 100644 index 000000000..d16960f1c --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_ast_io.mli @@ -0,0 +1,50 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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 Result[@@ocaml.warning "-33"] + +(** A marshalled ast packs the ast with the corresponding version of the + frontend *) +type ast = + | Impl : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.structure = 'concrete) * 'concrete -> ast + | Intf : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.signature = 'concrete) * 'concrete -> ast + +(** A simple alias used for the filename of the source that produced an AST *) +type filename = string + +type read_error = + | Not_a_binary_ast of string + (** The input doesn't contain a binary AST. The argument corresponds + to the bytes from the input that were consumed. *) + | Unknown_version of string + (** The input contains a binary AST for an unknown version of OCaml. + The argument is the unknown magic number. *) + +(** Load a marshalled AST from a channel + + Any exception raised during unmarshalling (see [Marshal]) can escape. *) +val from_channel : in_channel -> (filename * ast, read_error) result + +(** Load a marshalled AST from a byte string. + + See [from_channel] description for exception that can be raised. *) +val from_bytes : bytes -> int -> (filename * ast, read_error) result + +(** Marshal an AST to a channel *) +val to_channel : out_channel -> filename -> ast -> unit + +(** Marshal an AST to a byte string *) +val to_bytes : filename -> ast -> bytes diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.ml new file mode 100644 index 000000000..1ce3aaa1f --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.ml @@ -0,0 +1,138 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Errors that can happen when converting constructions that doesn't exist in + older version of the AST. *) +type missing_feature = + | Pexp_letexception + (** 4.04 -> 4.03: local exception, let exception _ in ... *) + | Ppat_open + (** 4.04 -> 4.03: module open in pattern match x with M.(_) -> ... *) + | Pexp_unreachable + (** 4.04 -> 4.03: unreachable pattern -> . *) + | PSig + (** 4.03 -> 4.02: signature in attribute, [@: val x : int] *) + | Pcstr_record + (** 4.03 -> 4.02: inline record *) + | Pconst_integer + (** 4.03 -> 4.02: integer literal with invalid suffix, 1234d *) + | Pconst_float + (** 4.03 -> 4.02: float literal with invalid suffix, 1234.0g *) + | Pcl_open + (** 4.06 -> 4.05: let open M in *) + | Pcty_open + (** 4.06 -> 4.05: let open M in *) + | Oinherit + (** 4.06 -> 4.05: type t = < m : int; u > *) + | Pwith_typesubst_longident + (** 4.06 -> 4.05: T with type X.t := ... *) + | Pwith_modsubst_longident + (** 4.06 -> 4.05: T with module X.Y := ... *) + | Pexp_open + (** 4.08 -> 4.07: open M(N).O *) + | Pexp_letop + (** 4.08 -> 4.07: let* x = ... *) + | Psig_typesubst + (** 4.08 -> 4.07: type t := ... *) + | Psig_modsubst + (** 4.08 -> 4.07: module M := ... *) + | Otyp_module + (** 4.08 -> 4.07: M(N) *) + | Immediate64 + (** 4.10 -> 4.09: [@@immediate64] *) + | Anonymous_let_module + (** 4.10 -> 4.09: let module _ = ... in ... *) + | Anonymous_unpack + (** 4.10 -> 4.09: (module _) *) + | Anonymous_module_binding + (** 4.10 -> 4.09: module _ = ... *) + | Anonymous_module_declaration + (** 4.10 -> 4.09: module _ = struct ... end *) + +exception Migration_error of missing_feature * Location.t + +(** [missing_feature_description x] is a text describing the feature [x]. *) +let missing_feature_description = function + | Pexp_letexception -> "local exceptions" + | Ppat_open -> "module open in patterns" + | Pexp_unreachable -> "unreachable patterns" + | PSig -> "signatures in attribute" + | Pcstr_record -> "inline records" + | Pconst_integer -> "custom integer literals" + | Pconst_float -> "custom float literals" + | Pcl_open -> "module open in class expression" + | Pcty_open -> "module open in class type" + | Oinherit -> "inheritance in object type" + | Pwith_typesubst_longident -> "type substitution inside a submodule" + | Pwith_modsubst_longident -> "module substitution inside a submodule" + | Pexp_open -> "complex open" + | Pexp_letop -> "let operators" + | Psig_typesubst -> "type substitution in signatures" + | Psig_modsubst -> "module substitution in signatures" + | Otyp_module -> "complex outcome module" + | Immediate64 -> "[@@immediate64] attribute" + | Anonymous_let_module -> "anonymous let module" + | Anonymous_unpack -> "anynymous unpack" + | Anonymous_module_binding -> "anonymous module binding" + | Anonymous_module_declaration -> "anonymous module declaration" + +(** [missing_feature_minimal_version x] is the OCaml version where x was + introduced. *) +let missing_feature_minimal_version = function + | Pexp_letexception -> "OCaml 4.04" + | Ppat_open -> "OCaml 4.04" + | Pexp_unreachable -> "OCaml 4.03" + | PSig -> "OCaml 4.03" + | Pcstr_record -> "OCaml 4.03" + | Pconst_integer -> "OCaml 4.03" + | Pconst_float -> "OCaml 4.03" + | Pcl_open -> "OCaml 4.06" + | Pcty_open -> "OCaml 4.06" + | Oinherit -> "OCaml 4.06" + | Pwith_typesubst_longident -> "OCaml 4.06" + | Pwith_modsubst_longident -> "OCaml 4.06" + | Pexp_open -> "OCaml 4.08" + | Pexp_letop -> "OCaml 4.08" + | Psig_typesubst -> "OCaml 4.08" + | Psig_modsubst -> "OCaml 4.08" + | Otyp_module -> "OCaml 4.08" + | Immediate64 -> "OCaml 4.10" + | Anonymous_let_module -> "OCaml 4.10" + | Anonymous_unpack -> "OCaml 4.10" + | Anonymous_module_binding -> "OCaml 4.10" + | Anonymous_module_declaration -> "OCaml 4.10" + +(** Turn a missing feature into a reasonable error message. *) +let migration_error_message x = + let feature = missing_feature_description x in + let version = missing_feature_minimal_version x in + feature ^ " are not supported before " ^ version + +let () = + let location_prefix l = + if l = Location.none then "" else + let {Location.loc_start; loc_end; _} = l in + let bol = loc_start.Lexing.pos_bol in + Printf.sprintf "File %S, line %d, characters %d-%d: " + loc_start.Lexing.pos_fname + loc_start.Lexing.pos_lnum + (loc_start.Lexing.pos_cnum - bol) + (loc_end.Lexing.pos_cnum - bol) + in + Printexc.register_printer (function + | Migration_error (err, loc) -> + Some (location_prefix loc ^ migration_error_message err) + | _ -> None + ) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.mli new file mode 100644 index 000000000..ff7c121b5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_def.mli @@ -0,0 +1,52 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(** Features which are not available in all versions of the frontend *) +type missing_feature = + Pexp_letexception + | Ppat_open + | Pexp_unreachable + | PSig + | Pcstr_record + | Pconst_integer + | Pconst_float + | Pcl_open + | Pcty_open + | Oinherit + | Pwith_typesubst_longident + | Pwith_modsubst_longident + | Pexp_open + | Pexp_letop + | Psig_typesubst + | Psig_modsubst + | Otyp_module + | Immediate64 + | Anonymous_let_module + | Anonymous_unpack + | Anonymous_module_binding + | Anonymous_module_declaration + +(** Exception thrown by migration functions when a feature is not supported. *) +exception Migration_error of missing_feature * Location.t + +(** [missing_feature_description x] is a text describing the feature [x]. *) +val missing_feature_description : missing_feature -> string + +(** [missing_feature_minimal_version x] is the OCaml version where x was + introduced. *) +val missing_feature_minimal_version : missing_feature -> string + +(** Turn a missing feature into a reasonable error message. *) +val migration_error_message : missing_feature -> string diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.ml new file mode 100644 index 000000000..5d1ed626a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.ml @@ -0,0 +1,599 @@ +open Migrate_parsetree_versions +module Ast_io = Migrate_parsetree_ast_io + +(** {1 State a rewriter can access} *) + +type extra = .. + +type config = { + tool_name: string; + include_dirs : string list; + load_path : string list; + debug : bool; + for_package : string option; + extras : extra list; +} + +let make_config ~tool_name ?(include_dirs=[]) ?(load_path=[]) ?(debug=false) + ?for_package ?(extras=[]) () = + { tool_name + ; include_dirs + ; load_path + ; debug + ; for_package + ; extras + } + +type cookie = Cookie : 'types ocaml_version * 'types get_expression -> cookie + +type cookies = (string, cookie) Hashtbl.t + +let create_cookies () = Hashtbl.create 3 + +let global_cookie_table = create_cookies () + +let get_cookie table name version = + match + match Hashtbl.find table name with + | result -> Some result + | exception Not_found -> + match Ast_mapper.get_cookie name with + | Some expr -> Some (Cookie ((module OCaml_current), expr)) + | None -> + match Hashtbl.find global_cookie_table name with + | result -> Some result + | exception Not_found -> None + with + | None -> None + | Some (Cookie (version', expr)) -> + Some ((migrate version' version).copy_expression expr) + +let set_cookie table name version expr = + Hashtbl.replace table name (Cookie (version, expr)) + +let set_global_cookie name version expr = + set_cookie global_cookie_table name version expr + +let apply_cookies table = + Hashtbl.iter (fun name (Cookie (version, expr)) -> + Ast_mapper.set_cookie name + ((migrate version (module OCaml_current)).copy_expression expr) + ) table + +let initial_state () = + { + tool_name = Ast_mapper.tool_name (); + include_dirs = !Clflags.include_dirs; + load_path = Migrate_parsetree_compiler_functions.get_load_paths (); + debug = !Clflags.debug; + for_package = !Clflags.for_package; + extras = []; + } + +(** {1 Registering rewriters} *) + +type 'types rewriter = config -> cookies -> 'types get_mapper + +type rewriter_group = + Rewriters : 'types ocaml_version * (string * 'types rewriter) list -> rewriter_group + +let rewriter_group_names (Rewriters (_, l)) = List.map fst l + +let uniq_rewriter = Hashtbl.create 7 +module Pos_map = Map.Make(struct + type t = int + let compare : int -> int -> t = compare + end) +let registered_rewriters = ref Pos_map.empty + +let all_rewriters () = + Pos_map.bindings !registered_rewriters + |> List.map (fun (_, r) -> !r) + |> List.concat + +let uniq_arg = Hashtbl.create 7 +let registered_args_reset = ref [] +let registered_args = ref [] + +let () = + let set_cookie s = + match String.index s '=' with + | exception _ -> + raise (Arg.Bad "invalid cookie, must be of the form \"=\"") + | i -> + let name = String.sub s 0 i in + let value = String.sub s (i + 1) (String.length s - i - 1) in + let input_name = "" in + Location.input_name := input_name; + let lexbuf = Lexing.from_string value in + lexbuf.Lexing.lex_curr_p <- + { Lexing. + pos_fname = input_name + ; pos_lnum = 1 + ; pos_bol = 0 + ; pos_cnum = 0 + }; + let expr = Parse.expression lexbuf in + set_global_cookie name (module OCaml_current) expr + in + registered_args := + ("--cookie", Arg.String set_cookie, + "NAME=EXPR Set the cookie NAME to EXPR") :: !registered_args + +type ('types, 'version, 'rewriter) is_rewriter = + | Is_rewriter : ('types, 'types ocaml_version, 'types rewriter) is_rewriter + +let add_rewriter + (type types) (type version) (type rewriter) + (Is_rewriter : (types, version, rewriter) is_rewriter) + (version : version) name (rewriter : rewriter) = + let rec add_rewriter = function + | [] -> [Rewriters (version, [name, rewriter])] + | (Rewriters (version', rewriters) as x) :: xs -> + match compare_ocaml_version version version' with + | Eq -> Rewriters (version', (name, rewriter) :: rewriters) :: xs + | Lt -> Rewriters (version, [name, rewriter]) :: x :: xs + | Gt -> x :: add_rewriter xs + in + add_rewriter + +let register ~name ?reset_args ?(args=[]) ?(position=0) version rewriter = + (* Validate name *) + if name = "" then + invalid_arg "Migrate_parsetree_driver.register: name is empty"; + if Hashtbl.mem uniq_rewriter name then + invalid_arg ("Migrate_parsetree_driver.register: rewriter " ^ name ^ " has already been registered") + else Hashtbl.add uniq_rewriter name (); + (* Validate arguments *) + List.iter (fun (arg_name, _, _) -> + match Hashtbl.find uniq_arg arg_name with + | other_rewriter -> + invalid_arg (Printf.sprintf + "Migrate_parsetree_driver.register: argument %s is used by %s and %s" arg_name name other_rewriter) + | exception Not_found -> + Hashtbl.add uniq_arg arg_name name + ) args; + (* Register *) + begin match reset_args with + | None -> () + | Some f -> registered_args_reset := f :: !registered_args_reset + end; + registered_args := List.rev_append args !registered_args; + let r = + try + Pos_map.find position !registered_rewriters + with Not_found -> + let r = ref [] in + registered_rewriters := Pos_map.add position r !registered_rewriters; + r + in + r := add_rewriter Is_rewriter version name rewriter !r + +let registered_args () = List.rev !registered_args +let reset_args () = List.iter (fun f -> f ()) !registered_args_reset + +(** {1 Accessing or running registered rewriters} *) + +type ('types, 'version, 'tree) is_signature = + Signature : ('types, 'types ocaml_version, 'types get_signature) is_signature + +type ('types, 'version, 'tree) is_structure = + Structure : ('types, 'types ocaml_version, 'types get_structure) is_structure + +type some_structure = + | Str : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.structure = 'concrete) * 'concrete -> some_structure + +type some_signature = + | Sig : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.signature = 'concrete) * 'concrete -> some_signature + +let migrate_some_structure dst (Str ((module Version), st)) = + (migrate (module Version) dst).copy_structure st + +let migrate_some_signature dst (Sig ((module Version), sg)) = + (migrate (module Version) dst).copy_signature sg + +let rec rewrite_signature + : type types version tree. + config -> cookies -> + (types, version, tree) is_signature -> version -> tree -> + rewriter_group list -> some_signature + = fun (type types) (type version) (type tree) + config cookies + (Signature : (types, version, tree) is_signature) + (version : version) + (tree : tree) + -> function + | [] -> + let (module Version) = version in + Sig ((module Version), tree) + | Rewriters (version', rewriters) :: rest -> + let rewrite (_name, rewriter) tree = + let (module Version) = version' in + Version.Ast.map_signature (rewriter config cookies) tree + in + let tree = (migrate version version').copy_signature tree in + let tree = List.fold_right rewrite rewriters tree in + rewrite_signature config cookies Signature version' tree rest + +let rewrite_signature config version sg = + let cookies = create_cookies () in + let sg = + rewrite_signature config cookies Signature version sg + (all_rewriters ()) + in + apply_cookies cookies; + sg + +let rec rewrite_structure + : type types version tree. + config -> cookies -> + (types, version, tree) is_structure -> version -> tree -> + rewriter_group list -> some_structure + = fun (type types) (type version) (type tree) + config cookies + (Structure : (types, version, tree) is_structure) + (version : version) + (tree : tree) + -> function + | [] -> + let (module Version) = version in + Str ((module Version), tree) + | Rewriters (version', rewriters) :: rest -> + let rewriter (_name, rewriter) tree = + let (module Version) = version' in + Version.Ast.map_structure (rewriter config cookies) tree + in + let tree = (migrate version version').copy_structure tree in + let tree = List.fold_right rewriter rewriters tree in + rewrite_structure config cookies Structure version' tree rest + +let rewrite_structure config version st = + let cookies = create_cookies () in + let st = + rewrite_structure config cookies Structure version st + (all_rewriters ()) + in + apply_cookies cookies; + st + +let exit_or_raise ~exit_on_error f = + if not exit_on_error then + f () + else + try + f () + with + | Arg.Help text -> + print_string text; + exit 0 + | Arg.Bad text -> + prerr_string text; + exit 2 + | exn -> + Location.report_exception Format.err_formatter exn; + exit 1 + +let run_as_ast_mapper ?(exit_on_error = true) args = + let spec = registered_args () in + let args, usage = + let me = Filename.basename Sys.executable_name in + let args = match args with "--as-ppx" :: args -> args | args -> args in + (Array.of_list (me :: args), + Printf.sprintf "%s [options] " me) + in + reset_args (); + exit_or_raise ~exit_on_error begin fun () -> + Arg.parse_argv ~current:(ref 0) args spec + (fun arg -> raise (Arg.Bad (Printf.sprintf "invalid argument %S" arg))) + usage; + OCaml_current.Ast.make_top_mapper + ~signature:(fun sg -> + let config = initial_state () in + rewrite_signature config (module OCaml_current) sg + |> migrate_some_signature (module OCaml_current) + ) + ~structure:(fun str -> + let config = initial_state () in + rewrite_structure config (module OCaml_current) str + |> migrate_some_structure (module OCaml_current) + ) + end + +let protectx x ~finally ~f = + match f x with + | y -> finally x; y + | exception e -> finally x; raise e + +let with_file_in fn ~f = + protectx (open_in_bin fn) ~finally:close_in ~f + +let with_file_out fn ~f = + protectx (open_out_bin fn) ~finally:close_out ~f + +type ('a, 'b) intf_or_impl = + | Intf of 'a + | Impl of 'b + +type file_kind = + | Kind_intf + | Kind_impl + | Kind_unknown + +let guess_file_kind fn = + if Filename.check_suffix fn ".ml" then + Kind_impl + else if Filename.check_suffix fn ".mli" then + Kind_intf + else + Kind_unknown + +let check_kind fn ~expected ~got = + let describe = function + | Kind_intf -> "interface" + | Kind_impl -> "implementation" + | Kind_unknown -> "unknown file" + in + match expected, got with + | Kind_impl, Kind_impl + | Kind_intf, Kind_intf + | Kind_unknown, _ -> () + | _ -> + Location.raise_errorf ~loc:(Location.in_file fn) + "Expected an %s got an %s instead" + (describe expected) + (describe got) + +let load_file (kind, fn) = + with_file_in fn ~f:(fun ic -> + match Ast_io.from_channel ic with + | Ok (fn, Ast_io.Intf ((module V), sg)) -> + check_kind fn ~expected:kind ~got:Kind_intf; + Location.input_name := fn; + (* We need to convert to the current version in order to interpret the cookies using + [Ast_mapper.drop_ppx_context_*] from the compiler *) + let sg = (migrate (module V) (module OCaml_current)).copy_signature sg in + let migrate_back sg = + Ast_io.Intf + ((module V), + (migrate (module OCaml_current) (module V)).copy_signature sg) + in + (fn, Intf (sg, migrate_back)) + | Ok (fn, Ast_io.Impl ((module V), st)) -> + check_kind fn ~expected:kind ~got:Kind_impl; + Location.input_name := fn; + let st = (migrate (module V) (module OCaml_current)).copy_structure st in + let migrate_back st = + Ast_io.Impl + ((module V), + (migrate (module OCaml_current) (module V)).copy_structure st) + in + (fn, Impl (st, migrate_back)) + | Error (Ast_io.Unknown_version _) -> + Location.raise_errorf ~loc:(Location.in_file fn) + "File is a binary ast for an unknown version of OCaml" + | Error (Ast_io.Not_a_binary_ast prefix_read_from_file) -> + (* To test if a file is a binary AST file, we have to read the first few bytes of + the file. + + If it is not a binary AST, we have to parse these bytes and the rest of the file + as source code. To do that, we prefill the lexbuf buffer with what we read from + the file to do the test. *) + let lexbuf = Lexing.from_channel ic in + let len = String.length prefix_read_from_file in + String.blit prefix_read_from_file 0 lexbuf.Lexing.lex_buffer 0 len; + lexbuf.Lexing.lex_buffer_len <- len; + lexbuf.Lexing.lex_curr_p <- + { Lexing. + pos_fname = fn + ; pos_lnum = 1 + ; pos_bol = 0 + ; pos_cnum = 0 + }; + Location.input_name := fn; + let kind = + match kind with + | Kind_impl -> Kind_impl + | Kind_intf -> Kind_intf + | Kind_unknown -> guess_file_kind fn + in + match kind with + | Kind_impl -> + let migrate_back st = Ast_io.Impl ((module OCaml_current), st) in + (fn, Impl (Parse.implementation lexbuf, migrate_back)) + | Kind_intf -> + let migrate_back sg = Ast_io.Intf ((module OCaml_current), sg) in + (fn, Intf (Parse.interface lexbuf, migrate_back)) + | Kind_unknown -> + Location.raise_errorf ~loc:(Location.in_file fn) + "I can't decide whether %s is an implementation or interface file" + fn) + +let with_output ?bin output ~f = + match output with + | None -> + begin match bin with + | Some bin -> set_binary_mode_out stdout bin + | None -> () + end; + f stdout + | Some fn -> with_file_out fn ~f + +type output_mode = + | Pretty_print + | Dump_ast + | Null + +let process_file ~config ~output ~output_mode ~embed_errors file = + let fn, ast = load_file file in + let ast, binary_ast = + match ast with + | Intf (sg, migrate_back) -> + let sg = Ast_mapper.drop_ppx_context_sig ~restore:true sg in + let sg = + try + rewrite_signature config (module OCaml_current) sg + |> migrate_some_signature (module OCaml_current) + with exn when embed_errors -> + match Migrate_parsetree_compiler_functions.error_of_exn exn with + | None -> raise exn + | Some error -> + [ Ast_helper.Sig.extension ~loc:Location.none + (Ast_mapper.extension_of_error error) ] + in + let binary_sg = + Ast_mapper.add_ppx_context_sig ~tool_name:config.tool_name sg in + (Intf sg, migrate_back binary_sg) + | Impl (st, migrate_back) -> + let st = Ast_mapper.drop_ppx_context_str ~restore:true st in + let st = + try + rewrite_structure config (module OCaml_current) st + |> migrate_some_structure (module OCaml_current) + with exn when embed_errors -> + match Migrate_parsetree_compiler_functions.error_of_exn exn with + | None -> raise exn + | Some error -> + [ Ast_helper.Str.extension ~loc:Location.none + (Ast_mapper.extension_of_error error) ] + in + let binary_st = + Ast_mapper.add_ppx_context_str ~tool_name:config.tool_name st in + (Impl st, migrate_back binary_st) + in + match output_mode with + | Dump_ast -> + with_output ~bin:true output ~f:(fun oc -> + Ast_io.to_channel oc fn binary_ast) + | Pretty_print -> + with_output output ~f:(fun oc -> + let ppf = Format.formatter_of_out_channel oc in + (match ast with + | Intf sg -> Pprintast.signature ppf sg + | Impl st -> Pprintast.structure ppf st); + Format.pp_print_newline ppf ()) + | Null -> + () + +let print_transformations () = + let print_group name = function + | [] -> () + | names -> + Printf.printf "%s:\n" name; + List.iter (Printf.printf "%s\n") names + in + all_rewriters () + |> List.map rewriter_group_names + |> List.concat + |> print_group "Registered Transformations"; + Ppx_derivers.derivers () + |> List.map (fun (x, _) -> x) + |> print_group "Registered Derivers" + + +let run_as_standalone_driver ~exit_on_error argv = + let request_print_transformations = ref false in + let output = ref None in + let output_mode = ref Pretty_print in + let output_mode_arg = ref "" in + let files = ref [] in + let embed_errors = ref false in + let embed_errors_arg = ref "" in + let spec = + let fail fmt = Printf.ksprintf (fun s -> raise (Arg.Bad s)) fmt in + let incompatible a b = fail "%s and %s are incompatible" a b in + let as_ppx () = fail "--as-ppx must be passed as first argument" in + let set_embed_errors arg = + if !output_mode = Null then incompatible !output_mode_arg arg; + embed_errors := true; + embed_errors_arg := arg + in + let set_output_mode arg mode = + match !output_mode, mode with + | Pretty_print, _ -> + if mode = Null && !embed_errors then + incompatible !embed_errors_arg arg; + if mode = Null && !output <> None then + incompatible "-o" arg; + output_mode := mode; + output_mode_arg := arg + | _, Pretty_print -> assert false + | Dump_ast, Dump_ast | Null, Null -> () + | _ -> incompatible !output_mode_arg arg + in + let set_output fn = + if !output_mode = Null then incompatible !output_mode_arg "-o"; + output := Some fn + in + let as_pp () = + let arg = "--as-pp" in + set_output_mode arg Dump_ast; + set_embed_errors arg + in + [ "--as-ppx", Arg.Unit as_ppx, + " Act as a -ppx rewriter" + ; "--as-pp", Arg.Unit as_pp, + " Shorthand for: --dump-ast --embed-errors" + ; "--dump-ast", Arg.Unit (fun () -> set_output_mode "--dump-ast" Dump_ast), + " Output a binary AST instead of source code" + ; "--null", Arg.Unit (fun () -> set_output_mode "--null" Null), + " Output nothing, just report errors" + ; "-o", Arg.String set_output, + "FILE Output to this file instead of the standard output" + ; "--intf", Arg.String (fun fn -> files := (Kind_intf, fn) :: !files), + "FILE Treat FILE as a .mli file" + ; "--impl", Arg.String (fun fn -> files := (Kind_impl, fn) :: !files), + "FILE Treat FILE as a .ml file" + ; "--embed-errors", Arg.Unit (fun () -> set_embed_errors "--embed-errors"), + " Embed error reported by rewriters into the AST" + ; "--print-transformations", Arg.Set request_print_transformations, + " Print registered transformations in their order of executions" + ] + in + let spec = Arg.align (spec @ registered_args ()) in + let me = Filename.basename Sys.executable_name in + let usage = Printf.sprintf "%s [options] []" me in + exit_or_raise ~exit_on_error begin fun () -> + reset_args (); + Arg.parse_argv ~current:(ref 0) argv spec (fun anon -> + files := (Kind_unknown, anon) :: !files) usage; + if !request_print_transformations then + print_transformations () + else + let output = !output in + let output_mode = !output_mode in + let embed_errors = !embed_errors in + let config = + (* TODO: we could add -I, -L and -g options to populate these fields. *) + { tool_name = "migrate_driver" + ; include_dirs = [] + ; load_path = [] + ; debug = false + ; for_package = None + ; extras = [] + } + in + List.iter (process_file ~config ~output ~output_mode ~embed_errors) + (List.rev !files) + end + +let run_as_ppx_rewriter ?(exit_on_error = true) ?(argv = Sys.argv) () = + let a = argv in + let n = Array.length a in + exit_or_raise ~exit_on_error begin fun () -> + if n <= 2 then begin + let me = Filename.basename Sys.executable_name in + Arg.usage_string (registered_args ()) + (Printf.sprintf "%s [options] " me); + |> fun s -> raise (Arg.Bad s) + end; + Ast_mapper.apply ~source:a.(n - 2) ~target:a.(n - 1) + (run_as_ast_mapper (Array.to_list (Array.sub a 1 (n - 3)))) + end + +let run_main ?(exit_on_error = true) ?(argv = Sys.argv) () = + if Array.length argv >= 2 && argv.(1) = "--as-ppx" then + run_as_ppx_rewriter ~exit_on_error ~argv () + else + run_as_standalone_driver ~exit_on_error argv diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.mli new file mode 100644 index 000000000..11a0bebfa --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver.mli @@ -0,0 +1,113 @@ +open Migrate_parsetree_versions + +(** {1 State a rewriter can access} *) + +type extra = .. + +type config = { + tool_name : string; + include_dirs : string list; + load_path : string list; + debug : bool; + for_package : string option; + (** Additional parameters that can be passed by a caller of + [rewrite_{signature,structure}] to a specific register rewriter. *) + extras : extra list; +} + +val make_config + : tool_name:string + -> ?include_dirs:string list + -> ?load_path:string list + -> ?debug:bool + -> ?for_package:string + -> ?extras:extra list + -> unit + -> config + +type cookies + +val get_cookie + : cookies + -> string + -> 'types ocaml_version -> 'types get_expression option + +val set_cookie + : cookies + -> string + -> 'types ocaml_version -> 'types get_expression + -> unit + +val set_global_cookie + : string + -> 'types ocaml_version -> 'types get_expression + -> unit + +(** {1 Registering rewriters} *) + +type 'types rewriter = config -> cookies -> 'types get_mapper + +(** Register a ppx rewriter. [position] is a integer that indicates + when the ppx rewriter should be applied. It is guaranteed that if + two ppx rewriters [a] and [b] have different position numbers, then + the one with the lowest number will be applied first. The rewriting + order of ppx rewriters with the same position number is not + specified. The default position is [0]. + + Note that more different position numbers means more AST + conversions and slower rewriting, so think twice before setting + [position] to a non-zero number. +*) +val register + : name:string + -> ?reset_args:(unit -> unit) -> ?args:(Arg.key * Arg.spec * Arg.doc) list + -> ?position:int + -> 'types ocaml_version -> 'types rewriter + -> unit + +(** Return the list of command line arguments registered by rewriters *) +val registered_args : unit -> (Arg.key * Arg.spec * Arg.doc) list + +(** Call all the registered [reset_args] callbacks *) +val reset_args : unit -> unit + +(** {1 Running registered rewriters} *) + +val run_as_ast_mapper : ?exit_on_error:bool -> string list -> Ast_mapper.mapper + +val run_as_ppx_rewriter : + ?exit_on_error:bool -> ?argv:string array -> unit -> unit + +val run_main : ?exit_on_error:bool -> ?argv:string array -> unit -> unit + +(** {1 Manual mapping} *) + +type some_signature = + | Sig : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.signature = 'concrete) * 'concrete -> some_signature + +type some_structure = + | Str : (module Migrate_parsetree_versions.OCaml_version with + type Ast.Parsetree.structure = 'concrete) * 'concrete -> some_structure + +val migrate_some_signature + : 'version ocaml_version + -> some_signature + -> 'version get_signature + +val migrate_some_structure + : 'version ocaml_version + -> some_structure + -> 'version get_structure + +val rewrite_signature + : config + -> 'version ocaml_version + -> 'version get_signature + -> some_signature + +val rewrite_structure + : config + -> 'version ocaml_version + -> 'version get_structure + -> some_structure diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver_main.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver_main.ml new file mode 100644 index 000000000..354b225fb --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_driver_main.ml @@ -0,0 +1 @@ +let () = Reason_migrate_parsetree.Driver.run_main () diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.ml new file mode 100644 index 000000000..e2aef0d27 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.ml @@ -0,0 +1,53 @@ + +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* Parser entry points that migrate to a specified version of OCaml. + + The parser used is the one from current compiler-libs. The resulting AST is + then converted to the desired version. + + These parsing functions can raise Migration_errors. +*) + +open Migrate_parsetree_versions + +let implementation version = + let { copy_structure; _ } = migrate ocaml_current version in + fun lexbuf -> copy_structure (Parse.implementation lexbuf) + +let interface version = + let { copy_signature; _ } = migrate ocaml_current version in + fun lexbuf -> copy_signature (Parse.interface lexbuf) + +let toplevel_phrase version = + let { copy_toplevel_phrase; _ } = migrate ocaml_current version in + fun lexbuf -> copy_toplevel_phrase (Parse.toplevel_phrase lexbuf) + +let use_file version = + let { copy_toplevel_phrase; _ } = migrate ocaml_current version in + fun lexbuf -> List.map copy_toplevel_phrase (Parse.use_file lexbuf) + +let core_type version = + let { copy_core_type; _ } = migrate ocaml_current version in + fun lexbuf -> copy_core_type (Parse.core_type lexbuf) + +let expression version = + let { copy_expression; _ } = migrate ocaml_current version in + fun lexbuf -> copy_expression (Parse.expression lexbuf) + +let pattern version = + let { copy_pattern; _ } = migrate ocaml_current version in + fun lexbuf -> copy_pattern (Parse.pattern lexbuf) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.mli new file mode 100644 index 000000000..7d0ad48ad --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_parse.mli @@ -0,0 +1,32 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* Parser entry points that migrate to a specified version of OCaml. + + The parser used is the one from current compiler-libs. The resulting AST is + then converted to the desired version. + + These parsing functions can raise Migration_errors. +*) + +open Migrate_parsetree_versions + +val implementation : 'types ocaml_version -> Lexing.lexbuf -> 'types get_structure +val interface : 'types ocaml_version -> Lexing.lexbuf -> 'types get_signature +val toplevel_phrase : 'types ocaml_version -> Lexing.lexbuf -> 'types get_toplevel_phrase +val use_file : 'types ocaml_version -> Lexing.lexbuf -> 'types get_toplevel_phrase list +val core_type : 'types ocaml_version -> Lexing.lexbuf -> 'types get_core_type +val expression : 'types ocaml_version -> Lexing.lexbuf -> 'types get_expression +val pattern : 'types ocaml_version -> Lexing.lexbuf -> 'types get_pattern diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.ml new file mode 100644 index 000000000..229cc19a1 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.ml @@ -0,0 +1,761 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(* BEGIN of BLACK MAGIC *) +(*$ #use "src/cinaps_helpers" $*) + +type _ witnesses = .. + +type _ migration = .. +type _ migration += Undefined : _ migration + +type 'a migration_info = { + mutable next_version : 'a migration; + mutable previous_version : 'a migration; +} + +(** Abstract view of a version of an OCaml Ast *) +module type Ast = sig + (*$ foreach_module (fun m types -> + printf "module %s : sig\n" m; + List.iter types ~f:(printf "type %s\n"); + printf "end\n" + ) + *) + module Parsetree : sig + type structure + type signature + type toplevel_phrase + type core_type + type expression + type pattern + type case + type type_declaration + type type_extension + type extension_constructor + end + module Outcometree : sig + type out_value + type out_type + type out_class_type + type out_module_type + type out_sig_item + type out_type_extension + type out_phrase + end + module Ast_mapper : sig + type mapper + end + (*$*) + module Config : sig + val ast_impl_magic_number : string + val ast_intf_magic_number : string + end + val shallow_identity : Ast_mapper.mapper + val map_signature : Ast_mapper.mapper -> Parsetree.signature -> Parsetree.signature + val map_structure : Ast_mapper.mapper -> Parsetree.structure -> Parsetree.structure + val make_top_mapper + : signature:(Parsetree.signature -> Parsetree.signature) + -> structure:(Parsetree.structure -> Parsetree.structure) + -> Ast_mapper.mapper +end + +(* Shortcuts for talking about ast types outside of the module language *) + +type 'a _types = 'a constraint 'a + = < + (*$ foreach_type (fun _ s -> printf "%-21s : _;\n" s) *) + structure : _; + signature : _; + toplevel_phrase : _; + core_type : _; + expression : _; + pattern : _; + case : _; + type_declaration : _; + type_extension : _; + extension_constructor : _; + out_value : _; + out_type : _; + out_class_type : _; + out_module_type : _; + out_sig_item : _; + out_type_extension : _; + out_phrase : _; + mapper : _; + (*$*) + > +;; + +(*$ foreach_type (fun _ s -> + printf "type 'a get_%s =\n" s; + printf " 'x constraint 'a _types = < %s : 'x; .. >\n" s + ) *) +type 'a get_structure = + 'x constraint 'a _types = < structure : 'x; .. > +type 'a get_signature = + 'x constraint 'a _types = < signature : 'x; .. > +type 'a get_toplevel_phrase = + 'x constraint 'a _types = < toplevel_phrase : 'x; .. > +type 'a get_core_type = + 'x constraint 'a _types = < core_type : 'x; .. > +type 'a get_expression = + 'x constraint 'a _types = < expression : 'x; .. > +type 'a get_pattern = + 'x constraint 'a _types = < pattern : 'x; .. > +type 'a get_case = + 'x constraint 'a _types = < case : 'x; .. > +type 'a get_type_declaration = + 'x constraint 'a _types = < type_declaration : 'x; .. > +type 'a get_type_extension = + 'x constraint 'a _types = < type_extension : 'x; .. > +type 'a get_extension_constructor = + 'x constraint 'a _types = < extension_constructor : 'x; .. > +type 'a get_out_value = + 'x constraint 'a _types = < out_value : 'x; .. > +type 'a get_out_type = + 'x constraint 'a _types = < out_type : 'x; .. > +type 'a get_out_class_type = + 'x constraint 'a _types = < out_class_type : 'x; .. > +type 'a get_out_module_type = + 'x constraint 'a _types = < out_module_type : 'x; .. > +type 'a get_out_sig_item = + 'x constraint 'a _types = < out_sig_item : 'x; .. > +type 'a get_out_type_extension = + 'x constraint 'a _types = < out_type_extension : 'x; .. > +type 'a get_out_phrase = + 'x constraint 'a _types = < out_phrase : 'x; .. > +type 'a get_mapper = + 'x constraint 'a _types = < mapper : 'x; .. > +(*$*) + +module type OCaml_version = sig + module Ast : Ast + val version : int + val string_version : string + type types = < + (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s)*) + structure : Ast.Parsetree.structure; + signature : Ast.Parsetree.signature; + toplevel_phrase : Ast.Parsetree.toplevel_phrase; + core_type : Ast.Parsetree.core_type; + expression : Ast.Parsetree.expression; + pattern : Ast.Parsetree.pattern; + case : Ast.Parsetree.case; + type_declaration : Ast.Parsetree.type_declaration; + type_extension : Ast.Parsetree.type_extension; + extension_constructor : Ast.Parsetree.extension_constructor; + out_value : Ast.Outcometree.out_value; + out_type : Ast.Outcometree.out_type; + out_class_type : Ast.Outcometree.out_class_type; + out_module_type : Ast.Outcometree.out_module_type; + out_sig_item : Ast.Outcometree.out_sig_item; + out_type_extension : Ast.Outcometree.out_type_extension; + out_phrase : Ast.Outcometree.out_phrase; + mapper : Ast.Ast_mapper.mapper; + (*$*) + > _types + type _ witnesses += Version : types witnesses + val migration_info : types migration_info +end + +module Make_witness(Ast : Ast) = +struct + type types = < + (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s)*) + structure : Ast.Parsetree.structure; + signature : Ast.Parsetree.signature; + toplevel_phrase : Ast.Parsetree.toplevel_phrase; + core_type : Ast.Parsetree.core_type; + expression : Ast.Parsetree.expression; + pattern : Ast.Parsetree.pattern; + case : Ast.Parsetree.case; + type_declaration : Ast.Parsetree.type_declaration; + type_extension : Ast.Parsetree.type_extension; + extension_constructor : Ast.Parsetree.extension_constructor; + out_value : Ast.Outcometree.out_value; + out_type : Ast.Outcometree.out_type; + out_class_type : Ast.Outcometree.out_class_type; + out_module_type : Ast.Outcometree.out_module_type; + out_sig_item : Ast.Outcometree.out_sig_item; + out_type_extension : Ast.Outcometree.out_type_extension; + out_phrase : Ast.Outcometree.out_phrase; + mapper : Ast.Ast_mapper.mapper; + (*$*) + > _types + type _ witnesses += Version : types witnesses + let migration_info : types migration_info = + { next_version = Undefined; previous_version = Undefined } +end + +type 'types ocaml_version = + (module OCaml_version + (*$ let sep = with_then_and () in + foreach_type (fun m s -> + printf "%t type Ast.%s.%s = 'types get_%s\n" sep m s s) *) + with type Ast.Parsetree.structure = 'types get_structure + and type Ast.Parsetree.signature = 'types get_signature + and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase + and type Ast.Parsetree.core_type = 'types get_core_type + and type Ast.Parsetree.expression = 'types get_expression + and type Ast.Parsetree.pattern = 'types get_pattern + and type Ast.Parsetree.case = 'types get_case + and type Ast.Parsetree.type_declaration = 'types get_type_declaration + and type Ast.Parsetree.type_extension = 'types get_type_extension + and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor + and type Ast.Outcometree.out_value = 'types get_out_value + and type Ast.Outcometree.out_type = 'types get_out_type + and type Ast.Outcometree.out_class_type = 'types get_out_class_type + and type Ast.Outcometree.out_module_type = 'types get_out_module_type + and type Ast.Outcometree.out_sig_item = 'types get_out_sig_item + and type Ast.Outcometree.out_type_extension = 'types get_out_type_extension + and type Ast.Outcometree.out_phrase = 'types get_out_phrase + and type Ast.Ast_mapper.mapper = 'types get_mapper + (*$*) + ) + +type ('a, 'b) type_comparison = + | Lt : ('a, 'b) type_comparison + | Eq : ('a, 'a) type_comparison + | Gt : ('a, 'b) type_comparison + +let compare_ocaml_version + (*$ foreach_type (fun _ s -> printf "(type %s1) (type %s2)\n" s s) *) + (type structure1) (type structure2) + (type signature1) (type signature2) + (type toplevel_phrase1) (type toplevel_phrase2) + (type core_type1) (type core_type2) + (type expression1) (type expression2) + (type pattern1) (type pattern2) + (type case1) (type case2) + (type type_declaration1) (type type_declaration2) + (type type_extension1) (type type_extension2) + (type extension_constructor1) (type extension_constructor2) + (type out_value1) (type out_value2) + (type out_type1) (type out_type2) + (type out_class_type1) (type out_class_type2) + (type out_module_type1) (type out_module_type2) + (type out_sig_item1) (type out_sig_item2) + (type out_type_extension1) (type out_type_extension2) + (type out_phrase1) (type out_phrase2) + (type mapper1) (type mapper2) + (*$*) + ((module A) : < + (*$ foreach_type (fun _ s -> printf "%-21s : %s1;\n" s s) *) + structure : structure1; + signature : signature1; + toplevel_phrase : toplevel_phrase1; + core_type : core_type1; + expression : expression1; + pattern : pattern1; + case : case1; + type_declaration : type_declaration1; + type_extension : type_extension1; + extension_constructor : extension_constructor1; + out_value : out_value1; + out_type : out_type1; + out_class_type : out_class_type1; + out_module_type : out_module_type1; + out_sig_item : out_sig_item1; + out_type_extension : out_type_extension1; + out_phrase : out_phrase1; + mapper : mapper1; + (*$*) + > ocaml_version) + ((module B) : < + (*$ foreach_type (fun _ s -> printf "%-21s : %s2;\n" s s) *) + structure : structure2; + signature : signature2; + toplevel_phrase : toplevel_phrase2; + core_type : core_type2; + expression : expression2; + pattern : pattern2; + case : case2; + type_declaration : type_declaration2; + type_extension : type_extension2; + extension_constructor : extension_constructor2; + out_value : out_value2; + out_type : out_type2; + out_class_type : out_class_type2; + out_module_type : out_module_type2; + out_sig_item : out_sig_item2; + out_type_extension : out_type_extension2; + out_phrase : out_phrase2; + mapper : mapper2; + (*$*) + > ocaml_version) + : (A.types, B.types) type_comparison + = + match A.Version with + | B.Version -> Eq + | _ when A.version < B.version -> Lt + | _ when A.version > B.version -> Gt + | _ -> assert false + +type ('from, 'to_) migration_functions = { + (*$ foreach_type (fun _ s -> + printf "copy_%s: 'from get_%s -> 'to_ get_%s;\n" s s s) *) + copy_structure: 'from get_structure -> 'to_ get_structure; + copy_signature: 'from get_signature -> 'to_ get_signature; + copy_toplevel_phrase: 'from get_toplevel_phrase -> 'to_ get_toplevel_phrase; + copy_core_type: 'from get_core_type -> 'to_ get_core_type; + copy_expression: 'from get_expression -> 'to_ get_expression; + copy_pattern: 'from get_pattern -> 'to_ get_pattern; + copy_case: 'from get_case -> 'to_ get_case; + copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration; + copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension; + copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor; + copy_out_value: 'from get_out_value -> 'to_ get_out_value; + copy_out_type: 'from get_out_type -> 'to_ get_out_type; + copy_out_class_type: 'from get_out_class_type -> 'to_ get_out_class_type; + copy_out_module_type: 'from get_out_module_type -> 'to_ get_out_module_type; + copy_out_sig_item: 'from get_out_sig_item -> 'to_ get_out_sig_item; + copy_out_type_extension: 'from get_out_type_extension -> 'to_ get_out_type_extension; + copy_out_phrase: 'from get_out_phrase -> 'to_ get_out_phrase; + copy_mapper: 'from get_mapper -> 'to_ get_mapper; + (*$*) +} + +let id x = x +let migration_identity : ('a, 'a) migration_functions = { + (*$ foreach_type (fun _ s -> printf "copy_%s = id;\n" s) *) + copy_structure = id; + copy_signature = id; + copy_toplevel_phrase = id; + copy_core_type = id; + copy_expression = id; + copy_pattern = id; + copy_case = id; + copy_type_declaration = id; + copy_type_extension = id; + copy_extension_constructor = id; + copy_out_value = id; + copy_out_type = id; + copy_out_class_type = id; + copy_out_module_type = id; + copy_out_sig_item = id; + copy_out_type_extension = id; + copy_out_phrase = id; + copy_mapper = id; + (*$*) +} + +let compose f g x = f (g x) +let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migration_functions) : ('a, 'c) migration_functions = { + (*$ foreach_type (fun _ s -> + printf "copy_%-21s = compose bc.copy_%-21s ab.copy_%s;\n" s s s) *) + copy_structure = compose bc.copy_structure ab.copy_structure; + copy_signature = compose bc.copy_signature ab.copy_signature; + copy_toplevel_phrase = compose bc.copy_toplevel_phrase ab.copy_toplevel_phrase; + copy_core_type = compose bc.copy_core_type ab.copy_core_type; + copy_expression = compose bc.copy_expression ab.copy_expression; + copy_pattern = compose bc.copy_pattern ab.copy_pattern; + copy_case = compose bc.copy_case ab.copy_case; + copy_type_declaration = compose bc.copy_type_declaration ab.copy_type_declaration; + copy_type_extension = compose bc.copy_type_extension ab.copy_type_extension; + copy_extension_constructor = compose bc.copy_extension_constructor ab.copy_extension_constructor; + copy_out_value = compose bc.copy_out_value ab.copy_out_value; + copy_out_type = compose bc.copy_out_type ab.copy_out_type; + copy_out_class_type = compose bc.copy_out_class_type ab.copy_out_class_type; + copy_out_module_type = compose bc.copy_out_module_type ab.copy_out_module_type; + copy_out_sig_item = compose bc.copy_out_sig_item ab.copy_out_sig_item; + copy_out_type_extension = compose bc.copy_out_type_extension ab.copy_out_type_extension; + copy_out_phrase = compose bc.copy_out_phrase ab.copy_out_phrase; + copy_mapper = compose bc.copy_mapper ab.copy_mapper; + (*$*) +} + +type _ migration += Migration : 'from ocaml_version * ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from migration + +module type Migrate_module = sig + module From : Ast + module To : Ast + (*$ foreach_type (fun m s -> + printf "val copy_%-21s: From.%s.%s -> To.%s.%s\n" s m s m s) *) + val copy_structure : From.Parsetree.structure -> To.Parsetree.structure + val copy_signature : From.Parsetree.signature -> To.Parsetree.signature + val copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase + val copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type + val copy_expression : From.Parsetree.expression -> To.Parsetree.expression + val copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern + val copy_case : From.Parsetree.case -> To.Parsetree.case + val copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration + val copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension + val copy_extension_constructor: From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor + val copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value + val copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type + val copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type + val copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type + val copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item + val copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension + val copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase + val copy_mapper : From.Ast_mapper.mapper -> To.Ast_mapper.mapper + (*$*) +end + +module Migration_functions + (A : OCaml_version) (B : OCaml_version) + (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast) += +struct + let migration_functions : (A.types, B.types) migration_functions = + let open A_to_B in + { + (*$ foreach_type (fun _ s -> printf "copy_%s;\n" s) *) + copy_structure; + copy_signature; + copy_toplevel_phrase; + copy_core_type; + copy_expression; + copy_pattern; + copy_case; + copy_type_declaration; + copy_type_extension; + copy_extension_constructor; + copy_out_value; + copy_out_type; + copy_out_class_type; + copy_out_module_type; + copy_out_sig_item; + copy_out_type_extension; + copy_out_phrase; + copy_mapper; + (*$*) + } +end + +module Register_migration (A : OCaml_version) (B : OCaml_version) + (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast) + (B_to_A : Migrate_module with module From = B.Ast and module To = A.Ast) += +struct + let () = ( + let is_undefined : type a. a migration -> bool = function + | Undefined -> true + | _ -> false + in + assert (A.version < B.version); + assert (is_undefined A.migration_info.next_version); + assert (is_undefined B.migration_info.previous_version); + let module A_to_B_fun = Migration_functions(A)(B)(A_to_B) in + let module B_to_A_fun = Migration_functions(B)(A)(B_to_A) in + A.migration_info.next_version <- + Migration ((module A), A_to_B_fun.migration_functions, (module B)); + B.migration_info.previous_version <- + Migration ((module B), B_to_A_fun.migration_functions, (module A)); + ) +end + +type 'from immediate_migration = + | No_migration : 'from immediate_migration + | Immediate_migration + : ('from, 'to_) migration_functions * 'to_ ocaml_version + -> 'from immediate_migration + +let immediate_migration + (*$ foreach_type (fun _ s -> printf "(type %s)\n" s) *) + (type structure) + (type signature) + (type toplevel_phrase) + (type core_type) + (type expression) + (type pattern) + (type case) + (type type_declaration) + (type type_extension) + (type extension_constructor) + (type out_value) + (type out_type) + (type out_class_type) + (type out_module_type) + (type out_sig_item) + (type out_type_extension) + (type out_phrase) + (type mapper) + (*$*) + ((module A) : < + (*$ foreach_type (fun _ s -> printf "%-21s : %s;\n" s s) *) + structure : structure; + signature : signature; + toplevel_phrase : toplevel_phrase; + core_type : core_type; + expression : expression; + pattern : pattern; + case : case; + type_declaration : type_declaration; + type_extension : type_extension; + extension_constructor : extension_constructor; + out_value : out_value; + out_type : out_type; + out_class_type : out_class_type; + out_module_type : out_module_type; + out_sig_item : out_sig_item; + out_type_extension : out_type_extension; + out_phrase : out_phrase; + mapper : mapper; + (*$*) + > ocaml_version) + direction + = + let version = match direction with + | `Next -> A.migration_info.next_version + | `Previous -> A.migration_info.previous_version + in + match version with + | Undefined -> No_migration + | Migration (_, funs, to_) -> Immediate_migration (funs, to_) + | _ -> assert false + +let migrate + (*$ foreach_type (fun _ s -> printf "(type %s1) (type %s2)\n" s s) *) + (type structure1) (type structure2) + (type signature1) (type signature2) + (type toplevel_phrase1) (type toplevel_phrase2) + (type core_type1) (type core_type2) + (type expression1) (type expression2) + (type pattern1) (type pattern2) + (type case1) (type case2) + (type type_declaration1) (type type_declaration2) + (type type_extension1) (type type_extension2) + (type extension_constructor1) (type extension_constructor2) + (type out_value1) (type out_value2) + (type out_type1) (type out_type2) + (type out_class_type1) (type out_class_type2) + (type out_module_type1) (type out_module_type2) + (type out_sig_item1) (type out_sig_item2) + (type out_type_extension1) (type out_type_extension2) + (type out_phrase1) (type out_phrase2) + (type mapper1) (type mapper2) + (*$*) + ((module A) : < + (*$ foreach_type (fun _ s -> printf "%-21s : %s1;\n" s s) *) + structure : structure1; + signature : signature1; + toplevel_phrase : toplevel_phrase1; + core_type : core_type1; + expression : expression1; + pattern : pattern1; + case : case1; + type_declaration : type_declaration1; + type_extension : type_extension1; + extension_constructor : extension_constructor1; + out_value : out_value1; + out_type : out_type1; + out_class_type : out_class_type1; + out_module_type : out_module_type1; + out_sig_item : out_sig_item1; + out_type_extension : out_type_extension1; + out_phrase : out_phrase1; + mapper : mapper1; + (*$*) + > ocaml_version) + ((module B) : < + (*$ foreach_type (fun _ s -> printf "%-21s : %s2;\n" s s) *) + structure : structure2; + signature : signature2; + toplevel_phrase : toplevel_phrase2; + core_type : core_type2; + expression : expression2; + pattern : pattern2; + case : case2; + type_declaration : type_declaration2; + type_extension : type_extension2; + extension_constructor : extension_constructor2; + out_value : out_value2; + out_type : out_type2; + out_class_type : out_class_type2; + out_module_type : out_module_type2; + out_sig_item : out_sig_item2; + out_type_extension : out_type_extension2; + out_phrase : out_phrase2; + mapper : mapper2; + (*$*) + > ocaml_version) + : (A.types, B.types) migration_functions + = + match A.Version with + | B.Version -> migration_identity + | _ -> + let direction = if A.version < B.version then `Next else `Previous in + let rec migrate (m : A.types immediate_migration) : (A.types, B.types) migration_functions = + match m with + | No_migration -> assert false + | Immediate_migration (f, (module To)) -> + match To.Version with + | B.Version -> f + | _ -> + match immediate_migration (module To) direction with + | No_migration -> assert false + | Immediate_migration (g, to2) -> + migrate (Immediate_migration (migration_compose f g, to2)) + in + migrate (immediate_migration (module A) direction) + +module Convert (A : OCaml_version) (B : OCaml_version) = struct + let { + (*$ foreach_type (fun _ s -> printf "copy_%s;\n" s) *) + copy_structure; + copy_signature; + copy_toplevel_phrase; + copy_core_type; + copy_expression; + copy_pattern; + copy_case; + copy_type_declaration; + copy_type_extension; + copy_extension_constructor; + copy_out_value; + copy_out_type; + copy_out_class_type; + copy_out_module_type; + copy_out_sig_item; + copy_out_type_extension; + copy_out_phrase; + copy_mapper; + (*$*) + } : (A.types, B.types) migration_functions = + migrate (module A) (module B) +end + +(*$ foreach_version (fun suffix version -> + printf "module OCaml_%s = struct\n" suffix; + printf " module Ast = Ast_%s\n" suffix; + printf " include Make_witness(Ast_%s)\n" suffix; + printf " let version = %s\n" suffix; + printf " let string_version = %S\n" version; + printf "end\n"; + printf "let ocaml_%s : OCaml_%s.types ocaml_version = (module OCaml_%s)\n" + suffix suffix suffix; + ) +*) +module OCaml_402 = struct + module Ast = Ast_402 + include Make_witness(Ast_402) + let version = 402 + let string_version = "4.02" +end +let ocaml_402 : OCaml_402.types ocaml_version = (module OCaml_402) +module OCaml_403 = struct + module Ast = Ast_403 + include Make_witness(Ast_403) + let version = 403 + let string_version = "4.03" +end +let ocaml_403 : OCaml_403.types ocaml_version = (module OCaml_403) +module OCaml_404 = struct + module Ast = Ast_404 + include Make_witness(Ast_404) + let version = 404 + let string_version = "4.04" +end +let ocaml_404 : OCaml_404.types ocaml_version = (module OCaml_404) +module OCaml_405 = struct + module Ast = Ast_405 + include Make_witness(Ast_405) + let version = 405 + let string_version = "4.05" +end +let ocaml_405 : OCaml_405.types ocaml_version = (module OCaml_405) +module OCaml_406 = struct + module Ast = Ast_406 + include Make_witness(Ast_406) + let version = 406 + let string_version = "4.06" +end +let ocaml_406 : OCaml_406.types ocaml_version = (module OCaml_406) +module OCaml_407 = struct + module Ast = Ast_407 + include Make_witness(Ast_407) + let version = 407 + let string_version = "4.07" +end +let ocaml_407 : OCaml_407.types ocaml_version = (module OCaml_407) +module OCaml_408 = struct + module Ast = Ast_408 + include Make_witness(Ast_408) + let version = 408 + let string_version = "4.08" +end +let ocaml_408 : OCaml_408.types ocaml_version = (module OCaml_408) +module OCaml_409 = struct + module Ast = Ast_409 + include Make_witness(Ast_409) + let version = 409 + let string_version = "4.09" +end +let ocaml_409 : OCaml_409.types ocaml_version = (module OCaml_409) +module OCaml_410 = struct + module Ast = Ast_410 + include Make_witness(Ast_410) + let version = 410 + let string_version = "4.10" +end +let ocaml_410 : OCaml_410.types ocaml_version = (module OCaml_410) +module OCaml_411 = struct + module Ast = Ast_411 + include Make_witness(Ast_411) + let version = 411 + let string_version = "4.11" +end +let ocaml_411 : OCaml_411.types ocaml_version = (module OCaml_411) +(*$*) + +let all_versions : (module OCaml_version) list = [ + (*$foreach_version (fun suffix _ -> + printf "(module OCaml_%s : OCaml_version);\n" suffix)*) + (module OCaml_402 : OCaml_version); + (module OCaml_403 : OCaml_version); + (module OCaml_404 : OCaml_version); + (module OCaml_405 : OCaml_version); + (module OCaml_406 : OCaml_version); + (module OCaml_407 : OCaml_version); + (module OCaml_408 : OCaml_version); + (module OCaml_409 : OCaml_version); + (module OCaml_410 : OCaml_version); + (module OCaml_411 : OCaml_version); + (*$*) +] + +(*$foreach_version_pair (fun a b -> + printf "include Register_migration(OCaml_%s)(OCaml_%s)\n" a b; + printf " (Migrate_parsetree_%s_%s)(Migrate_parsetree_%s_%s)\n" a b b a + ) +*) +include Register_migration(OCaml_402)(OCaml_403) + (Migrate_parsetree_402_403)(Migrate_parsetree_403_402) +include Register_migration(OCaml_403)(OCaml_404) + (Migrate_parsetree_403_404)(Migrate_parsetree_404_403) +include Register_migration(OCaml_404)(OCaml_405) + (Migrate_parsetree_404_405)(Migrate_parsetree_405_404) +include Register_migration(OCaml_405)(OCaml_406) + (Migrate_parsetree_405_406)(Migrate_parsetree_406_405) +include Register_migration(OCaml_406)(OCaml_407) + (Migrate_parsetree_406_407)(Migrate_parsetree_407_406) +include Register_migration(OCaml_407)(OCaml_408) + (Migrate_parsetree_407_408)(Migrate_parsetree_408_407) +include Register_migration(OCaml_408)(OCaml_409) + (Migrate_parsetree_408_409)(Migrate_parsetree_409_408) +include Register_migration(OCaml_409)(OCaml_410) + (Migrate_parsetree_409_410)(Migrate_parsetree_410_409) +include Register_migration(OCaml_410)(OCaml_411) + (Migrate_parsetree_410_411)(Migrate_parsetree_411_410) +(*$*) + +module OCaml_current = OCaml_OCAML_VERSION +let ocaml_current : OCaml_current.types ocaml_version = (module OCaml_current) + +(* Make sure the preprocessing worked as expected *) +let _f (x : Parsetree.expression) : OCaml_current.Ast.Parsetree.expression = x diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.mli new file mode 100644 index 000000000..1f32a059a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/migrate_parsetree_versions.mli @@ -0,0 +1,314 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(*$ #use "src/cinaps_helpers" $*) + +(** {1 Abstracting an OCaml frontend} *) + +(** Abstract view of a version of an OCaml Ast *) +module type Ast = sig + (*$ foreach_module (fun m types -> + printf "module %s : sig\n" m; + List.iter types ~f:(printf "type %s\n"); + printf "end\n" + ) + *) + module Parsetree : sig + type structure + type signature + type toplevel_phrase + type core_type + type expression + type pattern + type case + type type_declaration + type type_extension + type extension_constructor + end + module Outcometree : sig + type out_value + type out_type + type out_class_type + type out_module_type + type out_sig_item + type out_type_extension + type out_phrase + end + module Ast_mapper : sig + type mapper + end + (*$*) + module Config : sig + val ast_impl_magic_number : string + val ast_intf_magic_number : string + end + val shallow_identity : Ast_mapper.mapper + val map_signature : Ast_mapper.mapper -> Parsetree.signature -> Parsetree.signature + val map_structure : Ast_mapper.mapper -> Parsetree.structure -> Parsetree.structure + val make_top_mapper + : signature:(Parsetree.signature -> Parsetree.signature) + -> structure:(Parsetree.structure -> Parsetree.structure) + -> Ast_mapper.mapper +end + +(* Shortcuts for talking about ast types outside of the module language *) + +type 'a _types = 'a constraint 'a + = < + (*$ foreach_type (fun _ s -> printf "%-21s : _;\n" s) *) + structure : _; + signature : _; + toplevel_phrase : _; + core_type : _; + expression : _; + pattern : _; + case : _; + type_declaration : _; + type_extension : _; + extension_constructor : _; + out_value : _; + out_type : _; + out_class_type : _; + out_module_type : _; + out_sig_item : _; + out_type_extension : _; + out_phrase : _; + mapper : _; + (*$*) + > +;; + +(*$ foreach_type (fun _ s -> + printf "type 'a get_%s = 'x constraint 'a _types = < %s : 'x; .. >\n" s s + ); + printf ";;\n" *) +type 'a get_structure = 'x constraint 'a _types = < structure : 'x; .. > +type 'a get_signature = 'x constraint 'a _types = < signature : 'x; .. > +type 'a get_toplevel_phrase = 'x constraint 'a _types = < toplevel_phrase : 'x; .. > +type 'a get_core_type = 'x constraint 'a _types = < core_type : 'x; .. > +type 'a get_expression = 'x constraint 'a _types = < expression : 'x; .. > +type 'a get_pattern = 'x constraint 'a _types = < pattern : 'x; .. > +type 'a get_case = 'x constraint 'a _types = < case : 'x; .. > +type 'a get_type_declaration = 'x constraint 'a _types = < type_declaration : 'x; .. > +type 'a get_type_extension = 'x constraint 'a _types = < type_extension : 'x; .. > +type 'a get_extension_constructor = 'x constraint 'a _types = < extension_constructor : 'x; .. > +type 'a get_out_value = 'x constraint 'a _types = < out_value : 'x; .. > +type 'a get_out_type = 'x constraint 'a _types = < out_type : 'x; .. > +type 'a get_out_class_type = 'x constraint 'a _types = < out_class_type : 'x; .. > +type 'a get_out_module_type = 'x constraint 'a _types = < out_module_type : 'x; .. > +type 'a get_out_sig_item = 'x constraint 'a _types = < out_sig_item : 'x; .. > +type 'a get_out_type_extension = 'x constraint 'a _types = < out_type_extension : 'x; .. > +type 'a get_out_phrase = 'x constraint 'a _types = < out_phrase : 'x; .. > +type 'a get_mapper = 'x constraint 'a _types = < mapper : 'x; .. > +;; +(*$*) + +(** A version of the OCaml frontend packs the ast with type witnesses + so that equalities can be recovered dynamically. *) +type _ witnesses (*IF_AT_LEAST 406 = private ..*) + +(** [migration_info] is an opaque type that is used to generate migration + functions. *) +type _ migration_info + +(** An OCaml frontend versions an Ast, version number and some witnesses for + conversion. *) +module type OCaml_version = sig + + (** Ast definition for this version *) + module Ast : Ast + + (* Version number as an integer, 402, 403, 404, ... *) + val version : int + + (* Version number as a user-friendly string *) + val string_version : string (* 4.02, 4.03, 4.04, ... *) + + (** Shortcut for talking about Ast types *) + type types = < + (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s) *) + structure : Ast.Parsetree.structure; + signature : Ast.Parsetree.signature; + toplevel_phrase : Ast.Parsetree.toplevel_phrase; + core_type : Ast.Parsetree.core_type; + expression : Ast.Parsetree.expression; + pattern : Ast.Parsetree.pattern; + case : Ast.Parsetree.case; + type_declaration : Ast.Parsetree.type_declaration; + type_extension : Ast.Parsetree.type_extension; + extension_constructor : Ast.Parsetree.extension_constructor; + out_value : Ast.Outcometree.out_value; + out_type : Ast.Outcometree.out_type; + out_class_type : Ast.Outcometree.out_class_type; + out_module_type : Ast.Outcometree.out_module_type; + out_sig_item : Ast.Outcometree.out_sig_item; + out_type_extension : Ast.Outcometree.out_type_extension; + out_phrase : Ast.Outcometree.out_phrase; + mapper : Ast.Ast_mapper.mapper; + (*$*) + > _types + + (** A construtor for recovering type equalities between two arbitrary + versions. *) + type _ witnesses += Version : types witnesses + + (** Information used to derive migration functions, see below *) + val migration_info : types migration_info +end + +(** Representing an ocaml version in type language *) +type 'types ocaml_version = + (module OCaml_version + (*$ let sep = with_then_and () in + foreach_type (fun m s -> + printf "%t type Ast.%s.%s = 'types get_%s\n" sep m s s) *) + with type Ast.Parsetree.structure = 'types get_structure + and type Ast.Parsetree.signature = 'types get_signature + and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase + and type Ast.Parsetree.core_type = 'types get_core_type + and type Ast.Parsetree.expression = 'types get_expression + and type Ast.Parsetree.pattern = 'types get_pattern + and type Ast.Parsetree.case = 'types get_case + and type Ast.Parsetree.type_declaration = 'types get_type_declaration + and type Ast.Parsetree.type_extension = 'types get_type_extension + and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor + and type Ast.Outcometree.out_value = 'types get_out_value + and type Ast.Outcometree.out_type = 'types get_out_type + and type Ast.Outcometree.out_class_type = 'types get_out_class_type + and type Ast.Outcometree.out_module_type = 'types get_out_module_type + and type Ast.Outcometree.out_sig_item = 'types get_out_sig_item + and type Ast.Outcometree.out_type_extension = 'types get_out_type_extension + and type Ast.Outcometree.out_phrase = 'types get_out_phrase + and type Ast.Ast_mapper.mapper = 'types get_mapper + (*$*) + ) + +(** {1 Concrete frontend instances} *) + +(*$foreach_version (fun suffix _ -> + printf "module OCaml_%s : OCaml_version with module Ast = Ast_%s\n" + suffix suffix; + printf "val ocaml_%s : OCaml_%s.types ocaml_version\n" suffix suffix; + )*) +module OCaml_402 : OCaml_version with module Ast = Ast_402 +val ocaml_402 : OCaml_402.types ocaml_version +module OCaml_403 : OCaml_version with module Ast = Ast_403 +val ocaml_403 : OCaml_403.types ocaml_version +module OCaml_404 : OCaml_version with module Ast = Ast_404 +val ocaml_404 : OCaml_404.types ocaml_version +module OCaml_405 : OCaml_version with module Ast = Ast_405 +val ocaml_405 : OCaml_405.types ocaml_version +module OCaml_406 : OCaml_version with module Ast = Ast_406 +val ocaml_406 : OCaml_406.types ocaml_version +module OCaml_407 : OCaml_version with module Ast = Ast_407 +val ocaml_407 : OCaml_407.types ocaml_version +module OCaml_408 : OCaml_version with module Ast = Ast_408 +val ocaml_408 : OCaml_408.types ocaml_version +module OCaml_409 : OCaml_version with module Ast = Ast_409 +val ocaml_409 : OCaml_409.types ocaml_version +module OCaml_410 : OCaml_version with module Ast = Ast_410 +val ocaml_410 : OCaml_410.types ocaml_version +module OCaml_411 : OCaml_version with module Ast = Ast_411 +val ocaml_411 : OCaml_411.types ocaml_version +(*$*) + +(* An alias to the current compiler version *) +module OCaml_current = OCaml_OCAML_VERSION +val ocaml_current : OCaml_current.types ocaml_version + +val all_versions : (module OCaml_version) list + +(** {1 Migrating between different versions} *) + +type ('a, 'b) type_comparison = + | Lt : ('a, 'b) type_comparison + | Eq : ('a, 'a) type_comparison + | Gt : ('a, 'b) type_comparison + +val compare_ocaml_version : 'a ocaml_version -> 'b ocaml_version -> ('a, 'b) type_comparison + +(** A record for migrating each AST construct between two known versions *) +type ('from, 'to_) migration_functions = { + (*$ foreach_type (fun _ s -> + printf "copy_%s: 'from get_%s -> 'to_ get_%s;\n" s s s) *) + copy_structure: 'from get_structure -> 'to_ get_structure; + copy_signature: 'from get_signature -> 'to_ get_signature; + copy_toplevel_phrase: 'from get_toplevel_phrase -> 'to_ get_toplevel_phrase; + copy_core_type: 'from get_core_type -> 'to_ get_core_type; + copy_expression: 'from get_expression -> 'to_ get_expression; + copy_pattern: 'from get_pattern -> 'to_ get_pattern; + copy_case: 'from get_case -> 'to_ get_case; + copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration; + copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension; + copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor; + copy_out_value: 'from get_out_value -> 'to_ get_out_value; + copy_out_type: 'from get_out_type -> 'to_ get_out_type; + copy_out_class_type: 'from get_out_class_type -> 'to_ get_out_class_type; + copy_out_module_type: 'from get_out_module_type -> 'to_ get_out_module_type; + copy_out_sig_item: 'from get_out_sig_item -> 'to_ get_out_sig_item; + copy_out_type_extension: 'from get_out_type_extension -> 'to_ get_out_type_extension; + copy_out_phrase: 'from get_out_phrase -> 'to_ get_out_phrase; + copy_mapper: 'from get_mapper -> 'to_ get_mapper; + (*$*) +} + +(** Migrating to the same version is no-op *) +val migration_identity : ('a, 'a) migration_functions + +(** Migrations can be composed *) +val migration_compose : ('a, 'b) migration_functions -> ('b, 'c) migration_functions -> ('a, 'c) migration_functions + +(** Represent the next or previous version of an Ast *) + +type 'from immediate_migration = + | No_migration : 'from immediate_migration + (** Cannot migrate earliest or latest supported version *) + | + Immediate_migration : + ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from immediate_migration + (** Pack the migration functions and the new version *) + +val immediate_migration : 'types ocaml_version -> [< `Next | `Previous ] -> 'types immediate_migration + +val migrate : 'from ocaml_version -> 'to_ ocaml_version -> ('from, 'to_) migration_functions + +(** {1 Convenience definitions} *) + +(** Module level migration *) +module Convert (A : OCaml_version) (B : OCaml_version) : sig + (*$ foreach_type (fun m s -> + let fq = sprintf "%s.%s" m s in + printf " val copy_%-21s : A.Ast.%-31s -> B.Ast.%s\n" s fq fq) *) + val copy_structure : A.Ast.Parsetree.structure -> B.Ast.Parsetree.structure + val copy_signature : A.Ast.Parsetree.signature -> B.Ast.Parsetree.signature + val copy_toplevel_phrase : A.Ast.Parsetree.toplevel_phrase -> B.Ast.Parsetree.toplevel_phrase + val copy_core_type : A.Ast.Parsetree.core_type -> B.Ast.Parsetree.core_type + val copy_expression : A.Ast.Parsetree.expression -> B.Ast.Parsetree.expression + val copy_pattern : A.Ast.Parsetree.pattern -> B.Ast.Parsetree.pattern + val copy_case : A.Ast.Parsetree.case -> B.Ast.Parsetree.case + val copy_type_declaration : A.Ast.Parsetree.type_declaration -> B.Ast.Parsetree.type_declaration + val copy_type_extension : A.Ast.Parsetree.type_extension -> B.Ast.Parsetree.type_extension + val copy_extension_constructor : A.Ast.Parsetree.extension_constructor -> B.Ast.Parsetree.extension_constructor + val copy_out_value : A.Ast.Outcometree.out_value -> B.Ast.Outcometree.out_value + val copy_out_type : A.Ast.Outcometree.out_type -> B.Ast.Outcometree.out_type + val copy_out_class_type : A.Ast.Outcometree.out_class_type -> B.Ast.Outcometree.out_class_type + val copy_out_module_type : A.Ast.Outcometree.out_module_type -> B.Ast.Outcometree.out_module_type + val copy_out_sig_item : A.Ast.Outcometree.out_sig_item -> B.Ast.Outcometree.out_sig_item + val copy_out_type_extension : A.Ast.Outcometree.out_type_extension -> B.Ast.Outcometree.out_type_extension + val copy_out_phrase : A.Ast.Outcometree.out_phrase -> B.Ast.Outcometree.out_phrase + val copy_mapper : A.Ast.Ast_mapper.mapper -> B.Ast.Ast_mapper.mapper + (*$*) +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/reason_migrate_parsetree.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/reason_migrate_parsetree.ml new file mode 100644 index 000000000..ba1989387 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/reason_migrate_parsetree.ml @@ -0,0 +1,113 @@ +(**************************************************************************) +(* *) +(* OCaml Migrate Parsetree *) +(* *) +(* Frédéric Bour *) +(* Jérémie Dimino, Jane Street Europe *) +(* *) +(* Copyright 2017 Institut National de Recherche en Informatique et *) +(* en Automatique (INRIA). *) +(* *) +(* 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. *) +(* *) +(**************************************************************************) + +(*$ #use "src/cinaps_helpers" $*) + +(* Shared definitions. + Mostly errors about features missing in older versions. *) +module Def = Migrate_parsetree_def + +(* Copy of OCaml parsetrees *) +(*$foreach_version (fun suffix _ -> + printf "module Ast_%s = Ast_%s\n" suffix suffix + )*) +module Ast_402 = Ast_402 +module Ast_403 = Ast_403 +module Ast_404 = Ast_404 +module Ast_405 = Ast_405 +module Ast_406 = Ast_406 +module Ast_407 = Ast_407 +module Ast_408 = Ast_408 +module Ast_409 = Ast_409 +module Ast_410 = Ast_410 +module Ast_411 = Ast_411 +(*$*) + +(* A module for marshalling/unmarshalling arbitrary versions of Asts *) +module Ast_io = Migrate_parsetree_ast_io + +(* Manual migration between versions *) +(*$foreach_version_pair (fun x y -> + printf "module Migrate_%s_%s = Migrate_parsetree_%s_%s\n" x y x y; + printf "module Migrate_%s_%s = Migrate_parsetree_%s_%s\n" y x y x; + )*) +module Migrate_402_403 = Migrate_parsetree_402_403 +module Migrate_403_402 = Migrate_parsetree_403_402 +module Migrate_403_404 = Migrate_parsetree_403_404 +module Migrate_404_403 = Migrate_parsetree_404_403 +module Migrate_404_405 = Migrate_parsetree_404_405 +module Migrate_405_404 = Migrate_parsetree_405_404 +module Migrate_405_406 = Migrate_parsetree_405_406 +module Migrate_406_405 = Migrate_parsetree_406_405 +module Migrate_406_407 = Migrate_parsetree_406_407 +module Migrate_407_406 = Migrate_parsetree_407_406 +module Migrate_407_408 = Migrate_parsetree_407_408 +module Migrate_408_407 = Migrate_parsetree_408_407 +module Migrate_408_409 = Migrate_parsetree_408_409 +module Migrate_409_408 = Migrate_parsetree_409_408 +module Migrate_409_410 = Migrate_parsetree_409_410 +module Migrate_410_409 = Migrate_parsetree_410_409 +module Migrate_410_411 = Migrate_parsetree_410_411 +module Migrate_411_410 = Migrate_parsetree_411_410 +(*$*) + +(* An abstraction of OCaml compiler versions *) +module Versions = Migrate_parsetree_versions + +(* All versions are compatible with this signature *) +module type OCaml_version = Versions.OCaml_version + +(*$foreach_version (fun suffix _ -> + printf "module OCaml_%s = Versions.OCaml_%s\n" suffix suffix + )*) +module OCaml_402 = Versions.OCaml_402 +module OCaml_403 = Versions.OCaml_403 +module OCaml_404 = Versions.OCaml_404 +module OCaml_405 = Versions.OCaml_405 +module OCaml_406 = Versions.OCaml_406 +module OCaml_407 = Versions.OCaml_407 +module OCaml_408 = Versions.OCaml_408 +module OCaml_409 = Versions.OCaml_409 +module OCaml_410 = Versions.OCaml_410 +module OCaml_411 = Versions.OCaml_411 +(*$*) +module OCaml_current = Versions.OCaml_current + +(* A Functor taking two OCaml versions and producing a module of functions + migrating from one to the other. *) +module Convert = Versions.Convert + +(* A [Parse] module that migrate ASTs to the desired version of an AST *) +module Parse = Migrate_parsetree_parse + +(* Entrypoints for registering rewriters and making a ppx binary *) +module Driver = Migrate_parsetree_driver + +(* Aliases for compiler-libs modules that might be shadowed *) +module Compiler_libs = struct + module Location = Location + module Longident = Longident + + module type Asttypes = module type of struct include Asttypes end + module rec Asttypes : Asttypes = Asttypes + + module type Parsetree = module type of struct include Parsetree end + module rec Parsetree : Parsetree = Parsetree + + module Docstrings = Docstrings + module Ast_helper = Ast_helper + module Ast_mapper = Ast_mapper +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/stdlib0.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/stdlib0.ml new file mode 100644 index 000000000..8f8180baa --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/src/stdlib0.ml @@ -0,0 +1,10 @@ +module Int = struct + let to_string = string_of_int +end + +module Option = struct + let map f o = + match o with + | None -> None + | Some v -> Some (f v) +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/manual/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/manual/dune new file mode 100644 index 000000000..748cee51a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/manual/dune @@ -0,0 +1,17 @@ +(executable + (name driver) + (libraries ocaml-migrate-parsetree) + (link_flags -linkall)) + +(rule + (with-stdout-to driver.ml + (echo "Migrate_parsetree.Driver.run_main ()"))) + +(rule + (with-stdout-to file.blah + (echo "let x = 42"))) + +(alias + (name runtest) + (action (ignore-stdout + (run ./driver.exe --impl %{dep:file.blah})))) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/dune new file mode 100644 index 000000000..c3a835af8 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/dune @@ -0,0 +1,16 @@ +(executable + (name ppx) + (flags :standard -linkall) + (libraries ppx1 ppx2)) + +(rule + (with-stdout-to null.output (run ./ppx.exe --null))) + +(rule + (with-stdout-to null.expected (echo ""))) + +(alias + (name runtest) + (deps null.expected null.output) + (action (run diff -u null.expected null.output))) + diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/ppx.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/ppx.ml new file mode 100644 index 000000000..7bd156703 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/null/ppx.ml @@ -0,0 +1 @@ +let () = Migrate_parsetree.Driver.run_main () diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/dune new file mode 100644 index 000000000..b182677f2 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/dune @@ -0,0 +1,13 @@ +(executable + (name foo) + (preprocess (pps ppx1 ppx2 -- + -message "Hello, world!" + --cookie "plop=\"Chocolate\""))) + +(rule + (with-stdout-to foo.output (run ./foo.exe))) + +(alias + (name runtest) + (deps foo.expected foo.output) + (action (run diff -u foo.expected foo.output))) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.expected b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.expected new file mode 100644 index 000000000..96295aa1a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.expected @@ -0,0 +1,3 @@ +42 +Hello, world! +Chocolate diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.ml new file mode 100644 index 000000000..5c2f92d25 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx-user/foo.ml @@ -0,0 +1,3 @@ +let () = + Printf.printf "%d\n%s\n%s\n" + [%forty_two] [%cmd_line_arg] [%plop] diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/dune new file mode 100644 index 000000000..f64fd37dc --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/dune @@ -0,0 +1,4 @@ +(library + (name ppx1) + (kind ppx_rewriter) + (libraries ocaml-migrate-parsetree)) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/ppx1.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/ppx1.ml new file mode 100644 index 000000000..71492db15 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx1/ppx1.ml @@ -0,0 +1,20 @@ +(* Rewrite [%fourty_two] as 42 *) + +open Migrate_parsetree +open OCaml_403.Ast +open Parsetree + +let rewriter _config _cookies = + let super = Ast_mapper.default_mapper in + let expr self e = + match e.pexp_desc with + | Pexp_extension ({ txt = "forty_two"; _ }, PStr []) -> + { e with pexp_desc = Pexp_constant (Pconst_integer ("42", None)) } + | _ -> super.expr self e + in + { super with expr } + +let () = + Driver.register ~name:"ppx1" + (module OCaml_403) + rewriter diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/dune new file mode 100644 index 000000000..d1dc2b84a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/dune @@ -0,0 +1,4 @@ +(library + (name ppx2) + (kind ppx_rewriter) + (libraries ocaml-migrate-parsetree)) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/ppx2.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/ppx2.ml new file mode 100644 index 000000000..06b81b468 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/test/driver/ppx2/ppx2.ml @@ -0,0 +1,32 @@ +(* Rewrite [%fourty_two] as 42 *) + +open Migrate_parsetree +open OCaml_403.Ast +open Parsetree + +let cmd_line_arg = ref "unset" + +let get_plop cookies ~loc = + match Driver.get_cookie cookies "plop" (module OCaml_403) with + | Some e -> e + | None -> + let open Ast_helper in + Exp.constant ~loc (Const.string "unset") + +let rewriter _config cookies = + let super = Ast_mapper.default_mapper in + let expr self e = + match e.pexp_desc with + | Pexp_extension ({ txt = "cmd_line_arg"; _ }, PStr []) -> + { e with pexp_desc = Pexp_constant (Pconst_string (!cmd_line_arg, None)) } + | Pexp_extension ({ txt = "plop"; _ }, PStr []) -> + get_plop cookies ~loc:e.pexp_loc + | _ -> super.expr self e + in + { super with expr } + +let () = + Driver.register ~name:"ppx2" + ~args:[("-message", Arg.Set_string cmd_line_arg, "MSG Set [%cmd_line_arg] to MSG")] + (module OCaml_403) + rewriter diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.ml new file mode 100644 index 000000000..f766dc73e --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.ml @@ -0,0 +1,66 @@ +(* Add (*IF_CURRENT:= Parsetree.expression *) comments to type definitions. *) + +open StdLabels +open Parsetree + +[@@@warning "-40"] + +let read_file fn = + let ic = open_in_bin fn in + let len = in_channel_length ic in + let s = really_input_string ic len in + close_in ic; + s + +let collect_insertions structure = + let insertions = ref [] in + let add_after ~(loc:Location.t) txt = + insertions := (loc.loc_end.pos_cnum, txt) :: !insertions + in + List.iter structure ~f:(fun item -> + match item.pstr_desc with + | Pstr_module { pmb_name = module_name + ; pmb_expr = { pmod_desc = Pmod_structure items; _ } + ; _ + } -> + List.iter items ~f:(fun item -> + match item.pstr_desc with + | Pstr_type (_, tds) -> + List.iter tds ~f:(fun td -> + match td.ptype_manifest with + | Some _ -> () + | None -> + let name = td.ptype_name in + let params = + let to_string (ty, _) = + Format.asprintf "%a" Pprintast.core_type ty + in + match td.ptype_params with + | [] -> "" + | [param] -> to_string param ^ " " + | l -> + Printf.sprintf "(%s) " + (String.concat ~sep:", " (List.map l ~f:to_string)) + in + Printf.ksprintf (add_after ~loc:name.loc) + " (*IF_CURRENT = %s%s.%s *)" params (Option.value module_name.txt ~default:"X") name.txt) + | _ -> ()) + | _ -> ()); + List.sort !insertions ~cmp:(fun (a, _) (b, _) -> compare a b) + +let () = + let fn = Sys.argv.(1) in + let file_contents = read_file fn in + let lb = Lexing.from_string file_contents in + Location.init lb fn; + let ast = Parse.implementation lb in + let insertions = collect_insertions ast in + let oc = open_out_bin fn in + let pos = + List.fold_left insertions ~init:0 ~f:(fun cur_pos (pos, txt) -> + output_substring oc file_contents cur_pos (pos - cur_pos); + output_string oc txt; + pos) + in + output_substring oc file_contents pos (String.length file_contents - pos); + close_out oc diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.mli new file mode 100644 index 000000000..e790aeb70 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/add_special_comments.mli @@ -0,0 +1 @@ +(* empty *) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/dune b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/dune new file mode 100644 index 000000000..979bb710d --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/dune @@ -0,0 +1,6 @@ +(executables + (names add_special_comments pp gencopy) + (libraries compiler-libs.common compiler-libs.bytecomp) + (flags :standard -w -3)) + +(ocamllex pp_rewrite) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/gencopy.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/gencopy.ml new file mode 100644 index 000000000..8ca1d197a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/gencopy.ml @@ -0,0 +1,343 @@ +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* This file has been modified/specialized for ocaml-migrate-parsetree *) + +(* Generate code to perform a deep copy of a type into another + identical type (in another module). Used to generate a first + version of migration code between two versions of the same type, + to be then patched manually to perform actual migration. *) + +let drop_prefix ~prefix s = + let plen = String.length prefix in + if plen > String.length s then None + else + try + for i = 0 to String.length prefix - 1 do + if not (Char.equal s.[i] prefix.[i]) then raise Exit + done; + Some (String.sub s plen (String.length s - plen)) + with Exit -> None + +let rec find_map f = function + | [] -> None + | x :: xs -> ( match f x with None -> find_map f xs | Some x -> Some x ) + +module Main : sig end = struct + open Types + open Asttypes + open Location + open Ast_helper + + module Label = struct + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + | Nolabel + | Labelled of string + | Optional of string + + let nolabel : t = Nolabel + end + + let may_tuple ?loc tup = function + | [] -> None + | [ x ] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + + let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc + + let constr ?loc ?attrs s args = + Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) + + let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] + + let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [ x ] -> x + | xs -> Exp.tuple ?loc ?attrs xs + + let app ?loc ?attrs f l = + if l = [] then f + else Exp.apply ?loc ?attrs f (List.map (fun a -> (Label.nolabel, a)) l) + + let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) + + let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + + let func ?loc ?attrs l = + Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) + + let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = + Exp.fun_ ?loc ?attrs label default pat exp + + let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) + + let pconstr ?loc ?attrs s args = + Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) + + let selfcall m args = app (evar m) args + + (*************************************************************************) + + let env = Env.initial_safe_string + + let module_mapping = ref [] + + let rec clean = function + | [ "Location"; "t" ] -> [ "location" ] + | [] -> [] + | [ x ] -> [ x ] + | [ _; "t" ] as x -> x + | _ :: xs -> clean xs + + let print_fun s = + let lid = Longident.parse s in + let s = Longident.flatten lid |> clean in + String.concat "_" ("copy" :: s) + + let printed = Hashtbl.create 16 + + let meths = ref [] + + let rec gen ty = + if Hashtbl.mem printed ty then () + else + let tylid = Longident.parse ty in + let td = + try snd (Env.lookup_type tylid env ~loc:Location.none) + with Not_found -> + Format.eprintf "** Cannot resolve type %s@." ty; + exit 2 + in + let prefix, local = + let open Longident in + match tylid with + | Ldot (m, s) -> (String.concat "." (Longident.flatten m) ^ ".", s) + | Lident s -> ("", s) + | Lapply _ -> assert false + in + let target_prefix = + match + find_map + (fun (v1, v2) -> + match drop_prefix ~prefix:v1 prefix with + | None -> None + | Some suffix -> Some (v2 ^ suffix) ) + !module_mapping + with + | Some x -> x + | None -> prefix + in + let funname = print_fun ty in + Hashtbl.add printed ty (); + let params_in = + List.mapi + (fun i _ -> mkloc (Printf.sprintf "f%i" i) !default_loc) + td.type_params + in + let params_out = + List.mapi + (fun i _ -> mkloc (Printf.sprintf "g%i" i) !default_loc) + td.type_params + in + let env = + List.map2 (fun s t -> (t.id, evar s.txt)) params_in td.type_params + in + let make_result_t tyargs_in tyargs_out = + Typ.( + arrow Asttypes.Nolabel + (constr (lid (prefix ^ local)) tyargs_in) + (constr (lid (target_prefix ^ local)) tyargs_out)) + in + let make_t tyargs_in tyargs_out = + List.fold_right2 + (fun arg_in arg_out t -> + Typ.( + arrow Asttypes.Nolabel (arrow Asttypes.Nolabel arg_in arg_out) t) + ) + tyargs_in tyargs_out + (make_result_t tyargs_in tyargs_out) + in + let tyargs_in = List.map (fun t -> Typ.var t.txt) params_in in + let tyargs_out = List.map (fun t -> Typ.var t.txt) params_out in + let t = + Typ.poly (params_in @ params_out) (make_t tyargs_in tyargs_out) + in + let concrete e = + let e = + List.fold_right + (fun x e -> lam x e) + (List.map (fun x -> pvar x.txt) params_in) + e + in + meths := Vb.mk (Pat.constraint_ (pvar funname) t) e :: !meths + in + let field ld = + let s = Ident.name ld.ld_id in + ( (lid (prefix ^ s), pvar s), + (lid (target_prefix ^ s), tyexpr env ld.ld_type (evar s)) ) + in + match (td.type_kind, td.type_manifest) with + | Type_record (l, _), _ -> + let l = List.map field l in + concrete + (lam + (Pat.record (List.map fst l) Closed) + (Exp.record (List.map snd l) None)) + | Type_variant l, _ -> + let case cd = + let c = Ident.name cd.cd_id in + match cd.cd_args with + | Cstr_tuple tys -> + let p, args = gentuple env tys in + (pconstr (prefix ^ c) p, constr (target_prefix ^ c) args) + | Cstr_record _l -> + failwith "Inline records are not yet supported." + in + concrete (func (List.map case l)) + | Type_abstract, Some t -> concrete (tyexpr_fun env t) + | Type_abstract, None -> failwith ("Abstract type " ^ ty) + | Type_open, _ -> + Format.eprintf "** Open types are not yet supported %s@." ty; + () + + and gentuple env tl = + let arg i t = + let x = Printf.sprintf "x%i" i in + (pvar x, tyexpr env t (evar x)) + in + List.split (List.mapi arg tl) + + and tyexpr env ty x = + match ty.desc with + | Tvar _ -> ( + match List.assoc ty.id env with + | f -> app f [ x ] + | exception Not_found -> failwith "Existentials not supported" ) + | Ttuple tl -> + let p, e = gentuple env tl in + let_in [ Vb.mk (Pat.tuple p) x ] (tuple e) + | Tconstr (path, [ t ], _) when Path.same path Predef.path_list -> + app (evar "List.map") [ tyexpr_fun env t; x ] + | Tconstr (path, [ t ], _) when Path.same path Predef.path_array -> + app (evar "Array.map") [ tyexpr_fun env t; x ] + | Tconstr (path, [ t ], _) when Path.same path Predef.path_option -> + app (evar "Option.map") [ tyexpr_fun env t; x ] + | Tconstr (path, [], _) + when Path.same path Predef.path_string + || Path.same path Predef.path_bytes + || Path.same path Predef.path_bool + || Path.same path Predef.path_unit + || Path.same path Predef.path_exn + || Path.same path Predef.path_int + || Path.same path Predef.path_char + || Path.same path Predef.path_int32 + || Path.same path Predef.path_int64 + || Path.same path Predef.path_nativeint + || Path.same path Predef.path_float + || Path.same path Predef.path_extension_constructor -> + x + | Tconstr (path, tl, _) -> + let ty = Path.name path in + gen ty; + selfcall (print_fun ty) (List.map (tyexpr_fun env) tl @ [ x ]) + | _ -> + Format.eprintf "** Cannot deal with type %a@." Printtyp.type_expr ty; + x + + and tyexpr_fun env ty = lam (pvar "x") (tyexpr env ty (evar "x")) + + let simplify = + (* (fun x -> x) ====> *) + let open Ast_mapper in + let super = default_mapper in + let expr this e = + let e = super.expr this e in + let open Longident in + let open Parsetree in + match e.pexp_desc with + | Pexp_fun + ( Asttypes.Nolabel, + None, + { ppat_desc = Ppat_var { txt = id; _ }; _ }, + { pexp_desc = + Pexp_apply + ( f, + [ ( Asttypes.Nolabel, + { pexp_desc = Pexp_ident { txt = Lident id2; _ }; _ } + ) + ] ) + ; _ + } ) + when id = id2 -> + f + | _ -> e + in + let value_binding this (vb : Parsetree.value_binding) = + let pvb_pat = this.pat this vb.pvb_pat in + let pvb_expr = super.expr this vb.pvb_expr in + let pvb_attributes = this.attributes this vb.pvb_attributes in + let pvb_loc = this.location this vb.pvb_loc in + { Parsetree.pvb_loc; pvb_attributes; pvb_expr; pvb_pat } + in + { super with expr; value_binding } + + let add_mapping s = + let i = + try String.index s ':' + with Not_found -> failwith (Printf.sprintf "Cannot parse mapping %S" s) + in + module_mapping := + ( String.sub s 0 i ^ ".", + String.sub s (i + 1) (String.length s - i - 1) ^ "." ) + :: !module_mapping + + let args = + let open Arg in + [ ( "-I", + String + (fun s -> + Load_path.add_dir (Misc.expand_directory Config.standard_library s) + ), + " Add to the list of include directories" ); + ( "-map", + String add_mapping, + "Old_module:New_module Map types from Old_module to types in \ + New_module" ) + ] + + let usage = Printf.sprintf "%s [options] \n" Sys.argv.(0) + + let main () = + Load_path.init [ Config.standard_library ]; + Arg.parse (Arg.align args) gen usage; + let from_, to_ = + match !module_mapping with + | [ (from_, to_) ] -> + ( String.sub from_ 0 (String.length from_ - 1), + String.sub to_ 0 (String.length to_ - 1) ) + | _ -> failwith "expect one and only one '-map' argument" + in + let s = + [ Str.module_ + (Mb.mk + (mkloc (Some "From") Location.none) + (Mod.ident (mkloc (Longident.parse from_) Location.none))); + Str.module_ + (Mb.mk (mkloc (Some "To") Location.none) + (Mod.ident (mkloc (Longident.parse to_) Location.none))); + Str.value Recursive !meths + ] + in + Format.printf "%a@." Pprintast.structure + (simplify.Ast_mapper.structure simplify s) + + let () = + try main () + with exn -> + Format.eprintf "%a@?" Errors.report_error exn; + exit 1 +end diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.ml b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.ml new file mode 100644 index 000000000..ed0e98028 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.ml @@ -0,0 +1,13 @@ +let () = + match Sys.argv with + | [|_; ocaml_version; fname|] -> + let is_current = + (Filename.basename fname = Printf.sprintf "ast_%s.ml" ocaml_version) + in + let ic = open_in_bin fname in + Printf.printf "# 1 %S\n" fname; + Pp_rewrite.rewrite is_current ocaml_version (Lexing.from_channel ic) + | _ -> + Printf.eprintf "%s: \n" + Sys.executable_name; + exit 2 diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.mli new file mode 100644 index 000000000..e790aeb70 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp.mli @@ -0,0 +1 @@ +(* empty *) diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mli b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mli new file mode 100644 index 000000000..56290ace5 --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mli @@ -0,0 +1 @@ +val rewrite : bool -> string -> Lexing.lexbuf -> unit diff --git a/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mll b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mll new file mode 100644 index 000000000..052d65c5a --- /dev/null +++ b/src/vendored-ocaml-migrate-parsetree-v1.7.3/tools/pp_rewrite.mll @@ -0,0 +1,45 @@ +{ +open Printf + +let print_ocaml_version version = + let patt_len = String.length "OCAML_VERSION" in + (* Note: the spaces in the replacements are to preserve locations *) + printf "%-*s" patt_len version +} + +rule rewrite is_current ocaml_version = parse + | "OCAML_VERSION" + { print_ocaml_version ocaml_version; + rewrite is_current ocaml_version lexbuf + } + | "(*IF_CURRENT " ([^'*']* as s) "*)" + { let chunk = if is_current + then " " ^ s ^ " " + else Lexing.lexeme lexbuf + in + print_string chunk; + rewrite is_current ocaml_version lexbuf + } + | "(*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 + in + print_string chunk; + rewrite is_current ocaml_version lexbuf + } + | "(*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 + in + print_string chunk; + rewrite is_current ocaml_version lexbuf + } + | _ as c + { print_char c; + rewrite is_current ocaml_version lexbuf + } + | eof { () } + +