From fc97ab20653501e08497966540cbe6fbb9bfaa41 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 24 Apr 2023 17:41:40 -0700 Subject: [PATCH 01/64] chore: port to ppxlib (#2711) --- dune-project | 4 +- esy.json | 1 + esy.lock/index.json | 464 +- .../opam | 8 +- .../{cmdliner.1.1.1 => cmdliner.1.2.0}/opam | 4 +- .../opam | 8 +- .../opam | 8 +- esy.lock/opam/{dune.3.7.0 => dune.3.7.1}/opam | 10 +- .../{menhir.20220210 => menhir.20230415}/opam | 8 +- .../opam | 8 +- .../opam | 8 +- .../opam/ocaml-compiler-libs.v0.12.4/opam | 39 + esy.lock/opam/ppxlib.0.29.1/opam | 63 + esy.lock/opam/sexplib0.v0.15.1/opam | 26 + esy.lock/opam/stdlib-shims.0.3.0/opam | 31 + .../opam/{utop.2.11.0 => utop.2.12.0}/opam | 8 +- esy.lock/opam/{xdg.3.7.0 => xdg.3.7.1}/opam | 8 +- flake.lock | 44 +- nix/default.nix | 2 + reason.json | 1 + reason.opam | 1 + src/ppx/dune | 6 - src/ppx/reactjs_jsx_ppx_v2.ml | 411 -- src/ppx/reactjs_jsx_ppx_v2.mli | 11 - src/reason-merlin/ocamlmerlin_reason.cppo.ml | 8 +- src/reason-parser-tests/testOprint.cppo.ml | 8 +- src/reason-parser/dune | 6 +- src/reason-parser/reason_attributes.ml | 3 +- src/reason-parser/reason_errors.ml | 3 +- src/reason-parser/reason_errors.mli | 2 +- src/reason-parser/reason_heuristics.ml | 22 +- src/reason-parser/reason_oprint.ml | 63 +- src/reason-parser/reason_parser.mly | 117 +- src/reason-parser/reason_parser_def.ml | 2 +- src/reason-parser/reason_pprint_ast.ml | 173 +- src/reason-parser/reason_pprint_ast.mli | 17 +- src/reason-parser/reason_syntax_util.cppo.ml | 423 +- src/reason-parser/reason_syntax_util.cppo.mli | 37 +- src/reason-parser/reason_toolchain.ml | 5 +- src/reason-parser/reason_toolchain_conf.ml | 13 +- src/reason-parser/reason_toolchain_ocaml.ml | 61 +- src/reason-parser/reason_toolchain_reason.ml | 1 - src/refmt/printer_maker.ml | 22 +- src/refmt/reason_implementation_printer.ml | 21 +- src/refmt/reason_interface_printer.ml | 21 +- src/vendored-omp/src/ast_402.ml | 2673 ----------- src/vendored-omp/src/ast_403.ml | 2755 ----------- src/vendored-omp/src/ast_404.ml | 2772 ----------- src/vendored-omp/src/ast_405.ml | 2844 ------------ src/vendored-omp/src/ast_406.ml | 2874 ------------ src/vendored-omp/src/ast_407.ml | 2889 ------------ src/vendored-omp/src/ast_408.ml | 4000 +--------------- src/vendored-omp/src/ast_409.ml | 4001 +--------------- src/vendored-omp/src/ast_410.ml | 4017 +--------------- src/vendored-omp/src/ast_411.ml | 4036 +--------------- src/vendored-omp/src/ast_412.ml | 4052 +--------------- src/vendored-omp/src/ast_413.ml | 4083 +--------------- src/vendored-omp/src/ast_414.ml | 4135 +---------------- src/vendored-omp/src/ast_500.ml | 4135 +---------------- .../src/migrate_parsetree_402_403.ml | 113 - .../src/migrate_parsetree_402_403_migrate.ml | 2060 +------- .../src/migrate_parsetree_403_402.ml | 113 - .../src/migrate_parsetree_403_402_migrate.ml | 2081 +-------- .../src/migrate_parsetree_403_404.ml | 113 - .../src/migrate_parsetree_403_404_migrate.ml | 2067 +------- .../src/migrate_parsetree_404_403.ml | 113 - .../src/migrate_parsetree_404_403_migrate.ml | 2076 +-------- .../src/migrate_parsetree_404_405.ml | 113 - .../src/migrate_parsetree_404_405_migrate.ml | 1902 +------- .../src/migrate_parsetree_405_404.ml | 113 - .../src/migrate_parsetree_405_404_migrate.ml | 1900 +------- .../src/migrate_parsetree_405_406.ml | 113 - .../src/migrate_parsetree_405_406_migrate.ml | 1904 +------- .../src/migrate_parsetree_406_405.ml | 113 - .../src/migrate_parsetree_406_405_migrate.ml | 1916 +------- .../src/migrate_parsetree_406_407.ml | 113 - .../src/migrate_parsetree_406_407_migrate.ml | 1931 +------- .../src/migrate_parsetree_407_406.ml | 113 - .../src/migrate_parsetree_407_406_migrate.ml | 1927 +------- .../src/migrate_parsetree_407_408.ml | 121 - .../src/migrate_parsetree_407_408_migrate.ml | 1993 +------- .../src/migrate_parsetree_408_407.ml | 118 - .../src/migrate_parsetree_408_407_migrate.ml | 1999 +------- .../src/migrate_parsetree_408_409.ml | 123 - .../src/migrate_parsetree_408_409_migrate.ml | 1200 +---- .../src/migrate_parsetree_409_408.ml | 123 - .../src/migrate_parsetree_409_408_migrate.ml | 1200 +---- .../src/migrate_parsetree_409_410.ml | 124 - .../src/migrate_parsetree_409_410_migrate.ml | 1310 +----- .../src/migrate_parsetree_410_409.ml | 123 - .../src/migrate_parsetree_410_409_migrate.ml | 1242 +---- .../src/migrate_parsetree_410_411.ml | 125 - .../src/migrate_parsetree_410_411_migrate.ml | 1209 +---- .../src/migrate_parsetree_411_410.ml | 125 - .../src/migrate_parsetree_411_410_migrate.ml | 1210 +---- .../src/migrate_parsetree_411_412.ml | 126 - .../src/migrate_parsetree_411_412_migrate.ml | 1215 +---- .../src/migrate_parsetree_412_411.ml | 127 - .../src/migrate_parsetree_412_411_migrate.ml | 1264 +---- .../src/migrate_parsetree_412_413.ml | 127 - .../src/migrate_parsetree_412_413_migrate.ml | 1224 +---- .../src/migrate_parsetree_413_412.ml | 128 - .../src/migrate_parsetree_413_412_migrate.ml | 1242 +---- .../src/migrate_parsetree_413_414.ml | 127 - .../src/migrate_parsetree_413_414_migrate.ml | 1237 +---- .../src/migrate_parsetree_414_413.ml | 128 - .../src/migrate_parsetree_414_413_migrate.ml | 1247 +---- .../src/migrate_parsetree_414_500.ml | 128 - .../src/migrate_parsetree_414_500_migrate.ml | 1241 +---- .../src/migrate_parsetree_500_414.ml | 128 - .../src/migrate_parsetree_500_414_migrate.ml | 1241 +---- .../src/migrate_parsetree_ast_io.ml | 101 - .../src/migrate_parsetree_ast_io.mli | 49 - .../src/migrate_parsetree_driver.ml | 599 --- .../src/migrate_parsetree_driver.mli | 113 - .../src/migrate_parsetree_parse.ml | 53 - .../src/migrate_parsetree_parse.mli | 32 - .../src/migrate_parsetree_versions.ml | 250 +- .../src/migrate_parsetree_versions.mli | 94 +- src/vendored-omp/src/reason_omp.ml | 9 - src/vendored-omp/tools/dune | 10 +- src/vendored-omp/tools/gencopy.ml | 18 +- test/basics.t/run.t | 1 + test/lib/typedtreePrinter.cppo.ml | 8 +- 124 files changed, 4460 insertions(+), 92522 deletions(-) rename esy.lock/opam/{chrome-trace.3.7.0 => chrome-trace.3.7.1}/opam (69%) rename esy.lock/opam/{cmdliner.1.1.1 => cmdliner.1.2.0}/opam (90%) rename esy.lock/opam/{dune-build-info.3.7.0 => dune-build-info.3.7.1}/opam (75%) rename esy.lock/opam/{dune-configurator.3.7.0 => dune-configurator.3.7.1}/opam (75%) rename esy.lock/opam/{dune.3.7.0 => dune.3.7.1}/opam (79%) rename esy.lock/opam/{menhir.20220210 => menhir.20230415}/opam (66%) rename esy.lock/opam/{menhirLib.20220210 => menhirLib.20230415}/opam (67%) rename esy.lock/opam/{menhirSdk.20220210 => menhirSdk.20230415}/opam (67%) create mode 100644 esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam create mode 100644 esy.lock/opam/ppxlib.0.29.1/opam create mode 100644 esy.lock/opam/sexplib0.v0.15.1/opam create mode 100644 esy.lock/opam/stdlib-shims.0.3.0/opam rename esy.lock/opam/{utop.2.11.0 => utop.2.12.0}/opam (79%) rename esy.lock/opam/{xdg.3.7.0 => xdg.3.7.1}/opam (68%) delete mode 100644 src/ppx/dune delete mode 100644 src/ppx/reactjs_jsx_ppx_v2.ml delete mode 100644 src/ppx/reactjs_jsx_ppx_v2.mli delete mode 100644 src/vendored-omp/src/migrate_parsetree_ast_io.ml delete mode 100644 src/vendored-omp/src/migrate_parsetree_ast_io.mli delete mode 100644 src/vendored-omp/src/migrate_parsetree_driver.ml delete mode 100644 src/vendored-omp/src/migrate_parsetree_driver.mli delete mode 100644 src/vendored-omp/src/migrate_parsetree_parse.ml delete mode 100644 src/vendored-omp/src/migrate_parsetree_parse.mli diff --git a/dune-project b/dune-project index 6b1228397..546b268db 100644 --- a/dune-project +++ b/dune-project @@ -43,7 +43,9 @@ (merlin-extend (>= "0.6")) fix - ppx_derivers)) + ppx_derivers + (ppxlib + (>= "0.28.0")))) (package (name rtop) diff --git a/esy.json b/esy.json index c3cf11de6..f0906fe68 100644 --- a/esy.json +++ b/esy.json @@ -12,6 +12,7 @@ "@opam/merlin-extend": " >= 0.6", "@opam/ocamlfind": "1.9.5", "@opam/ppx_derivers": "< 2.0.0", + "@opam/ppxlib": "> 0.28.x", "@opam/utop": " >= 1.17.0", "ocaml": " >= 4.3.0 < 4.15.0" }, diff --git a/esy.lock/index.json b/esy.lock/index.json index b811aa7b4..e16b24647 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "541ef021a71d9d8bce474b1d40a99f0b", + "checksum": "c3c0ec4dc1dab9c4069b9ff27b904076", "root": "reason-cli@link-dev:./esy.json", "node": { "reason-cli@link-dev:./esy.json": { @@ -9,14 +9,15 @@ "source": { "type": "link-dev", "path": ".", "manifest": "esy.json" }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/utop@opam:2.11.0@bd245e47", + "ocaml@4.14.0@d41d8cd9", "@opam/utop@opam:2.12.0@41cf0331", + "@opam/ppxlib@opam:0.29.1@8414c948", "@opam/ppx_derivers@opam:1.2.1@e2cbad12", "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/merlin-extend@opam:0.6.1@7d979feb", - "@opam/menhir@opam:20220210@ff5ea9a7", + "@opam/menhir@opam:20230415@ce1c9ac7", "@opam/fix@opam:20220121@17b9a1a4", - "@opam/dune-build-info@opam:3.7.0@ce68449d", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune-build-info@opam:3.7.1@adf0d411", + "@opam/dune@opam:3.7.1@40db2f22" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/odoc@opam:2.2.0@020767ad", @@ -59,14 +60,14 @@ "@opam/uuseg@opam:15.0.0@14085231", "@opam/uucp@opam:15.0.0@55460339", "@opam/uchar@opam:0.0.2@aedf91f9", "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/uuseg@opam:15.0.0@14085231", "@opam/uucp@opam:15.0.0@55460339", "@opam/uchar@opam:0.0.2@aedf91f9", "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/yojson@opam:2.0.2@eb65f292": { @@ -88,37 +89,37 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, - "@opam/xdg@opam:3.7.0@449d6490": { - "id": "@opam/xdg@opam:3.7.0@449d6490", + "@opam/xdg@opam:3.7.1@387cb889": { + "id": "@opam/xdg@opam:3.7.1@387cb889", "name": "@opam/xdg", - "version": "opam:3.7.0", + "version": "opam:3.7.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e2/e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8", - "archive:https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" + "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", + "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" ], "opam": { "name": "xdg", - "version": "3.7.0", - "path": "esy.lock/opam/xdg.3.7.0" + "version": "3.7.1", + "path": "esy.lock/opam/xdg.3.7.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/uutf@opam:1.0.3@47c95a18": { @@ -142,7 +143,7 @@ "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] @@ -169,7 +170,7 @@ "@opam/uucp@opam:15.0.0@55460339", "@opam/topkg@opam:1.0.7@7ee47d76", "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ @@ -198,25 +199,25 @@ "@opam/topkg@opam:1.0.7@7ee47d76", "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] }, - "@opam/utop@opam:2.11.0@bd245e47": { - "id": "@opam/utop@opam:2.11.0@bd245e47", + "@opam/utop@opam:2.12.0@41cf0331": { + "id": "@opam/utop@opam:2.12.0@41cf0331", "name": "@opam/utop", - "version": "opam:2.11.0", + "version": "opam:2.12.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/69/6937c6c672913ac3b875341ac4a205c7561d01cd8ac8f47cfb35d3bc0e762170#sha256:6937c6c672913ac3b875341ac4a205c7561d01cd8ac8f47cfb35d3bc0e762170", - "archive:https://github.com/ocaml-community/utop/releases/download/2.11.0/utop-2.11.0.tbz#sha256:6937c6c672913ac3b875341ac4a205c7561d01cd8ac8f47cfb35d3bc0e762170" + "archive:https://opam.ocaml.org/cache/sha256/ad/ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea#sha256:ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea", + "archive:https://github.com/ocaml-community/utop/releases/download/2.12.0/utop-2.12.0.tbz#sha256:ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea" ], "opam": { "name": "utop", - "version": "2.11.0", - "path": "esy.lock/opam/utop.2.11.0" + "version": "2.12.0", + "path": "esy.lock/opam/utop.2.12.0" } }, "overrides": [], @@ -227,7 +228,7 @@ "@opam/lwt_react@opam:1.2.0@4253a145", "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", "@opam/lambda-term@opam:3.3.1@ee145aff", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" @@ -239,7 +240,7 @@ "@opam/lwt_react@opam:1.2.0@4253a145", "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", "@opam/lambda-term@opam:3.3.1@ee145aff", - "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084" ] @@ -292,12 +293,12 @@ "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/trie@opam:1.0.0@f4e510e2": { @@ -318,11 +319,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/topkg@opam:1.0.7@7ee47d76": { @@ -371,7 +372,7 @@ "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" @@ -379,11 +380,36 @@ "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@opam/base-unix@opam:base@87d0b2eb" ] }, + "@opam/stdlib-shims@opam:0.3.0@72c7bc98": { + "id": "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "name": "@opam/stdlib-shims", + "version": "opam:0.3.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/ba/babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a", + "archive:https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" + ], + "opam": { + "name": "stdlib-shims", + "version": "0.3.0", + "path": "esy.lock/opam/stdlib-shims.0.3.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + ] + }, "@opam/spawn@opam:v0.15.1@85e9d6f1": { "id": "@opam/spawn@opam:v0.15.1@85e9d6f1", "name": "@opam/spawn", @@ -402,11 +428,36 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + ] + }, + "@opam/sexplib0@opam:v0.15.1@51111c0c": { + "id": "@opam/sexplib0@opam:v0.15.1@51111c0c", + "name": "@opam/sexplib0", + "version": "opam:v0.15.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/ab/ab8fd6273f35a792cad48cbb3024a7f9#md5:ab8fd6273f35a792cad48cbb3024a7f9", + "archive:https://github.com/janestreet/sexplib0/archive/refs/tags/v0.15.1.tar.gz#md5:ab8fd6273f35a792cad48cbb3024a7f9" + ], + "opam": { + "name": "sexplib0", + "version": "v0.15.1", + "path": "esy.lock/opam/sexplib0.v0.15.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/seq@opam:base@d8d7de1d": { @@ -446,11 +497,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/react@opam:1.2.2@e0f4480e": { @@ -497,11 +548,43 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" + ] + }, + "@opam/ppxlib@opam:0.29.1@8414c948": { + "id": "@opam/ppxlib@opam:0.29.1@8414c948", + "name": "@opam/ppxlib", + "version": "opam:0.29.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/c8/c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79#sha256:c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79", + "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.29.1/ppxlib-0.29.1.tbz#sha256:c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79" + ], + "opam": { + "name": "ppxlib", + "version": "0.29.1", + "path": "esy.lock/opam/ppxlib.0.29.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.15.1@51111c0c", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.15.1@51111c0c", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7": { @@ -523,11 +606,11 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/ppx_derivers@opam:1.2.1@e2cbad12": { @@ -548,11 +631,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/pp@opam:1.1.2@89ad03b5": { @@ -573,11 +656,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/ordering@opam:3.6.2@37bc3093": { @@ -598,11 +681,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/omd@opam:1.3.2@511d53d2": { @@ -623,13 +706,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-bytes@opam:base@19d0c2ff", "@opam/base-bigarray@opam:base@b03491b0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-bytes@opam:base@19d0c2ff", "@opam/base-bigarray@opam:base@b03491b0" ] @@ -653,14 +736,14 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/camlp-streams@opam:5.0.1@daaa0f94", "@opam/astring@opam:0.8.5@1300cee8", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/camlp-streams@opam:5.0.1@daaa0f94", "@opam/astring@opam:0.8.5@1300cee8" ] @@ -687,8 +770,8 @@ "@opam/result@opam:1.5@1c6a6533", "@opam/odoc-parser@opam:2.0.0@a08011a0", "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/cppo@opam:1.6.9@db929a12", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@opam/astring@opam:0.8.5@1300cee8", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], @@ -697,8 +780,8 @@ "@opam/result@opam:1.5@1c6a6533", "@opam/odoc-parser@opam:2.0.0@a08011a0", "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:3.7.0@95218dc4", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/dune@opam:3.7.1@40db2f22", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@opam/astring@opam:0.8.5@1300cee8" ] }, @@ -720,11 +803,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/ocplib-endian@opam:1.2@008dc942": { @@ -745,13 +828,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-bytes@opam:base@19d0c2ff", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-bytes@opam:base@19d0c2ff" ] }, @@ -773,11 +856,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7" ] }, @@ -827,11 +910,11 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/ocamlbuild@opam:0.14.2@c6163b28": { @@ -880,7 +963,7 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/xdg@opam:3.7.0@449d6490", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/xdg@opam:3.7.1@387cb889", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdune@opam:3.6.2@47d75c4b", "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.10.4@c4910ba6", "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", @@ -891,14 +974,14 @@ "@opam/ocamlc-loc@opam:3.6.2@edc950a7", "@opam/fiber@opam:3.6.2@349136be", "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune-rpc@opam:3.6.2@d874b9d2", - "@opam/dune-build-info@opam:3.7.0@ce68449d", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/csexp@opam:1.5.1@8a8fb3a7", - "@opam/chrome-trace@opam:3.7.0@6448e71e", + "@opam/dune-build-info@opam:3.7.1@adf0d411", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", + "@opam/chrome-trace@opam:3.7.1@92d3c503", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/xdg@opam:3.7.0@449d6490", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/xdg@opam:3.7.1@387cb889", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdune@opam:3.6.2@47d75c4b", "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.10.4@c4910ba6", "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", @@ -909,9 +992,34 @@ "@opam/ocamlc-loc@opam:3.6.2@edc950a7", "@opam/fiber@opam:3.6.2@349136be", "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune-rpc@opam:3.6.2@d874b9d2", - "@opam/dune-build-info@opam:3.7.0@ce68449d", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/csexp@opam:1.5.1@8a8fb3a7", - "@opam/chrome-trace@opam:3.7.0@6448e71e" + "@opam/dune-build-info@opam:3.7.1@adf0d411", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", + "@opam/chrome-trace@opam:3.7.1@92d3c503" + ] + }, + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882": { + "id": "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "name": "@opam/ocaml-compiler-libs", + "version": "opam:v0.12.4", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/4e/4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760", + "archive:https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" + ], + "opam": { + "name": "ocaml-compiler-libs", + "version": "v0.12.4", + "path": "esy.lock/opam/ocaml-compiler-libs.v0.12.4" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/mew_vi@opam:0.5.0@cf66c299": { @@ -933,12 +1041,12 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.0@95218dc4" + "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/mew@opam:0.1.0@65011d4b": { @@ -960,12 +1068,12 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.0@95218dc4" + "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/merlin-extend@opam:0.6.1@7d979feb": { @@ -986,89 +1094,89 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, - "@opam/menhirSdk@opam:20220210@fe146ed3": { - "id": "@opam/menhirSdk@opam:20220210@fe146ed3", + "@opam/menhirSdk@opam:20230415@2aa219cc": { + "id": "@opam/menhirSdk@opam:20230415@2aa219cc", "name": "@opam/menhirSdk", - "version": "opam:20220210", + "version": "opam:20230415", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" + "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" ], "opam": { "name": "menhirSdk", - "version": "20220210", - "path": "esy.lock/opam/menhirSdk.20220210" + "version": "20230415", + "path": "esy.lock/opam/menhirSdk.20230415" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, - "@opam/menhirLib@opam:20220210@9afeb270": { - "id": "@opam/menhirLib@opam:20220210@9afeb270", + "@opam/menhirLib@opam:20230415@78be630c": { + "id": "@opam/menhirLib@opam:20230415@78be630c", "name": "@opam/menhirLib", - "version": "opam:20220210", + "version": "opam:20230415", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" + "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" ], "opam": { "name": "menhirLib", - "version": "20220210", - "path": "esy.lock/opam/menhirLib.20220210" + "version": "20230415", + "path": "esy.lock/opam/menhirLib.20230415" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, - "@opam/menhir@opam:20220210@ff5ea9a7": { - "id": "@opam/menhir@opam:20220210@ff5ea9a7", + "@opam/menhir@opam:20230415@ce1c9ac7": { + "id": "@opam/menhir@opam:20230415@ce1c9ac7", "name": "@opam/menhir", - "version": "opam:20220210", + "version": "opam:20230415", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/e3/e3cef220f676c4b1c16cbccb174cefe3#md5:e3cef220f676c4b1c16cbccb174cefe3", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz#md5:e3cef220f676c4b1c16cbccb174cefe3" + "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" ], "opam": { "name": "menhir", - "version": "20220210", - "path": "esy.lock/opam/menhir.20220210" + "version": "20230415", + "path": "esy.lock/opam/menhir.20230415" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20220210@fe146ed3", - "@opam/menhirLib@opam:20220210@9afeb270", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20230415@2aa219cc", + "@opam/menhirLib@opam:20230415@78be630c", + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20220210@fe146ed3", - "@opam/menhirLib@opam:20220210@9afeb270", - "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20230415@2aa219cc", + "@opam/menhirLib@opam:20230415@78be630c", + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/lwt_react@opam:1.2.0@4253a145": { @@ -1090,12 +1198,12 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.0@95218dc4" + "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/lwt@opam:5.6.1@2a9902ab": { @@ -1117,16 +1225,16 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", - "@opam/dune-configurator@opam:3.7.0@4fa6f76e", - "@opam/dune@opam:3.7.0@95218dc4", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/dune-configurator@opam:3.7.1@32ab7c21", + "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", - "@opam/dune-configurator@opam:3.7.0@4fa6f76e", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune-configurator@opam:3.7.1@32ab7c21", + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/logs@opam:0.7.0@46a3dffc": { @@ -1151,7 +1259,7 @@ "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/ocamlbuild@opam:0.14.2@c6163b28", "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/fmt@opam:0.9.0@87213963", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], @@ -1180,7 +1288,7 @@ "@opam/mew_vi@opam:0.5.0@cf66c299", "@opam/lwt_react@opam:1.2.0@4253a145", "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/zed@opam:3.2.1@276736c0", @@ -1188,7 +1296,7 @@ "@opam/mew_vi@opam:0.5.0@cf66c299", "@opam/lwt_react@opam:1.2.0@4253a145", "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/fpath@opam:0.7.3@674d8125": { @@ -1240,7 +1348,7 @@ "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", "@opam/ocamlfind@opam:1.9.5@e83abf74", "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], @@ -1264,11 +1372,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/fiber@opam:3.6.2@349136be": { @@ -1290,12 +1398,12 @@ "overrides": [], "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/dyn@opam:3.6.2@38120dfc": { @@ -1318,12 +1426,12 @@ "dependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dune@opam:3.7.0@95218dc4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dune@opam:3.7.0@95218dc4" + "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/dune-rpc@opam:3.6.2@d874b9d2": { @@ -1344,86 +1452,86 @@ }, "overrides": [], "dependencies": [ - "@opam/xdg@opam:3.7.0@449d6490", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/xdg@opam:3.7.1@387cb889", "@opam/stdune@opam:3.6.2@47d75c4b", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "@opam/xdg@opam:3.7.0@449d6490", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/xdg@opam:3.7.1@387cb889", "@opam/stdune@opam:3.6.2@47d75c4b", "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7" ] }, - "@opam/dune-configurator@opam:3.7.0@4fa6f76e": { - "id": "@opam/dune-configurator@opam:3.7.0@4fa6f76e", + "@opam/dune-configurator@opam:3.7.1@32ab7c21": { + "id": "@opam/dune-configurator@opam:3.7.1@32ab7c21", "name": "@opam/dune-configurator", - "version": "opam:3.7.0", + "version": "opam:3.7.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e2/e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8", - "archive:https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" + "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", + "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" ], "opam": { "name": "dune-configurator", - "version": "3.7.0", - "path": "esy.lock/opam/dune-configurator.3.7.0" + "version": "3.7.1", + "path": "esy.lock/opam/dune-configurator.3.7.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", "@opam/base-unix@opam:base@87d0b2eb" ] }, - "@opam/dune-build-info@opam:3.7.0@ce68449d": { - "id": "@opam/dune-build-info@opam:3.7.0@ce68449d", + "@opam/dune-build-info@opam:3.7.1@adf0d411": { + "id": "@opam/dune-build-info@opam:3.7.1@adf0d411", "name": "@opam/dune-build-info", - "version": "opam:3.7.0", + "version": "opam:3.7.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e2/e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8", - "archive:https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" + "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", + "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" ], "opam": { "name": "dune-build-info", - "version": "3.7.0", - "path": "esy.lock/opam/dune-build-info.3.7.0" + "version": "3.7.1", + "path": "esy.lock/opam/dune-build-info.3.7.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, - "@opam/dune@opam:3.7.0@95218dc4": { - "id": "@opam/dune@opam:3.7.0@95218dc4", + "@opam/dune@opam:3.7.1@40db2f22": { + "id": "@opam/dune@opam:3.7.1@40db2f22", "name": "@opam/dune", - "version": "opam:3.7.0", + "version": "opam:3.7.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e2/e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8", - "archive:https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" + "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", + "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" ], "opam": { "name": "dune", - "version": "3.7.0", - "path": "esy.lock/opam/dune.3.7.0" + "version": "3.7.1", + "path": "esy.lock/opam/dune.3.7.1" } }, "overrides": [], @@ -1455,11 +1563,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/cppo@opam:1.6.9@db929a12": { @@ -1480,29 +1588,29 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@opam/base-unix@opam:base@87d0b2eb" ] }, - "@opam/cmdliner@opam:1.1.1@03763729": { - "id": "@opam/cmdliner@opam:1.1.1@03763729", + "@opam/cmdliner@opam:1.2.0@b0c6143c": { + "id": "@opam/cmdliner@opam:1.2.0@b0c6143c", "name": "@opam/cmdliner", - "version": "opam:1.1.1", + "version": "opam:1.2.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha512/54/5478ad833da254b5587b3746e3a8493e66e867a081ac0f653a901cc8a7d944f66e4387592215ce25d939be76f281c4785702f54d4a74b1700bc8838a62255c9e#sha512:5478ad833da254b5587b3746e3a8493e66e867a081ac0f653a901cc8a7d944f66e4387592215ce25d939be76f281c4785702f54d4a74b1700bc8838a62255c9e", - "archive:https://erratique.ch/software/cmdliner/releases/cmdliner-1.1.1.tbz#sha512:5478ad833da254b5587b3746e3a8493e66e867a081ac0f653a901cc8a7d944f66e4387592215ce25d939be76f281c4785702f54d4a74b1700bc8838a62255c9e" + "archive:https://opam.ocaml.org/cache/sha512/6f/6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b#sha512:6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b", + "archive:https://erratique.ch/software/cmdliner/releases/cmdliner-1.2.0.tbz#sha512:6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b" ], "opam": { "name": "cmdliner", - "version": "1.1.1", - "path": "esy.lock/opam/cmdliner.1.1.1" + "version": "1.2.0", + "path": "esy.lock/opam/cmdliner.1.2.0" } }, "overrides": [], @@ -1511,29 +1619,29 @@ ], "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] }, - "@opam/chrome-trace@opam:3.7.0@6448e71e": { - "id": "@opam/chrome-trace@opam:3.7.0@6448e71e", + "@opam/chrome-trace@opam:3.7.1@92d3c503": { + "id": "@opam/chrome-trace@opam:3.7.1@92d3c503", "name": "@opam/chrome-trace", - "version": "opam:3.7.0", + "version": "opam:3.7.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e2/e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8", - "archive:https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz#sha256:e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" + "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", + "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" ], "opam": { "name": "chrome-trace", - "version": "3.7.0", - "path": "esy.lock/opam/chrome-trace.3.7.0" + "version": "3.7.1", + "path": "esy.lock/opam/chrome-trace.3.7.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/camlp-streams@opam:5.0.1@daaa0f94": { @@ -1554,11 +1662,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4", + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.0@95218dc4" + "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" ] }, "@opam/base-unix@opam:base@87d0b2eb": { diff --git a/esy.lock/opam/chrome-trace.3.7.0/opam b/esy.lock/opam/chrome-trace.3.7.1/opam similarity index 69% rename from esy.lock/opam/chrome-trace.3.7.0/opam rename to esy.lock/opam/chrome-trace.3.7.1/opam index 46cf1c78d..74649f970 100644 --- a/esy.lock/opam/chrome-trace.3.7.0/opam +++ b/esy.lock/opam/chrome-trace.3.7.1/opam @@ -30,10 +30,10 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz" + src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" checksum: [ - "sha256=e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" - "sha512=586e47ee45cd53a8c13095bde0b47de99aad9462d0a52199362140b5b654ca862597fa9f27f729a8cc594684ac46858848f9fa76f8f06dc8dc8ab8b1186a3295" + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" ] } -x-commit-hash: "d3d628f2eda2278bd2df6e37452d8693f367fcfd" +x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" diff --git a/esy.lock/opam/cmdliner.1.1.1/opam b/esy.lock/opam/cmdliner.1.2.0/opam similarity index 90% rename from esy.lock/opam/cmdliner.1.1.1/opam rename to esy.lock/opam/cmdliner.1.2.0/opam index 702b586b3..b29bd296e 100644 --- a/esy.lock/opam/cmdliner.1.1.1/opam +++ b/esy.lock/opam/cmdliner.1.2.0/opam @@ -33,7 +33,7 @@ install: [ ] dev-repo: "git+https://erratique.ch/repos/cmdliner.git" url { - src: "https://erratique.ch/software/cmdliner/releases/cmdliner-1.1.1.tbz" + src: "https://erratique.ch/software/cmdliner/releases/cmdliner-1.2.0.tbz" checksum: - "sha512=5478ad833da254b5587b3746e3a8493e66e867a081ac0f653a901cc8a7d944f66e4387592215ce25d939be76f281c4785702f54d4a74b1700bc8838a62255c9e" + "sha512=6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b" } \ No newline at end of file diff --git a/esy.lock/opam/dune-build-info.3.7.0/opam b/esy.lock/opam/dune-build-info.3.7.1/opam similarity index 75% rename from esy.lock/opam/dune-build-info.3.7.0/opam rename to esy.lock/opam/dune-build-info.3.7.1/opam index 059e6e18a..45de3528d 100644 --- a/esy.lock/opam/dune-build-info.3.7.0/opam +++ b/esy.lock/opam/dune-build-info.3.7.1/opam @@ -36,10 +36,10 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz" + src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" checksum: [ - "sha256=e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" - "sha512=586e47ee45cd53a8c13095bde0b47de99aad9462d0a52199362140b5b654ca862597fa9f27f729a8cc594684ac46858848f9fa76f8f06dc8dc8ab8b1186a3295" + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" ] } -x-commit-hash: "d3d628f2eda2278bd2df6e37452d8693f367fcfd" +x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" diff --git a/esy.lock/opam/dune-configurator.3.7.0/opam b/esy.lock/opam/dune-configurator.3.7.1/opam similarity index 75% rename from esy.lock/opam/dune-configurator.3.7.0/opam rename to esy.lock/opam/dune-configurator.3.7.1/opam index c5555e817..be511dfee 100644 --- a/esy.lock/opam/dune-configurator.3.7.0/opam +++ b/esy.lock/opam/dune-configurator.3.7.1/opam @@ -40,10 +40,10 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz" + src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" checksum: [ - "sha256=e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" - "sha512=586e47ee45cd53a8c13095bde0b47de99aad9462d0a52199362140b5b654ca862597fa9f27f729a8cc594684ac46858848f9fa76f8f06dc8dc8ab8b1186a3295" + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" ] } -x-commit-hash: "d3d628f2eda2278bd2df6e37452d8693f367fcfd" +x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" diff --git a/esy.lock/opam/dune.3.7.0/opam b/esy.lock/opam/dune.3.7.1/opam similarity index 79% rename from esy.lock/opam/dune.3.7.0/opam rename to esy.lock/opam/dune.3.7.1/opam index c9207f2cd..4a739625d 100644 --- a/esy.lock/opam/dune.3.7.0/opam +++ b/esy.lock/opam/dune.3.7.1/opam @@ -42,15 +42,15 @@ build: [ depends: [ # Please keep the lower bound in sync with .github/workflows/workflow.yml, # dune-project and min_ocaml_version in bootstrap.ml - ("ocaml" {>= "4.08"} | ("ocaml" {< "4.08~~"} & "ocamlfind-secondary")) + ("ocaml" {>= "4.08"} | ("ocaml" {>= "4.02" & < "4.08~~"} & "ocamlfind-secondary")) "base-unix" "base-threads" ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz" + src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" checksum: [ - "sha256=e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" - "sha512=586e47ee45cd53a8c13095bde0b47de99aad9462d0a52199362140b5b654ca862597fa9f27f729a8cc594684ac46858848f9fa76f8f06dc8dc8ab8b1186a3295" + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" ] } -x-commit-hash: "d3d628f2eda2278bd2df6e37452d8693f367fcfd" +x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" diff --git a/esy.lock/opam/menhir.20220210/opam b/esy.lock/opam/menhir.20230415/opam similarity index 66% rename from esy.lock/opam/menhir.20220210/opam rename to esy.lock/opam/menhir.20230415/opam index 498658b42..d61711fc0 100644 --- a/esy.lock/opam/menhir.20220210/opam +++ b/esy.lock/opam/menhir.20230415/opam @@ -8,7 +8,7 @@ authors: [ homepage: "http://gitlab.inria.fr/fpottier/menhir" dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" bug-reports: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception" +license: "GPL-2.0-only" build: [ ["dune" "build" "-p" name "-j" jobs] ] @@ -21,9 +21,9 @@ depends: [ synopsis: "An LR(1) parser generator" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" + "md5=7c4b51e1b666711af04f7832ebc90618" + "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" ] } diff --git a/esy.lock/opam/menhirLib.20220210/opam b/esy.lock/opam/menhirLib.20230415/opam similarity index 67% rename from esy.lock/opam/menhirLib.20220210/opam rename to esy.lock/opam/menhirLib.20230415/opam index d2097ae4f..6673506d3 100644 --- a/esy.lock/opam/menhirLib.20220210/opam +++ b/esy.lock/opam/menhirLib.20230415/opam @@ -8,7 +8,7 @@ authors: [ homepage: "http://gitlab.inria.fr/fpottier/menhir" dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" bug-reports: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception" +license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" build: [ ["dune" "build" "-p" name "-j" jobs] ] @@ -22,9 +22,9 @@ conflicts: [ synopsis: "Runtime support library for parsers generated by Menhir" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" + "md5=7c4b51e1b666711af04f7832ebc90618" + "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" ] } diff --git a/esy.lock/opam/menhirSdk.20220210/opam b/esy.lock/opam/menhirSdk.20230415/opam similarity index 67% rename from esy.lock/opam/menhirSdk.20220210/opam rename to esy.lock/opam/menhirSdk.20230415/opam index 585d2ca33..57f8ea866 100644 --- a/esy.lock/opam/menhirSdk.20220210/opam +++ b/esy.lock/opam/menhirSdk.20230415/opam @@ -8,7 +8,7 @@ authors: [ homepage: "http://gitlab.inria.fr/fpottier/menhir" dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" bug-reports: "https://gitlab.inria.fr/fpottier/menhir/-/issues" -license: "LGPL-2.0-only WITH OCaml-LGPL-linking-exception" +license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" build: [ ["dune" "build" "-p" name "-j" jobs] ] @@ -22,9 +22,9 @@ conflicts: [ synopsis: "Compile-time library for auxiliary tools related to Menhir" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20220210/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" checksum: [ - "md5=e3cef220f676c4b1c16cbccb174cefe3" - "sha512=3063fec1d8b9fe092c8461b0689d426c7fe381a2bf3fd258dc42ceecca1719d32efbb8a18d94ada5555c38175ea352da3adbb239fdbcbcf52c3a5c85a4d9586f" + "md5=7c4b51e1b666711af04f7832ebc90618" + "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" ] } diff --git a/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam b/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam new file mode 100644 index 000000000..14c9f7537 --- /dev/null +++ b/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam @@ -0,0 +1,39 @@ +opam-version: "2.0" +synopsis: "OCaml compiler libraries repackaged" +description: """ +This packages exposes the OCaml compiler libraries repackages under +the toplevel names Ocaml_common, Ocaml_bytecomp, Ocaml_optcomp, ...""" +maintainer: ["Jane Street developers"] +authors: ["Jane Street Group, LLC"] +license: "MIT" +homepage: "https://github.com/janestreet/ocaml-compiler-libs" +bug-reports: "https://github.com/janestreet/ocaml-compiler-libs/issues" +depends: [ + "dune" {>= "2.8"} + "ocaml" {>= "4.04.1"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/janestreet/ocaml-compiler-libs.git" +url { + src: + "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz" + checksum: [ + "sha256=4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" + "sha512=978dba8dfa61f98fa24fda7a9c26c2e837081f37d1685fe636dc19cfc3278a940cf01a10293504b185c406706bc1008bc54313d50f023bcdea6d5ac6c0788b35" + ] +} +x-commit-hash: "8cd12f18bb7171c2b67d661868c4271fae528d93" diff --git a/esy.lock/opam/ppxlib.0.29.1/opam b/esy.lock/opam/ppxlib.0.29.1/opam new file mode 100644 index 000000000..4170d25c1 --- /dev/null +++ b/esy.lock/opam/ppxlib.0.29.1/opam @@ -0,0 +1,63 @@ +opam-version: "2.0" +synopsis: "Standard library for ppx rewriters" +description: """ +Ppxlib is the standard library for ppx rewriters and other programs +that manipulate the in-memory representation of OCaml programs, a.k.a +the "Parsetree". + +It also comes bundled with two ppx rewriters that are commonly used to +write tools that manipulate and/or generate Parsetree values; +`ppxlib.metaquot` which allows to construct Parsetree values using the +OCaml syntax directly and `ppxlib.traverse` which provides various +ways of automatically traversing values of a given type, in particular +allowing to inject a complex structured value into generated code. +""" +maintainer: ["opensource@janestreet.com"] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml-ppx/ppxlib" +doc: "https://ocaml-ppx.github.io/ppxlib/" +bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" +depends: [ + "dune" {>= "2.7"} + "ocaml" {>= "4.04.1" & < "5.1.0"} + "ocaml-compiler-libs" {>= "v0.11.0"} + "ppx_derivers" {>= "1.0"} + "sexplib0" {>= "v0.12"} + "sexplib0" {with-test & >= "v0.15"} + "stdlib-shims" + "ocamlfind" {with-test} + "re" {with-test & >= "1.9.0"} + "cinaps" {with-test & >= "v0.12.1"} + "base" {with-test} + "stdio" {with-test} + "odoc" {with-doc} +] +conflicts: [ + "ocaml-migrate-parsetree" {< "2.0.0"} + "base-effects" +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-ppx/ppxlib.git" +url { + src: + "https://github.com/ocaml-ppx/ppxlib/releases/download/0.29.1/ppxlib-0.29.1.tbz" + checksum: [ + "sha256=c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79" + "sha512=edc468e9111cc26e31825e475fd72f55123a22fe86548e07e7d111796fecb8d60359b1b53c7eac383e5e2114cbae74dfd9c166f330e84cbeab4ddfd5797e322f" + ] +} +x-commit-hash: "36fcba0408b78963a730e0be92abdbab00b0ea26" diff --git a/esy.lock/opam/sexplib0.v0.15.1/opam b/esy.lock/opam/sexplib0.v0.15.1/opam new file mode 100644 index 000000000..123ccd03c --- /dev/null +++ b/esy.lock/opam/sexplib0.v0.15.1/opam @@ -0,0 +1,26 @@ +opam-version: "2.0" +maintainer: "Jane Street developers" +authors: ["Jane Street Group, LLC"] +homepage: "https://github.com/janestreet/sexplib0" +bug-reports: "https://github.com/janestreet/sexplib0/issues" +dev-repo: "git+https://github.com/janestreet/sexplib0.git" +doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/sexplib0/index.html" +license: "MIT" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.08"} + "dune" {>= "2.0.0"} +] +synopsis: "Library containing the definition of S-expressions and some base converters" +description: " +Part of Jane Street's Core library +The Core suite of libraries is an industrial strength alternative to +OCaml's standard library that was developed by Jane Street, the +largest industrial user of OCaml. +" +url { +src: "https://github.com/janestreet/sexplib0/archive/refs/tags/v0.15.1.tar.gz" +checksum: "md5=ab8fd6273f35a792cad48cbb3024a7f9" +} diff --git a/esy.lock/opam/stdlib-shims.0.3.0/opam b/esy.lock/opam/stdlib-shims.0.3.0/opam new file mode 100644 index 000000000..8c9695710 --- /dev/null +++ b/esy.lock/opam/stdlib-shims.0.3.0/opam @@ -0,0 +1,31 @@ +opam-version: "2.0" +maintainer: "The stdlib-shims programmers" +authors: "The stdlib-shims programmers" +homepage: "https://github.com/ocaml/stdlib-shims" +doc: "https://ocaml.github.io/stdlib-shims/" +dev-repo: "git+https://github.com/ocaml/stdlib-shims.git" +bug-reports: "https://github.com/ocaml/stdlib-shims/issues" +tags: ["stdlib" "compatibility" "org:ocaml"] +license: ["LGPL-2.1-only WITH OCaml-LGPL-linking-exception"] +depends: [ + "dune" + "ocaml" {>= "4.02.3"} +] +build: [ "dune" "build" "-p" name "-j" jobs ] +synopsis: "Backport some of the new stdlib features to older compiler" +description: """ +Backport some of the new stdlib features to older compiler, +such as the Stdlib module. + +This allows projects that require compatibility with older compiler to +use these new features in their code. +""" +x-commit-hash: "fb6815e5d745f07fd567c11671149de6ef2e74c8" +url { + src: + "https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz" + checksum: [ + "sha256=babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" + "sha512=1151d7edc8923516e9a36995a3f8938d323aaade759ad349ed15d6d8501db61ffbe63277e97c4d86149cf371306ac23df0f581ec7e02611f58335126e1870980" + ] +} diff --git a/esy.lock/opam/utop.2.11.0/opam b/esy.lock/opam/utop.2.12.0/opam similarity index 79% rename from esy.lock/opam/utop.2.11.0/opam rename to esy.lock/opam/utop.2.12.0/opam index d9f71c3cd..fde17cc37 100644 --- a/esy.lock/opam/utop.2.11.0/opam +++ b/esy.lock/opam/utop.2.12.0/opam @@ -34,10 +34,10 @@ and more. It integrates with the Tuareg mode in Emacs. """ url { src: - "https://github.com/ocaml-community/utop/releases/download/2.11.0/utop-2.11.0.tbz" + "https://github.com/ocaml-community/utop/releases/download/2.12.0/utop-2.12.0.tbz" checksum: [ - "sha256=6937c6c672913ac3b875341ac4a205c7561d01cd8ac8f47cfb35d3bc0e762170" - "sha512=ab8b96eaa7f24654a371245f14819b74de0907ed8f3b2bbd9196808dc10e536458cf95418eeacf6dfc4b7f64a8dd088ee31e2eaae3d9ebc7de7cebcada52fb84" + "sha256=ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea" + "sha512=cd55cfb49178bec60b39df5b15df9090d9a316b81ddd5e564daaaa04c3c896c2e1ccf24a15ebce5b41ad3e22db56cfc95cc3f1a6808ee8e09f1c685284cdfb71" ] } -x-commit-hash: "595002e6f07e6a3c6abc6e94a1b2448006115f1b" +x-commit-hash: "c50173caf9b147eae637cb44e302e2077778afb4" diff --git a/esy.lock/opam/xdg.3.7.0/opam b/esy.lock/opam/xdg.3.7.1/opam similarity index 68% rename from esy.lock/opam/xdg.3.7.0/opam rename to esy.lock/opam/xdg.3.7.1/opam index fe21970ac..18778392f 100644 --- a/esy.lock/opam/xdg.3.7.0/opam +++ b/esy.lock/opam/xdg.3.7.1/opam @@ -30,10 +30,10 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.0/dune-3.7.0.tbz" + src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" checksum: [ - "sha256=e2d637c9d080318fedf5e71d2a29fb367624f82ac4a26e83df2b3a03550528b8" - "sha512=586e47ee45cd53a8c13095bde0b47de99aad9462d0a52199362140b5b654ca862597fa9f27f729a8cc594684ac46858848f9fa76f8f06dc8dc8ab8b1186a3295" + "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" ] } -x-commit-hash: "d3d628f2eda2278bd2df6e37452d8693f367fcfd" +x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" diff --git a/flake.lock b/flake.lock index 80d7f1920..5b53b8411 100644 --- a/flake.lock +++ b/flake.lock @@ -1,12 +1,15 @@ { "nodes": { "flake-utils": { + "inputs": { + "systems": "systems" + }, "locked": { - "lastModified": 1678901627, - "narHash": "sha256-U02riOqrKKzwjsxc/400XnElV+UtPUQWpANPlyazjH0=", + "lastModified": 1681202837, + "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", "owner": "numtide", "repo": "flake-utils", - "rev": "93a2b84fc4b70d9e089d029deacc3583435c2ed6", + "rev": "cfacdce06f30d2b68473a46042957675eebb3401", "type": "github" }, "original": { @@ -17,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1678109515, - "narHash": "sha256-C2X+qC80K2C1TOYZT8nabgo05Dw2HST/pSn6s+n6BO8=", + "lastModified": 1681154353, + "narHash": "sha256-MCJ5FHOlbfQRFwN0brqPbCunLEVw05D/3sRVoNVt2tI=", "owner": "numtide", "repo": "nix-filter", - "rev": "aa9ff6ce4a7f19af6415fb3721eaa513ea6c763c", + "rev": "f529f42792ade8e32c4be274af6b6d60857fbee7", "type": "github" }, "original": { @@ -38,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1679617087, - "narHash": "sha256-rDcPKOEAsj9o8UeT5UMMKOURhJcM7eGC3Buzd+T69mw=", + "lastModified": 1681761444, + "narHash": "sha256-FM2yAWrPnAITvMgRlgqNSpCh1ieKvLmd+pG144bp8Ks=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "2b78ff251eec962ba83b0af72c7b9e02f6627717", + "rev": "9859e425c67c121709f323a54fda2e4e456a3196", "type": "github" }, "original": { @@ -53,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1679542234, - "narHash": "sha256-NrUIxT2MtOcRDLq+bAFqAUno4w9Ds7UDaKQj+3yJPQk=", + "lastModified": 1681713375, + "narHash": "sha256-UPDEwrzOQLTNzNDMkcf3J7+7vV3zlQCCrO33kwlFsdY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "99265ac4a8c83e4109f9cfc7c911707b86437b67", + "rev": "9a60b3eef1a0ccb4e3459eba1814bae91d07134e", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "99265ac4a8c83e4109f9cfc7c911707b86437b67", + "rev": "9a60b3eef1a0ccb4e3459eba1814bae91d07134e", "type": "github" } }, @@ -73,6 +76,21 @@ "nix-filter": "nix-filter", "nixpkgs": "nixpkgs" } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } } }, "root": "root", diff --git a/nix/default.nix b/nix/default.nix index 1f57f67ed..bb502f9dd 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -24,6 +24,8 @@ ocamlPackages.buildDunePackage { cppo fix ppx_derivers + ppxlib + dune-build-info ]; } diff --git a/reason.json b/reason.json index 3e027f07f..021476468 100644 --- a/reason.json +++ b/reason.json @@ -14,6 +14,7 @@ "@opam/menhir": " >= 20180523.0.0", "@opam/merlin-extend": " >= 0.6", "@opam/ppx_derivers": "< 2.0.0", + "@opam/ppxlib": "> 0.28.x", "@opam/dune": ">= 2.9.3", "@opam/dune-build-info": ">= 2.9.3" }, diff --git a/reason.opam b/reason.opam index 51eb29b52..4eaf5db39 100644 --- a/reason.opam +++ b/reason.opam @@ -23,6 +23,7 @@ depends: [ "merlin-extend" {>= "0.6"} "fix" "ppx_derivers" + "ppxlib" {>= "0.28.0"} "odoc" {with-doc} ] build: [ diff --git a/src/ppx/dune b/src/ppx/dune deleted file mode 100644 index fa41af888..000000000 --- a/src/ppx/dune +++ /dev/null @@ -1,6 +0,0 @@ -(executable - (name reactjs_jsx_ppx_v2) - (public_name reactjs_jsx_ppx_v2) - (package reason) - (flags (:standard -w -9)) - (libraries reason reason.ocaml-migrate-parsetree)) diff --git a/src/ppx/reactjs_jsx_ppx_v2.ml b/src/ppx/reactjs_jsx_ppx_v2.ml deleted file mode 100644 index 6d25a71d2..000000000 --- a/src/ppx/reactjs_jsx_ppx_v2.ml +++ /dev/null @@ -1,411 +0,0 @@ -(* - This is the file that handles turning Reason JSX' agnostic function call into - a ReasonReact-specific function call. Aka, this is a macro, using OCaml's ppx - facilities; https://whitequark.org/blog/2014/04/16/a-guide-to-extension- - points-in-ocaml/ - - You wouldn't use this file directly; it's used by BuckleScript's - bsconfig.json. Specifically, there's a field called `react-jsx` inside the - field `reason`, which enables this ppx through some internal call in bsb -*) - -(* - The actual transform: - - transform `[@JSX] div(~props1=a, ~props2=b, ~children=[foo, bar], ())` into - `ReactDOMRe.createElement("div", ~props={"props1": 1, "props2": b}, [|foo, - bar|])`. - - transform `[@JSX] div(~props1=a, ~props2=b, ~children=foo, ())` into - `ReactDOMRe.createElementVariadic("div", ~props={"props1": 1, "props2": b}, foo)`. - - transform the upper-cased case - `[@JSX] Foo.createElement(~key=a, ~ref=b, ~foo=bar, ~children=[], ())` into - `ReasonReact.element(~key=a, ~ref=b, Foo.make(~foo=bar, [||]))` - - transform `[@JSX] [foo]` into - `ReactDOMRe.createElement(ReasonReact.fragment, [|foo|])` -*) - -(* - This file's shared between the Reason repo and the BuckleScript repo. In - Reason, it's in src. In BuckleScript, it's in jscomp/bin. We periodically - copy this file from Reason (the source of truth) to BuckleScript, then - uncomment the #if #else #end cppo macros you see in the file. That's because - BuckleScript's on OCaml 4.02 while Reason's on 4.04; so the #if macros - surround the pieces of code that are different between the two compilers. - - When you modify this file, please make sure you're not dragging in too many - things. You don't necessarily have to test the file on both Reason and - 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) -*) - -(* #if defined BS_NO_COMPILER_PATCH then *) -open Reason_omp -open Ast_411 -module To_current = Convert(OCaml_411)(OCaml_current) - -let nolabel = Ast_411.Asttypes.Nolabel -let labelled str = Ast_411.Asttypes.Labelled str -let argIsKeyRef = function - | (Asttypes.Labelled ("key" | "ref"), _) | (Asttypes.Optional ("key" | "ref"), _) -> true - | _ -> false -let constantString ~loc str = - Ast_helper.Exp.constant ~loc (Parsetree.Pconst_string (str, loc, None)) - -(* #else -let nolabel = "" -let labelled str = str -let argIsKeyRef = function - | (("key" | "ref"), _) | (("?key" | "?ref"), _) -> true - | _ -> false -let constantString ~loc str = Ast_helper.Exp.constant ~loc (Asttypes.Const_string (str, None)) -#end *) - -open Ast_helper -open Ast_mapper -open Asttypes -open Parsetree -open Longident - -(* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) -let transformChildrenIfList ~loc ~mapper theList = - let rec transformChildren_ theList accum = - (* not in the sense of converting a list to an array; convert the AST - reprensentation of a list to the AST reprensentation of an array *) - match theList with - | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> - List.rev accum |> Exp.array ~loc - | {pexp_desc = Pexp_construct ( - {txt = Lident "::"}, - Some {pexp_desc = Pexp_tuple (v::acc::[])} - )} -> - transformChildren_ acc ((mapper.expr mapper v)::accum) - | notAList -> mapper.expr mapper notAList - in - transformChildren_ theList [] - -let extractChildren ?(removeLastPositionUnit=false) ~loc propsAndChildren = - let rec allButLast_ lst acc = match lst with - | [] -> [] -(* #if defined BS_NO_COMPILER_PATCH then *) - | (Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc - | (Nolabel, _)::_ -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") -(* #else - | ("", {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})::[] -> acc - | ("", _)::rest -> raise (Invalid_argument "JSX: found non-labelled argument before the last position") -#end *) - | arg::rest -> allButLast_ rest (arg::acc) - in - let allButLast lst = allButLast_ lst [] |> List.rev in - match (List.partition (fun (label, _) -> label = labelled "children") propsAndChildren) with - | ([], props) -> - (* no children provided? Place a placeholder list *) - (Exp.construct ~loc {loc; txt = Lident "[]"} None, if removeLastPositionUnit then allButLast props else props) - | ([(_, childrenExpr)], props) -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) - | _ -> raise (Invalid_argument "JSX: somehow there's more than one `children` label") - -(* TODO: some line number might still be wrong *) -let jsxMapper () = - - let jsxVersion = ref None in - - let transformUppercaseCall modulePath mapper loc attrs _ callArguments = - let (children, argsWithLabels) = extractChildren ~loc ~removeLastPositionUnit:true callArguments in - let (argsKeyRef, argsForMake) = List.partition argIsKeyRef argsWithLabels in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let recursivelyTransformedArgsForMake = argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let args = recursivelyTransformedArgsForMake @ [ (nolabel, childrenExpr) ] in - let wrapWithReasonReactElement e = (* ReasonReact.element(~key, ~ref, ...) *) - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "element")}) - (argsKeyRef @ [(nolabel, e)]) in - Exp.apply - ~loc - ~attrs - (* Foo.make *) - (Exp.ident ~loc {loc; txt = Ldot (modulePath, "make")}) - args - |> wrapWithReasonReactElement in - - let transformLowercaseCall mapper loc attrs callArguments id = - let (children, nonChildrenProps) = extractChildren ~loc callArguments in - let componentNameExpr = constantString ~loc id in - let childrenExpr = transformChildrenIfList ~loc ~mapper children in - let createElementCall = match children with - (* [@JSX] div(~children=[a]), coming from
a
*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple _ }) - | Pexp_construct ({txt = Lident "[]"}, None) - } -> "createElement" - (* [@JSX] div(~children=[|a|]), coming from
...[|a|]
*) - | { pexp_desc = (Pexp_array _) } -> - raise (Invalid_argument "A spread + an array literal as a DOM element's \ - children would cancel each other out, and thus don't make sense written \ - together. You can simply remove the spread and the array literal.") - (* [@JSX] div(~children=
), coming from
...
*) - | { - pexp_attributes - } when pexp_attributes |> List.exists (fun { attr_name = { txt }; _} -> txt = "JSX") -> - raise (Invalid_argument "A spread + a JSX literal as a DOM element's \ - children don't make sense written together. You can simply remove the spread.") - | _ -> "createElementVariadic" - in - let args = match nonChildrenProps with - | [_justTheUnitArgumentAtEnd] -> - [ - (* "div" *) - (nolabel, componentNameExpr); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] - | nonEmptyProps -> - let propsCall = - Exp.apply - ~loc - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "props")}) - (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) - in - [ - (* "div" *) - (nolabel, componentNameExpr); - (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) - (labelled "props", propsCall); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) - args - in - - let transformJsxCall mapper callExpression callArguments attrs = - (match callExpression.pexp_desc with - | Pexp_ident caller -> - (match caller with - | {txt = Lident "createElement"} -> - raise (Invalid_argument "JSX: `createElement` should be preceeded by a module name.") - - (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - (match !jsxVersion with - | None - | Some 2 -> transformUppercaseCall modulePath mapper loc attrs callExpression callArguments - | Some _ -> raise (Invalid_argument "JSX: the JSX version must be 2")) - - (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) - (* turn that into - ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) - | {loc; txt = Lident id} -> - transformLowercaseCall mapper loc attrs callArguments id - - | {txt = Ldot (_, anythingNotCreateElementOrMake)} -> - raise ( - Invalid_argument - ("JSX: the JSX attribute should be attached to a `YourModuleName.createElement` or `YourModuleName.make` call. We saw `" - ^ anythingNotCreateElementOrMake - ^ "` instead" - ) - ) - - | {txt = Lapply _} -> - (* don't think there's ever a case where this is reached *) - raise ( - Invalid_argument "JSX: encountered a weird case while processing the code. Please report this!" - ) - ) - | _ -> - raise ( - Invalid_argument "JSX: `createElement` should be preceeded by a simple, direct module name." - ) - ) in - - let structure = - (fun mapper structure -> match structure with - (* - match against [@bs.config {foo, jsx: ...}] at the file-level. This - indicates which version of JSX we're using. This code stays here because - we used to have 2 versions of JSX PPX (and likely will again in the - future when JSX PPX changes). So the architecture for switching between - JSX behavior stayed here. To create a new JSX ppx, copy paste this - entire file and change the relevant parts. - - Description of architecture: in bucklescript's bsconfig.json, you can - specify a project-wide JSX version. You can also specify a file-level - JSX version. This degree of freedom allows a person to convert a project - one file at time onto the new JSX, when it was released. It also enabled - a project to depend on a third-party which is still using an old version - of JSX - *) - | { - pstr_loc; - pstr_desc = Pstr_attribute { - attr_name = ({txt = "bs.config"} as bsConfigLabel); - attr_payload = PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (recordFields, b)} as innerConfigRecord, a)} as configRecord] - }; _ - }::restOfStructure -> begin - let (jsxField, recordFieldsWithoutJsx) = recordFields |> List.partition (fun ({txt}, _) -> txt = Lident "jsx") in - match (jsxField, recordFieldsWithoutJsx) with - (* no file-level jsx config found *) - | ([], _) -> default_mapper.structure mapper structure - (* {jsx: 2} *) -(* #if defined BS_NO_COMPILER_PATCH then *) - | ((_, {pexp_desc = Pexp_constant (Pconst_integer (version, _))})::_, recordFieldsWithoutJsx) -> begin - (match version with - | "2" -> jsxVersion := Some 2 - | _ -> raise (Invalid_argument "JSX: the file-level bs.config's jsx version must be 2")); -(* #else - | ((_, {pexp_desc = Pexp_constant (Const_int version)})::rest, recordFieldsWithoutJsx) -> begin - (match version with - | 2 -> jsxVersion := Some 2 - | _ -> raise (Invalid_argument "JSX: the file-level bs.config's jsx version must be 2")); -#end *) - match recordFieldsWithoutJsx with - (* record empty now, remove the whole bs.config attribute *) - | [] -> default_mapper.structure mapper restOfStructure - | fields -> default_mapper.structure mapper ({ - pstr_loc; - pstr_desc = Pstr_attribute ( - { attr_name = bsConfigLabel; - attr_payload = PStr [{configRecord with pstr_desc = Pstr_eval ({innerConfigRecord with pexp_desc = Pexp_record (fields, b)}, a)}]; - attr_loc = bsConfigLabel.loc - }) - }::restOfStructure) - end - | _ -> raise (Invalid_argument "JSX: the file-level bs.config's {jsx: ...} config accepts only a version number") - end - | _ -> default_mapper.structure mapper structure - ) in - - let expr = - (fun mapper expression -> match expression with - (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (callExpression, callArguments); - pexp_attributes - } -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun { attr_name = {txt}; _} -> txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> transformJsxCall mapper callExpression callArguments nonJSXAttributes) - - (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) - | { - pexp_desc = - Pexp_construct ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) - | Pexp_construct ({txt = Lident "[]"; loc}, None); - pexp_attributes - } as listItems -> - let (jsxAttribute, nonJSXAttributes) = List.partition (fun {attr_name = {txt}} -> txt = "JSX") pexp_attributes in - (match (jsxAttribute, nonJSXAttributes) with - (* no JSX attribute *) - | ([], _) -> default_mapper.expr mapper expression - | (_, nonJSXAttributes) -> - let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in - let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in - let args = [ - (* "div" *) - (nolabel, fragment); - (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr) - ] in - Exp.apply - ~loc - (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes - (* ReactDOMRe.createElement *) - (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) - args - ) - (* Delegate to the default mapper, a deep identity traversal *) - | e -> default_mapper.expr mapper e) in - -(* #if defined BS_NO_COMPILER_PATCH then *) - To_current.copy_mapper { default_mapper with structure; expr } -(* #else - { default_mapper with structure; expr } -#end *) - -(* #if BS_COMPILER_IN_BROWSER then - -module Js = struct - module Unsafe = struct - type any - external inject : 'a -> any = "%identity" - external get : 'a -> 'b -> 'c = "caml_js_get" - external set : 'a -> 'b -> 'c -> unit = "caml_js_set" - external pure_js_expr : string -> 'a = "caml_pure_js_expr" - let global = pure_js_expr "joo_global_object" - external obj : (string * any) array -> 'a = "caml_js_object" - end - type (-'a, +'b) meth_callback - type 'a callback = (unit, 'a) meth_callback - external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback = "caml_js_wrap_meth_callback" - type + 'a t - type js_string - external string : string -> js_string t = "caml_js_from_string" - external to_string : js_string t -> string = "caml_js_to_string" -end - -(* keep in sync with jscomp/core/jsoo_main.ml `let implementation` *) -let rewrite code = - let mapper = jsxMapper () in - Location.input_name := "//toplevel//"; - try - let lexer = Lexing.from_string code in - let pstr = Parse.implementation lexer in - let pstr = mapper.structure mapper pstr in - let buffer = Buffer.create 1000 in - Pprintast.structure Format.str_formatter pstr; - let ocaml_code = Format.flush_str_formatter () in - Js.Unsafe.(obj [| "ocaml_code", inject @@ Js.string ocaml_code |]) - with e -> - match Location.error_of_exn e with - | Some error -> - Location.report_error Format.err_formatter error; - let (file, line, startchar) = Location.get_pos_info error.loc.loc_start in - let (file, endline, endchar) = Location.get_pos_info error.loc.loc_end in - Js.Unsafe.(obj - [| - "ppx_error_msg", inject @@ Js.string (Printf.sprintf "Line %d, %d: %s" line startchar error.msg); - "row", inject (line - 1); - "column", inject startchar; - "endRow", inject (endline - 1); - "endColumn", inject endchar; - "text", inject @@ Js.string error.msg; - "type", inject @@ Js.string "error"; - |] - ) - | None -> - Js.Unsafe.(obj [| - "js_error_msg" , inject @@ Js.string (Printexc.to_string e) - |]) - -let export (field : string) v = - Js.Unsafe.set (Js.Unsafe.global) field v - -let make_ppx name = - export name - (Js.Unsafe.(obj - [|"rewrite", - inject @@ - Js.wrap_meth_callback - (fun _ code -> rewrite (Js.to_string code)); - |])) - -let () = make_ppx "jsxv2" *) - -(* #elif defined BS_NO_COMPILER_PATCH then *) -let () = Compiler_libs.Ast_mapper.register "JSX" (fun _argv -> jsxMapper ()) -(* #else -let () = Ast_mapper.register "JSX" (fun _argv -> jsxMapper ()) -#end *) diff --git a/src/ppx/reactjs_jsx_ppx_v2.mli b/src/ppx/reactjs_jsx_ppx_v2.mli deleted file mode 100644 index 4900fe06f..000000000 --- a/src/ppx/reactjs_jsx_ppx_v2.mli +++ /dev/null @@ -1,11 +0,0 @@ -(* - This file's shared between the Reason repo and the BuckleScript repo. In - Reason, it's in src. In BuckleScript, it's in vendor/reason We periodically - copy this file from Reason (the source of truth) to BuckleScript, then - uncomment the #if #else #end cppo macros you see in the file. That's because - BuckleScript's on OCaml 4.02 while Reason's on 4.04; so the #if macros - surround the pieces of code that are different between the two compilers. - *) -(* #if undefined BS_NO_COMPILER_PATCH then *) -(* val ast_mapper : Ast_mapper.mapper *) -(* #end *) diff --git a/src/reason-merlin/ocamlmerlin_reason.cppo.ml b/src/reason-merlin/ocamlmerlin_reason.cppo.ml index 89415e289..352b9b979 100644 --- a/src/reason-merlin/ocamlmerlin_reason.cppo.ml +++ b/src/reason-merlin/ocamlmerlin_reason.cppo.ml @@ -10,13 +10,17 @@ module Reason_reader = struct let structure str = let str = - Reason_syntax_util.(apply_mapper_to_structure str (backport_letopt_mapper remove_stylistic_attrs_mapper)) + str + |> Reason_syntax_util.(apply_mapper_to_structure remove_stylistic_attrs_mapper) + |> Reason_syntax_util.(apply_mapper_to_structure backport_letopt_mapper) in Structure (Reason_toolchain.To_current.copy_structure str) let signature sg = let sg = - Reason_syntax_util.(apply_mapper_to_signature sg (backport_letopt_mapper remove_stylistic_attrs_mapper)) + sg + |> Reason_syntax_util.(apply_mapper_to_signature remove_stylistic_attrs_mapper) + |> Reason_syntax_util.(apply_mapper_to_signature backport_letopt_mapper) in Signature (Reason_toolchain.To_current.copy_signature sg) diff --git a/src/reason-parser-tests/testOprint.cppo.ml b/src/reason-parser-tests/testOprint.cppo.ml index 00cc7ade4..233c2deb4 100644 --- a/src/reason-parser-tests/testOprint.cppo.ml +++ b/src/reason-parser-tests/testOprint.cppo.ml @@ -20,9 +20,9 @@ *) open Reason_omp +module Ast = Ast_414 -module Convert = Reason_omp.Convert (Reason_omp.OCaml_411) (Reason_omp.OCaml_current) -module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_411) +module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) let main () = let filename = "./TestTest.ml" in @@ -39,7 +39,7 @@ let main () = Env.set_unit_name modulename; let ast = impl lexbuf in - let ast = Convert.copy_structure ast in + let ast = Reason_toolchain.To_current.copy_structure ast in let env = Compmisc.initial_env() in #if OCAML_VERSION >= (4,13,0) let { Typedtree.structure = typedtree; _ } = @@ -48,7 +48,7 @@ let main () = #endif Typemod.type_implementation modulename modulename modulename env ast in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in - let phrase = (Ast_411.Outcometree.Ophr_signature + let phrase = (Ast.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) ) in let fmt = Format.str_formatter in diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 580775f1d..2bb29de80 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -121,4 +121,8 @@ reason_parser_explain_raw reason_parser_explain reason_parser_recover) - (libraries reason.ocaml-migrate-parsetree menhirLib reason.easy_format)) + (libraries + reason.ocaml-migrate-parsetree + menhirLib + reason.easy_format + ppxlib)) diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index c412496d9..a272ebdfa 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -1,5 +1,4 @@ -open Reason_omp -open Ast_411 +open Ppxlib open Location open Parsetree diff --git a/src/reason-parser/reason_errors.ml b/src/reason-parser/reason_errors.ml index c7dc30487..e5ea39342 100644 --- a/src/reason-parser/reason_errors.ml +++ b/src/reason-parser/reason_errors.ml @@ -10,6 +10,7 @@ A fourth case is when unknown / unexpected error occurs. *) +open Ppxlib open Format type lexing_error = @@ -127,8 +128,6 @@ let () = | _ -> None ) -open Reason_omp.Ast_411 - let str_eval_message text = { Parsetree. pstr_loc = Location.none; diff --git a/src/reason-parser/reason_errors.mli b/src/reason-parser/reason_errors.mli index 05e547d61..b9f7b8489 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 Reason_omp.Ast_411 +open Ppxlib type lexing_error = | Illegal_character of char diff --git a/src/reason-parser/reason_heuristics.ml b/src/reason-parser/reason_heuristics.ml index 360e1e7f5..405186684 100644 --- a/src/reason-parser/reason_heuristics.ml +++ b/src/reason-parser/reason_heuristics.ml @@ -1,7 +1,7 @@ -open Reason_omp +open Ppxlib let is_punned_labelled_expression e lbl = - let open Ast_411.Parsetree in + let open Parsetree in match e.pexp_desc with | Pexp_ident { txt } | Pexp_constraint ({pexp_desc = Pexp_ident { txt }}, _) @@ -17,11 +17,11 @@ let is_punned_labelled_expression e lbl = * where the sum of the string contents and identifier names are less than the print width *) let funAppCallbackExceedsWidth ~printWidth ~args ~funExpr () = - let open Ast_411.Parsetree in - let open Ast_411.Asttypes in + let open Parsetree in + let open Asttypes in let funLen = begin match funExpr.pexp_desc with | Pexp_ident ident -> - let identList = Longident.flatten ident.txt in + let identList = Longident.flatten_exn ident.txt in let lengthOfDots = List.length identList - 1 in let len = List.fold_left (fun acc curr -> acc + (String.length curr)) lengthOfDots identList in @@ -39,7 +39,7 @@ let funAppCallbackExceedsWidth ~printWidth ~args ~funExpr () = | (label, ({ pexp_desc = Pexp_ident ident } as e)) -> let identLen = List.fold_left (fun acc curr -> acc + (String.length curr) - ) len (Longident.flatten ident.txt) in + ) len (Longident.flatten_exn ident.txt) in begin match label with | Nolabel -> aux (len - identLen) args | Labelled s when is_punned_labelled_expression e s -> @@ -88,17 +88,17 @@ let singleTokenPatternOmmitTrail txt = String.length txt < 4 * -> setTimeout((.) => Js.log("hola"), 1000); *) let bsExprCanBeUncurried expr = - match Ast_411.Parsetree.(expr.pexp_desc) with + match Parsetree.(expr.pexp_desc) with | Pexp_fun _ | Pexp_apply _ -> true | _ -> false let isUnderscoreIdent expr = - match Ast_411.Parsetree.(expr.pexp_desc) with + match Parsetree.(expr.pexp_desc) with | Pexp_ident ({txt = Lident "_"}) -> true | _ -> false -let isPipeFirst e = match Ast_411.Parsetree.(e.pexp_desc) with +let isPipeFirst e = match Parsetree.(e.pexp_desc) with | Pexp_ident({txt = Longident.Lident("|.")}) -> true | Pexp_apply( {pexp_desc = Pexp_ident({txt = Longident.Lident("|.")})}, @@ -107,7 +107,7 @@ let isPipeFirst e = match Ast_411.Parsetree.(e.pexp_desc) with | _ -> false let isUnderscoreApplication expr = - let open Ast_411.Parsetree in + let open Parsetree in match expr with | {pexp_attributes = []; pexp_desc = Pexp_fun( Nolabel, @@ -125,7 +125,7 @@ let isUnderscoreApplication expr = * An application with pipe first inside jsx children requires special treatment. * Jsx children don't allow expression application, hence we need the braces * preserved in this case. *) -let isPipeFirstWithNonSimpleJSXChild e = match Ast_411.Parsetree.(e.pexp_desc) with +let isPipeFirstWithNonSimpleJSXChild e = match Parsetree.(e.pexp_desc) with | Pexp_apply( {pexp_desc = Pexp_ident({txt = Longident.Lident("|.")})}, [Nolabel, {pexp_desc = Pexp_apply(_)}; _] diff --git a/src/reason-parser/reason_oprint.ml b/src/reason-parser/reason_oprint.ml index 21cb27180..0951e83b2 100644 --- a/src/reason-parser/reason_oprint.ml +++ b/src/reason-parser/reason_oprint.ml @@ -84,10 +84,8 @@ patching the right parts, through the power of types(tm) *) -open Reason_omp -open Ast_411 - open Format +module Outcometree = Reason_omp.Ast_414.Outcometree open Outcometree exception Ellipsis @@ -451,15 +449,15 @@ and print_simple_out_type ppf = fprintf ppf "@[<1>%a@]" print_out_type ty; | Otyp_abstract | Otyp_open | Otyp_sum _ | Otyp_record _ | Otyp_manifest (_, _) -> () - | Otyp_module (p, n, tyl) -> + + | Otyp_module (p, ntyls) -> fprintf ppf "@[<1>(module %a" print_ident p; let first = ref true in - List.iter2 - (fun s t -> + List.iter + (fun (s, t) -> let sep = if !first then (first := false; "with") else "and" in - fprintf ppf " %s type %s = %a" sep s print_out_type t - ) - n tyl; + fprintf ppf " %s type %s = %a" sep s print_out_type t) + ntyls; fprintf ppf ")@]" | Otyp_attribute (t, attr) -> fprintf ppf "@[<1>(%a [@@%s])@]" print_out_type t attr.oattr_name @@ -520,15 +518,12 @@ and print_typargs ppf = let out_type = ref print_out_type -(* Class types *) let variance = function - (* co, contra *) - | false, false -> "" - | true, true -> "" - | true, false -> "+" - | false, true -> "-" + | Reason_omp.Ast_414.Asttypes.NoVariance -> "" + | Covariant -> "+" + | Contravariant -> "-" -let type_parameter ppf (ty, var) = +let type_parameter ppf (ty, (var, _)) = fprintf ppf "%s%s" (variance var) (if ty = "_" then ty else "'"^ty) @@ -636,13 +631,19 @@ and print_out_signature ppf = match items with Osig_typext(ext, Oext_next) :: items -> gather_extensions - ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc) + ( { ocstr_name = ext.oext_name; + ocstr_args = ext.oext_args; + ocstr_return_type = ext.oext_ret_type; + } :: acc) items | _ -> (List.rev acc, items) in let exts, items = gather_extensions - [(ext.oext_name, ext.oext_args, ext.oext_ret_type)] + [ { ocstr_name = ext.oext_name + ; ocstr_args = ext.oext_args + ; ocstr_return_type = ext.oext_ret_type + } ] items in let te = @@ -670,7 +671,11 @@ and print_out_sig_item ppf = print_out_class_type clt | Osig_typext (ext, Oext_exception) -> fprintf ppf "@[<2>exception %a@]" - print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type) + print_out_constr + { ocstr_name = ext.oext_name + ; ocstr_args = ext.oext_args + ; ocstr_return_type = ext.oext_ret_type + } | Osig_typext (ext, _) -> print_out_extension_constructor ppf ext | Osig_modtype (name, Omty_abstract) -> @@ -754,8 +759,8 @@ and print_out_type_decl kwd ppf td = | _ -> td.otype_type in let print_private ppf = function - Asttypes.Private -> fprintf ppf " pri" - | Asttypes.Public -> () + Reason_omp.Ast_414.Asttypes.Private -> fprintf ppf " pri" + | Public -> () in let print_out_tkind ppf = function | Otyp_abstract -> () @@ -779,7 +784,7 @@ and print_out_type_decl kwd ppf td = print_out_tkind ty print_constraints -and print_out_constr ppf (name, tyl,ret_type_opt) = +and print_out_constr ppf {ocstr_name =name; ocstr_args = tyl; ocstr_return_type = ret_type_opt} = match ret_type_opt with | None -> begin match tyl with @@ -832,8 +837,12 @@ and print_out_extension_constructor ppf ext = in fprintf ppf "@[type %t +=%s@;<1 2>%a@]" print_extended_type - (if ext.oext_private = Asttypes.Private then " pri" else "") - print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type) + (if ext.oext_private = Reason_omp.Ast_414.Asttypes.Private then " pri" else "") + print_out_constr + { ocstr_name = ext.oext_name + ; ocstr_args = ext.oext_args + ; ocstr_return_type = ext.oext_ret_type + } and print_out_type_extension ppf te = let print_extended_type ppf = @@ -855,7 +864,7 @@ and print_out_type_extension ppf te = in fprintf ppf "@[type %t +=%s@;<1 2>%a@]" print_extended_type - (if te.otyext_private = Asttypes.Private then " pri" else "") + (if te.otyext_private = Reason_omp.Ast_414.Asttypes.Private then " pri" else "") (print_list print_out_constr (fun ppf -> fprintf ppf "@ | ")) te.otyext_constructors @@ -878,13 +887,13 @@ let rec print_items ppf = match items with (Osig_typext(ext, Oext_next), None) :: items -> gather_extensions - ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc) + ({ocstr_name = ext.oext_name; ocstr_args = ext.oext_args; ocstr_return_type = ext.oext_ret_type} :: acc) items | _ -> (List.rev acc, items) in let exts, items = gather_extensions - [(ext.oext_name, ext.oext_args, ext.oext_ret_type)] + [{ ocstr_name = ext.oext_name; ocstr_args = ext.oext_args; ocstr_return_type = ext.oext_ret_type}] items in let te = diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index aa98fd8d1..719ffdefd 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -48,18 +48,24 @@ (* The parser definition *) %{ -open Reason_omp -open OCaml_411.Ast +open Ppxlib open Reason_syntax_util open Location open Asttypes open Longident open Parsetree open Ast_helper -open Ast_mapper open Reason_parser_def open Reason_errors +(* Menhir generates `Warnings.loc` *) +module Warnings = struct + type loc = Location.t +end + +let mkloc txt loc = {txt;loc} +let mknoloc txt = mkloc txt none + let raise_error error loc = raise_error (Ast_error error) loc @@ -357,10 +363,10 @@ let ghexp_cons args loc = mkexp ~ghost:true ~loc (Pexp_construct(mkloc (Lident "::") loc, Some args)) let mkpat_cons args loc = - mkpat ~loc (Ppat_construct(mkloc (Lident "::") loc, Some args)) + mkpat ~loc (Ppat_construct(mkloc (Lident "::") loc, Some ([], args))) let ghpat_cons args loc = - mkpat ~ghost:true ~loc (Ppat_construct(mkloc (Lident "::") loc, Some args)) + mkpat ~ghost:true ~loc (Ppat_construct(mkloc (Lident "::") loc, Some ([], args))) let mkpat_constructor_unit consloc loc = mkpat ~loc (Ppat_construct(mkloc (Lident "()") consloc, None)) @@ -688,10 +694,10 @@ let bigarray_set ?(loc=dummy_loc()) arr arg newval = Nolabel, newval])) let exp_of_label label = - mkexp ~loc:label.loc (Pexp_ident {label with txt=Lident(Longident.last label.txt)}) + mkexp ~loc:label.loc (Pexp_ident {label with txt=Lident(Longident.last_exn label.txt)}) let pat_of_label label = - mkpat ~loc:label.loc (Ppat_var {label with txt=(Longident.last label.txt)}) + mkpat ~loc:label.loc (Ppat_var {label with txt=(Longident.last_exn label.txt)}) let check_variable vl loc v = if List.mem v vl then @@ -844,9 +850,11 @@ let class_of_let_bindings lbs body = * unwrap the tuple to expose the inner tuple directly. * *) -let arity_conflict_resolving_mapper super = -{ super with - expr = begin fun mapper expr -> +let reason_to_ml_swap_operator_mapper = new reason_to_ml_swap_operator_mapper +let reason_mapper = object + inherit Ppxlib.Ast_traverse.map as super + + method! expression expr = match expr with | {pexp_desc=Pexp_construct(lid, args); pexp_loc; @@ -855,37 +863,34 @@ let arity_conflict_resolving_mapper super = match args with | Some {pexp_desc = Pexp_tuple [sp]} -> Some sp | _ -> args in - super.expr mapper + super#expression { pexp_desc=Pexp_construct(lid, new_args); pexp_loc; pexp_attributes = normalized_attributes "explicit_arity" pexp_attributes; pexp_loc_stack = [] } - | x -> super.expr mapper x - end; - pat = begin fun mapper pattern -> + | x -> super#expression x + method! pattern pattern = match pattern with | {ppat_desc=Ppat_construct(lid, args); ppat_loc; ppat_attributes} when attributes_conflicted "implicit_arity" "explicit_arity" ppat_attributes -> let new_args = match args with - | Some {ppat_desc = Ppat_tuple [sp]} -> Some sp - | _ -> args in - super.pat mapper + | Some (x, {ppat_desc = Ppat_tuple [sp]}) -> Some (x, sp) + | _ -> args + in + super#pattern { ppat_desc=Ppat_construct(lid, new_args); ppat_loc; ppat_attributes = normalized_attributes "explicit_arity" ppat_attributes; ppat_loc_stack = []; } - | x -> super.pat mapper x - end; -} + | x -> super#pattern x +end -let reason_mapper = - default_mapper - |> reason_to_ml_swap_operator_mapper - |> arity_conflict_resolving_mapper +let reason_mapper f a = + a |> f reason_to_ml_swap_operator_mapper |> f reason_mapper let rewriteFunctorApp module_name elt loc = let rec applies = function @@ -1050,7 +1055,7 @@ let package_type_of_module_type pmty = let add_brace_attr expr = let attr = { - attr_name = Location.mknoloc "reason.preserve_braces"; + attr_name = mknoloc "reason.preserve_braces"; attr_payload = PStr []; attr_loc = Location.none } @@ -1061,14 +1066,14 @@ let add_brace_attr expr = %[@recover.prelude - open Reason_omp.OCaml_411.Ast + open Ppxlib open Parsetree open Ast_helper let default_loc = ref Location.none let default_expr () = - let id = Location.mkloc "merlin.hole" !default_loc in + let id = Location.{txt = "merlin.hole"; loc = !default_loc} in Exp.mk ~loc:!default_loc (Pexp_extension (id, PStr [])) let default_pattern () = Pat.any ~loc:!default_loc () @@ -1358,19 +1363,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 @@ -1403,19 +1408,19 @@ conflicts. implementation: structure EOF - { apply_mapper_to_structure $1 reason_mapper } + { reason_mapper apply_mapper_to_structure $1 } ; interface: signature EOF - { apply_mapper_to_signature $1 reason_mapper } + { reason_mapper apply_mapper_to_signature $1 } ; toplevel_phrase: embedded ( EOF { raise End_of_file } | structure_item SEMI { Ptop_def $1 } | toplevel_directive SEMI { $1 } - ) { apply_mapper_to_toplevel_phrase $1 reason_mapper } + ) { reason_mapper apply_mapper_to_toplevel_phrase $1 } ; use_file_no_mapper: embedded @@ -1428,22 +1433,22 @@ use_file_no_mapper: embedded ; use_file: - use_file_no_mapper { apply_mapper_to_use_file $1 reason_mapper } + use_file_no_mapper { reason_mapper apply_mapper_to_use_file $1 } ; parse_core_type: core_type EOF - { apply_mapper_to_type $1 reason_mapper } + { reason_mapper apply_mapper_to_type $1 } ; parse_expression: expr EOF - { apply_mapper_to_expr $1 reason_mapper } + { reason_mapper apply_mapper_to_expr $1 } ; parse_pattern: pattern EOF - { apply_mapper_to_pattern $1 reason_mapper } + { reason_mapper apply_mapper_to_pattern $1 } ; (* Module expressions *) @@ -2645,7 +2650,7 @@ es6_parameters: | as_loc(UNDERSCORE) { ([{$1 with txt = Term (Nolabel, None, mkpat ~loc:$1.loc Ppat_any)}], false) } | simple_pattern_ident - { ([Location.mkloc (Term (Nolabel, None, $1)) $1.ppat_loc], false) } + { ([mkloc (Term (Nolabel, None, $1)) $1.ppat_loc], false) } ; (* TODO: properly fix JSX labelled/optional stuff *) @@ -3260,12 +3265,12 @@ labeled_expr: | Some typ -> ghexp_constraint $2.loc exp typ in - (Labelled (Longident.last lident_loc.txt), labeled_exp) + (Labelled (Longident.last_exn lident_loc.txt), labeled_exp) } | TILDE as_loc(val_longident) QUESTION { (* foo(~a?) -> parses ~a? *) let exp = mkexp (Pexp_ident $2) ~loc:$2.loc in - (Optional (Longident.last $2.txt), exp) + (Optional (Longident.last_exn $2.txt), exp) } | TILDE as_loc(LIDENT) EQUAL optional labeled_expr_constraint { (* foo(~bar=?Some(1)) or add(~x=1, ~y=2) -> parses ~bar=?Some(1) & ~x=1 & ~y=1 *) @@ -3678,11 +3683,11 @@ mark_position_pat *) { match is_pattern_list_single_any $2 with | Some singleAnyPat -> - mkpat (Ppat_construct($1, Some singleAnyPat)) + mkpat (Ppat_construct($1, Some ([], singleAnyPat))) | None -> let loc = mklocation $symbolstartpos $endpos in let argPattern = simple_pattern_list_to_tuple ~loc $2 in - mkExplicitArityTuplePat (Ppat_construct($1, Some argPattern)) + mkExplicitArityTuplePat (Ppat_construct($1, Some ([], argPattern))) } | name_tag simple_pattern { mkpat (Ppat_variant($1, Some $2)) } @@ -4027,12 +4032,12 @@ type_variables_with_variance: type_variable_with_variance: embedded - ( QUOTE ident { (mktyp (Ptyp_var $2) , Invariant ) } - | UNDERSCORE { (mktyp (Ptyp_any) , Invariant ) } - | PLUS QUOTE ident { (mktyp (Ptyp_var $3) , Covariant ) } - | PLUS UNDERSCORE { (mktyp (Ptyp_any) , Covariant ) } - | MINUS QUOTE ident { (mktyp (Ptyp_var $3) , Contravariant) } - | MINUS UNDERSCORE { (mktyp Ptyp_any , Contravariant) } + ( QUOTE ident { (mktyp (Ptyp_var $2) , (NoVariance, NoInjectivity) ) } + | UNDERSCORE { (mktyp (Ptyp_any) , (NoVariance, NoInjectivity) ) } + | PLUS QUOTE ident { (mktyp (Ptyp_var $3) , (Covariant, NoInjectivity) ) } + | PLUS UNDERSCORE { (mktyp (Ptyp_any) , (Covariant, NoInjectivity) ) } + | MINUS QUOTE ident { (mktyp (Ptyp_var $3) , (Contravariant, NoInjectivity)) } + | MINUS UNDERSCORE { (mktyp Ptyp_any , (Contravariant, NoInjectivity)) } ) { let first, second = $1 in let ptyp_loc = @@ -4042,10 +4047,10 @@ type_variable_with_variance: } ; -type_parameter: type_variance type_variable { ($2, $1) }; +type_parameter: type_variance type_variable { ($2, ($1, NoInjectivity)) }; type_variance: - | (* empty *) { Invariant } + | (* empty *) { NoVariance } | PLUS { Covariant } | MINUS { Contravariant } ; @@ -4222,7 +4227,7 @@ with_constraint: | TYPE as_loc(label_longident) type_variables_with_variance EQUAL embedded(private_flag) core_type constraints { let loc = mklocation $symbolstartpos $endpos in - let typ = Type.mk {$2 with txt=Longident.last $2.txt} + let typ = Type.mk {$2 with txt=Longident.last_exn $2.txt} ~params:$3 ~cstrs:$7 ~manifest:$6 ~priv:$5 ~loc in Pwith_type ($2, typ) } @@ -4642,7 +4647,7 @@ constant: | None -> [] | Some raw -> let constant = Exp.constant (Pconst_string (raw, loc, None)) in - [ { attr_name = Location.mkloc "reason.raw_literal" loc; + [ { attr_name = mkloc "reason.raw_literal" loc; attr_payload = PStr [mkstrexp constant []]; attr_loc = Location.none } ] diff --git a/src/reason-parser/reason_parser_def.ml b/src/reason-parser/reason_parser_def.ml index 0521994c1..17df73b02 100644 --- a/src/reason-parser/reason_parser_def.ml +++ b/src/reason-parser/reason_parser_def.ml @@ -1,4 +1,4 @@ -open Reason_omp.OCaml_411.Ast +open Ppxlib 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 5d7d005ef..668540a30 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -48,8 +48,7 @@ module Easy_format = Vendored_easy_format -open Reason_omp -open Ast_411 +open Ppxlib open Asttypes open Location open Longident @@ -178,7 +177,7 @@ let add_extension_sugar keyword = function let string_equal : string -> string -> bool = (=) -let string_loc_equal: string Ast_411.Asttypes.loc -> string Ast_411.Asttypes.loc -> bool = +let string_loc_equal: string Asttypes.loc -> string Asttypes.loc -> bool = fun l1 l2 -> l1.txt = l2.txt let longident_same l1 l2 = @@ -301,7 +300,7 @@ let expandLocation pos ~expand:(startPos, endPos) = * 2| let f = ... by the attr on line 1, not the lnum of the `let` *) let rec firstAttrLoc loc = function - | ({ attr_name = attrLoc; _} : Ast_411.Parsetree.attribute) ::attrs -> + | ({ attr_name = attrLoc; _} : Parsetree.attribute) ::attrs -> if attrLoc.loc.loc_start.pos_lnum < loc.loc_start.pos_lnum && not attrLoc.loc.loc_ghost then @@ -729,7 +728,7 @@ let override = function (* variance encoding: need to sync up with the [parser.mly] *) let type_variance = function - | Invariant -> "" + | NoVariance -> "" | Covariant -> "+" | Contravariant -> "-" @@ -2052,13 +2051,13 @@ let recordRowIsPunned pld = ptyp_attributes = []; _} when - (Longident.last txt = name + (Longident.last_exn txt = name (* Don't pun types from other modules, e.g. type bar = {foo: Baz.foo}; *) && isLongIdentWithDot txt == false) -> true | _ -> false) let isPunnedJsxArg lbl ident = - not (isLongIdentWithDot ident.txt) && (Longident.last ident.txt) = lbl + not (isLongIdentWithDot ident.txt) && (Longident.last_exn ident.txt) = lbl let is_unit_pattern x = match x.ppat_desc with | Ppat_construct ( {txt= Lident"()"}, None) -> true @@ -2514,7 +2513,7 @@ let printer = object(self:'self) makeList ~postSpace:true [atom "."; t] else t - method type_param (ct, a) = + method type_param (ct, (a, _)) = makeList [atom (type_variance a); self#core_type ct] (* According to the parse rule [type_declaration], the "type declaration"'s @@ -2626,7 +2625,7 @@ let printer = object(self:'self) in let sourceMappedName = atom ~loc:pext_name.loc pext_name.txt in let resolved = match pext_kind with - | Pext_decl (ctor_args, gadt) -> + | Pext_decl (_, ctor_args, gadt) -> let formattedArgs = match ctor_args with | Pcstr_tuple [] -> [] | Pcstr_tuple args -> [makeTup (List.map self#non_arrowed_non_simple_core_type args)] @@ -3101,7 +3100,7 @@ let printer = object(self:'self) self#type_variant_leaf ~opt_ampersand ~polymorphic:true - {pcd_name = label; pcd_args; pcd_res; pcd_loc = label.loc; pcd_attributes = all_attrs} + {pcd_name = label; pcd_args; pcd_res; pcd_loc = label.loc; pcd_attributes = all_attrs; pcd_vars = []} | Rinherit ct -> (* '| type' is required if the Rinherit is not the first row_field in the list @@ -3147,7 +3146,7 @@ let printer = object(self:'self) | { ppat_desc = Ppat_construct ( { txt = Lident("::")}, - Some {ppat_desc = Ppat_tuple ([pat1; pat2])} + Some ([], {ppat_desc = Ppat_tuple ([pat1; pat2])}) ) } -> self#pattern_list_split_cons (pat1::acc) pat2 | p -> (List.rev acc), p @@ -3255,7 +3254,7 @@ let printer = object(self:'self) (* ppat_attributes=[{txt="explicit_arity"; loc}] *) (* }) -> *) (* label ~space:true (self#longident_loc li) (makeSpacedBreakableInlineList (List.map self#simple_pattern l)) *) - | Some pattern -> + | Some (_, pattern) -> let arityIsClear = isArityClear arityAttrs in self#constructor_pattern ~arityIsClear (self#longident_loc li) pattern | None -> @@ -3507,10 +3506,10 @@ let printer = object(self:'self) match loc.txt with | Ldot (moduleLid, "createElement") -> Some (self#formatJSXComponent - (String.concat "." (Longident.flatten moduleLid)) l) + (String.concat "." (Longident.flatten_exn moduleLid)) l) | lid -> Some (self#formatJSXComponent - (String.concat "." (Longident.flatten lid)) l) + (String.concat "." (Longident.flatten_exn lid)) l) else None ) | (Pexp_apply ( @@ -3527,9 +3526,9 @@ let printer = object(self:'self) *) let rec extract_apps args = function | { pmod_desc = Pmod_apply (m1, {pmod_desc=Pmod_ident loc}) } -> - let arg = String.concat "." (Longident.flatten loc.txt) in + let arg = String.concat "." (Longident.flatten_exn loc.txt) in extract_apps (arg :: args) m1 - | { pmod_desc=Pmod_ident loc } -> (String.concat "." (Longident.flatten loc.txt))::args + | { pmod_desc=Pmod_ident loc } -> (String.concat "." (Longident.flatten_exn loc.txt))::args | _ -> failwith "Functors in JSX tags support only module names as parameters" in let hasLabelledChildrenLiteral = List.exists (function | (Labelled "children", _) -> true @@ -3542,8 +3541,8 @@ let printer = object(self:'self) | _ :: rest -> hasSingleNonLabelledUnitAndIsAtTheEnd rest in if hasLabelledChildrenLiteral && hasSingleNonLabelledUnitAndIsAtTheEnd l then - if List.length (Longident.flatten loc.txt) > 1 then - if Longident.last loc.txt = "createElement" then + if List.length (Longident.flatten_exn loc.txt) > 1 then + if Longident.last_exn loc.txt = "createElement" then begin match extract_apps [] app with | ftor::args -> let applied = ftor ^ "(" ^ String.concat ", " args ^ ")" in @@ -3551,7 +3550,7 @@ let printer = object(self:'self) | _ -> None end else None - else Some (self#formatJSXComponent (Longident.last loc.txt) l) + else Some (self#formatJSXComponent (Longident.last_exn loc.txt) l) else None ) | _ -> None @@ -5229,9 +5228,9 @@ let printer = object(self:'self) *) method attachDocAttrsToLayout (* all std attributes attached on the ast node backing the layout *) - ~stdAttrs:(stdAttrs : Ast_411.Parsetree.attributes) + ~stdAttrs:(stdAttrs : Parsetree.attributes) (* all doc comments attached on the ast node backing the layout *) - ~docAttrs:(docAttrs : Ast_411.Parsetree.attributes) + ~docAttrs:(docAttrs : Parsetree.attributes) (* location of the layout *) ~loc (* layout to attach the doc comments to *) @@ -5254,7 +5253,7 @@ let printer = object(self:'self) | [] -> loc in let rec aux prevLoc layout = function - | ({ attr_name = x; _} as attr : Ast_411.Parsetree.attribute)::xs -> + | ({ attr_name = x; _} as attr : Parsetree.attribute)::xs -> let newLayout = let range = Range.makeRangeBetween x.loc prevLoc in let layout = @@ -5750,13 +5749,13 @@ let printer = object(self:'self) method patternRecord ?(wrap=("","")) l closed = let longident_x_pattern (li, p) = match (li, p.ppat_desc) with - | ({txt = ident}, Ppat_var {txt}) when Longident.last ident = txt -> + | ({txt = ident}, Ppat_var {txt}) when Longident.last_exn ident = txt -> (* record field punning when destructuring. {x: x, y: y} becomes {x, y} *) (* works with module prefix too: {MyModule.x: x, y: y} becomes {MyModule.x, y} *) self#longident_loc li | ({txt = ident}, Ppat_alias ({ppat_desc = (Ppat_var {txt = ident2}) }, {txt = aliasIdent})) - when Longident.last ident = ident2 -> + when Longident.last_exn ident = ident2 -> (* record field punning when destructuring with renaming. {state: state as prevState} becomes {state as prevState *) (* works with module prefix too: {ReasonReact.state: state as prevState} becomes {ReasonReact.state as prevState *) makeList ~sep:(Sep " ") [self#longident_loc li; atom "as"; atom aliasIdent] @@ -6112,7 +6111,7 @@ let printer = object(self:'self) (* record value punning. Turns {foo: foo, bar: 1} into {foo, bar: 1} *) (* also turns {Foo.bar: bar, baz: 1} into {Foo.bar, baz: 1} *) (* don't turn {bar: Foo.bar, baz: 1} into {bar, baz: 1}, naturally *) - | (Pexp_ident {txt = Lident value}, true, true) when Longident.last li.txt = value -> + | (Pexp_ident {txt = Lident value}, true, true) when Longident.last_exn li.txt = value -> makeList (maybeQuoteFirstElem li []) (* Force breaks for nested records or bs obj sugar @@ -6601,9 +6600,9 @@ let printer = object(self:'self) let pcd_loc = ed.pext_loc in let pcd_attributes = [] in let exn_arg = match ed.pext_kind with - | Pext_decl (args, type_opt) -> + | Pext_decl (vars, args, type_opt) -> let pcd_args, pcd_res = args, type_opt in - [self#type_variant_leaf_nobar {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes}] + [self#type_variant_leaf_nobar {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes; pcd_vars = vars}] | Pext_rebind id -> [atom pcd_name.txt; atom "="; (self#longident_loc id)] in let {stdAttrs; docAttrs} = @@ -7384,6 +7383,7 @@ let printer = object(self:'self) () | Psig_typesubst l -> self#type_def_list ~eq_symbol:":=" (Recursive, l) + | Psig_modtypesubst _ -> assert false in source_map ~loc:x.psig_loc item @@ -7504,6 +7504,7 @@ let printer = object(self:'self) destrAtom td | Pwith_modsubst (s, li2) -> modSub (self#longident s.txt) li2 ":=" + | Pwith_modtype (_, _)|Pwith_modtypesubst (_, _) -> assert false in (match l with | [] -> self#module_type ~space letPattern mt @@ -7542,9 +7543,9 @@ let printer = object(self:'self) formatPrecedence (self#module_type letPattern mt) | Pmod_structure s -> let wrap = if hug then - if s = [] then - ("(", ")") - else + if s = [] then + ("(", ")") + else ("({", "})") else ("{", "}") in let items = @@ -7584,7 +7585,7 @@ let printer = object(self:'self) method structure structureItems = (* We don't have any way to know if an extension is placed at the top level by the parsetree while there's a difference syntactically (% for structure_items/expressons and %% for top_level). - This small fn detects this particular case (structure > structure_item > extension > value) and + This small fn detects this particular case (structure > structure_item > extension > value) and prints with double % *) let structure_item item = match item.pstr_desc with @@ -7904,7 +7905,7 @@ let printer = object(self:'self) | [] -> [] | hd::tl -> let formattedHd = self#pattern hd in - let formattedHd = match hd.ppat_desc with + let formattedHd = match hd.ppat_desc with | Ppat_constraint _ -> formatPrecedence formattedHd | _ -> formattedHd in @@ -8111,7 +8112,7 @@ let printer = object(self:'self) *) let forceBreak = match funExpr.pexp_desc with | Pexp_ident ident when - let lastIdent = Longident.last ident.txt in + let lastIdent = Longident.last_exn ident.txt in List.mem lastIdent ["test"; "describe"; "it"; "expect"] -> true | _ -> false in @@ -8288,78 +8289,88 @@ let wrap_pat_with_tuple pat = * *) -module StringSet = Set.Make(String);; +module StringSet = Stdlib.Set.Make(String) let built_in_explicit_arity_constructors = ["Some"; "Assert_failure"; "Match_failure"] let explicit_arity_constructors = StringSet.of_list(built_in_explicit_arity_constructors @ (!configuredSettings).constructorLists) -let add_explicit_arity_mapper super = - let super_expr = super.Ast_mapper.expr in - let super_pat = super.Ast_mapper.pat in - let expr mapper expr = - let expr = - match expr with - | {pexp_desc=Pexp_construct(lid, Some sp); - pexp_loc; - pexp_attributes} when - List.exists - (fun c -> StringSet.mem c explicit_arity_constructors) - (longident_for_arity lid.txt) && - explicit_arity_not_exists pexp_attributes -> - {pexp_desc=Pexp_construct(lid, Some (wrap_expr_with_tuple sp)); - pexp_loc; - pexp_attributes=add_explicit_arity pexp_loc pexp_attributes; - pexp_loc_stack = []} - | x -> x - in - super_expr mapper expr - and pat mapper pat = - let pat = - match pat with - | {ppat_desc=Ppat_construct(lid, Some sp); - ppat_loc; - ppat_attributes} when - List.exists - (fun c -> StringSet.mem c explicit_arity_constructors) - (longident_for_arity lid.txt) && - explicit_arity_not_exists ppat_attributes -> - {ppat_desc=Ppat_construct(lid, Some (wrap_pat_with_tuple sp)); - ppat_loc; - ppat_attributes=add_explicit_arity ppat_loc ppat_attributes; - ppat_loc_stack = []} - | x -> x - in - super_pat mapper pat - in - { super with Ast_mapper. expr; pat } let preprocessing_mapper = - ml_to_reason_swap_operator_mapper - (escape_stars_slashes_mapper - (add_explicit_arity_mapper Ast_mapper.default_mapper)) + let escape_slashes = new Reason_syntax_util.escape_stars_slashes_mapper in + object + inherit Ast_traverse.map as super + + method! expression expr = + let expr = + match expr with + | {pexp_desc=Pexp_construct(lid, Some sp); + pexp_loc; + pexp_attributes} when + List.exists + (fun c -> StringSet.mem c explicit_arity_constructors) + (longident_for_arity lid.txt) && + explicit_arity_not_exists pexp_attributes -> + {pexp_desc=Pexp_construct(lid, Some (wrap_expr_with_tuple sp)); + pexp_loc; + pexp_attributes=add_explicit_arity pexp_loc pexp_attributes; + pexp_loc_stack = []} + | x -> x + in + escape_slashes#expression (super#expression expr) + + method! pattern pat = + let pat = + match pat with + | {ppat_desc=Ppat_construct(lid, Some (x, sp)); + ppat_loc; + ppat_attributes} when + List.exists + (fun c -> StringSet.mem c explicit_arity_constructors) + (longident_for_arity lid.txt) && + explicit_arity_not_exists ppat_attributes -> + {ppat_desc=Ppat_construct(lid, Some (x, wrap_pat_with_tuple sp)); + ppat_loc; + ppat_attributes=add_explicit_arity ppat_loc ppat_attributes; + ppat_loc_stack = []} + | x -> x + in + escape_slashes#pattern (super#pattern pat) + end + +let ml_to_reason_swap_operator_mapper = new Reason_syntax_util.ml_to_reason_swap_operator_mapper + +let preprocessing_mapper f a = + a + |> f ml_to_reason_swap_operator_mapper + |> f preprocessing_mapper let core_type ppf x = format_layout ppf - (printer#core_type (apply_mapper_to_type x preprocessing_mapper)) + (printer#core_type + (preprocessing_mapper apply_mapper_to_type x)) let pattern ppf x = format_layout ppf - (printer#pattern (apply_mapper_to_pattern x preprocessing_mapper)) + (printer#pattern + (preprocessing_mapper apply_mapper_to_pattern x)) let signature (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments - (printer#signature (apply_mapper_to_signature x preprocessing_mapper)) + (printer#signature + (preprocessing_mapper apply_mapper_to_signature x)) let structure (comments : Comment.t list) ppf x = List.iter (fun comment -> printer#trackComment comment) comments; format_layout ppf ~comments - (printer#structure (apply_mapper_to_structure x preprocessing_mapper)) + (printer#structure + (preprocessing_mapper apply_mapper_to_structure x)) let expression ppf x = format_layout ppf - (printer#unparseExpr (apply_mapper_to_expr x preprocessing_mapper)) + (printer#unparseExpr + (preprocessing_mapper apply_mapper_to_expr x)) let case_list = case_list diff --git a/src/reason-parser/reason_pprint_ast.mli b/src/reason-parser/reason_pprint_ast.mli index 932569e8f..513d2a1b9 100644 --- a/src/reason-parser/reason_pprint_ast.mli +++ b/src/reason-parser/reason_pprint_ast.mli @@ -1,5 +1,4 @@ -open Reason_omp -open Ast_411.Parsetree +open Ppxlib val configure : width:int -> @@ -7,11 +6,11 @@ val configure : val createFormatter : unit -> < - case_list : Format.formatter -> case list -> unit; - core_type : Format.formatter -> core_type -> unit; - expression : Format.formatter -> expression -> unit; - pattern : Format.formatter -> pattern -> unit; - signature : Reason_comment.t list -> Format.formatter -> signature -> unit; - structure : Reason_comment.t list -> Format.formatter -> structure -> unit; - toplevel_phrase : Format.formatter -> toplevel_phrase -> unit; + case_list : Format.formatter -> Parsetree.case list -> unit; + core_type : Format.formatter -> Parsetree.core_type -> unit; + expression : Format.formatter -> Parsetree.expression -> unit; + pattern : Format.formatter -> Parsetree.pattern -> unit; + signature : Reason_comment.t list -> Format.formatter -> Parsetree.signature -> unit; + structure : Reason_comment.t list -> Format.formatter -> Parsetree.structure -> unit; + toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit; > diff --git a/src/reason-parser/reason_syntax_util.cppo.ml b/src/reason-parser/reason_syntax_util.cppo.ml index 443ffe306..1caf38f44 100644 --- a/src/reason-parser/reason_syntax_util.cppo.ml +++ b/src/reason-parser/reason_syntax_util.cppo.ml @@ -14,11 +14,8 @@ patching the right parts, through the power of types(tm) *) -open Reason_omp -open Ast_411 - +open Ppxlib open Asttypes -open Ast_mapper open Parsetree open Longident @@ -403,19 +400,27 @@ let map_core_type f typ = | other -> other } +(* class supery= Ppxlib.Ast_traverse.map *) + (** identifier_mapper maps all identifiers in an AST with a mapping function f this is used by swap_operator_mapper right below, to traverse the whole AST and swapping the symbols listed above. *) -let identifier_mapper f super = -let map_fields fields = List.map(fun (lid,x) -> (map_lident f lid, x)) fields in -let map_name ({txt} as name) = {name with txt=(f txt)} in -let map_lid lid = map_lident f lid in -let map_label label = map_arg_label f label in -{ super with - expr = begin fun mapper expr -> - let expr = - match expr with + + +class identifier_mapper f = + + let map_fields fields = List.map(fun (lid,x) -> (map_lident f lid, x)) fields in + let map_name ({txt} as name) = {name with txt=(f txt)} in + let map_lid lid = map_lident f lid in + let map_label label = map_arg_label f label in + + object + inherit Ast_traverse.map as super + + method! expression (expr: Parsetree.expression) = + let expr = + match expr with | { pexp_desc = Pexp_ident lid } -> { expr with pexp_desc = Pexp_ident (map_lid lid) } | { pexp_desc = Pexp_fun (label, eo, pat, e) } when !rename_labels -> @@ -452,128 +457,125 @@ let map_label label = map_arg_label f label in { expr with pexp_desc = Pexp_newtype ({ s with txt = f s.txt }, e) } | _ -> expr - in - super.expr mapper expr - end; - pat = begin fun mapper pat -> - let pat = - match pat with - | { ppat_desc = Ppat_var name } -> - { pat with ppat_desc = Ppat_var (map_name name) } - | { ppat_desc = Ppat_alias (p, name) } -> - { pat with ppat_desc = Ppat_alias (p, map_name name) } - | { ppat_desc = Ppat_variant (s, po) } -> - { pat with - ppat_desc = Ppat_variant (f s, po) } - | { ppat_desc = Ppat_record (fields, closed) } when !rename_labels -> - { pat with - ppat_desc = Ppat_record (map_fields fields, closed) } - | { ppat_desc = Ppat_type lid } -> - { pat with ppat_desc = Ppat_type (map_lid lid) } - | _ -> pat - in - super.pat mapper pat - end; - value_description = begin fun mapper desc -> - let desc' = - { desc with - pval_name = map_name desc.pval_name } - in - super.value_description mapper desc' - end; - type_declaration = begin fun mapper type_decl -> - let type_decl' = - { type_decl with ptype_name = map_name type_decl.ptype_name } - in - let type_decl'' = match type_decl'.ptype_kind with - | Ptype_record lst when !rename_labels -> - { type_decl' - with ptype_kind = Ptype_record (List.map (fun lbl -> - { lbl with pld_name = map_name lbl.pld_name }) - lst) } - | _ -> type_decl' - in - super.type_declaration mapper type_decl'' - end; - typ = begin fun mapper typ -> - super.typ mapper (map_core_type f typ) - end; - class_declaration = begin fun mapper class_decl -> - let class_decl' = - { class_decl - with pci_name = map_name class_decl.pci_name - ; pci_expr = map_class_expr f class_decl.pci_expr - } - in - super.class_declaration mapper class_decl' - end; - class_field = begin fun mapper class_field -> - let class_field_desc' = match class_field.pcf_desc with - | Pcf_inherit (ovf, e, lo) -> - Pcf_inherit (ovf, map_class_expr f e, lo) - | Pcf_val (lbl, mut, kind) -> - Pcf_val ({lbl with txt = f lbl.txt}, mut, kind) - | Pcf_method (lbl, priv, kind) -> - Pcf_method ({lbl with txt = f lbl.txt}, priv, kind) - | x -> x - in - super.class_field mapper { class_field with pcf_desc = class_field_desc' } - end; - class_type_field = begin fun mapper class_type_field -> - let class_type_field_desc' = match class_type_field.pctf_desc with - | Pctf_inherit class_type -> - Pctf_inherit (map_class_type f class_type) - | Pctf_val (lbl, mut, vf, ct) -> - Pctf_val ({ lbl with txt = f lbl.txt }, mut, vf, ct) - | Pctf_method (lbl, pf, vf, ct) -> - Pctf_method ({ lbl with txt = f lbl.txt }, pf, vf, ct) - | x -> x - in - super.class_type_field mapper - { class_type_field - with pctf_desc = class_type_field_desc' } - end; - class_type_declaration = begin fun mapper class_type_decl -> - let class_type_decl' = - { class_type_decl - with pci_name = map_name class_type_decl.pci_name } - in - super.class_type_declaration mapper class_type_decl' - end; - module_type_declaration = begin fun mapper module_type_decl -> - let module_type_decl' = - { module_type_decl - with pmtd_name = map_name module_type_decl.pmtd_name } - in - super.module_type_declaration mapper module_type_decl' - end; -} - -let remove_stylistic_attrs_mapper_maker super = - let open Ast_411 in - let open Ast_mapper in -{ super with - expr = begin fun mapper expr -> - let {Reason_attributes.stylisticAttrs; arityAttrs; docAttrs; stdAttrs; jsxAttrs} = - Reason_attributes.partitionAttributes ~allowUncurry:false expr.pexp_attributes - in - let expr = if stylisticAttrs != [] then - { expr with pexp_attributes = arityAttrs @ docAttrs @ stdAttrs @ jsxAttrs } - else expr - in - super.expr mapper expr - end; - pat = begin fun mapper pat -> - let {Reason_attributes.stylisticAttrs; arityAttrs; docAttrs; stdAttrs; jsxAttrs} = - Reason_attributes.partitionAttributes ~allowUncurry:false pat.ppat_attributes - in - let pat = if stylisticAttrs != [] then - { pat with ppat_attributes = arityAttrs @ docAttrs @ stdAttrs @ jsxAttrs } - else pat - in - super.pat mapper pat - end; -} + in + super#expression expr + + method! pattern pat = + let pat = + match pat with + | { ppat_desc = Ppat_var name } -> + { pat with ppat_desc = Ppat_var (map_name name) } + | { ppat_desc = Ppat_alias (p, name) } -> + { pat with ppat_desc = Ppat_alias (p, map_name name) } + | { ppat_desc = Ppat_variant (s, po) } -> + { pat with + ppat_desc = Ppat_variant (f s, po) } + | { ppat_desc = Ppat_record (fields, closed) } when !rename_labels -> + { pat with + ppat_desc = Ppat_record (map_fields fields, closed) } + | { ppat_desc = Ppat_type lid } -> + { pat with ppat_desc = Ppat_type (map_lid lid) } + | _ -> pat + in + super#pattern pat + + method! value_description desc = + let desc' = + { desc with + pval_name = map_name desc.pval_name } + in + super#value_description desc' + + method! type_declaration type_decl = + let type_decl' = + { type_decl with ptype_name = map_name type_decl.ptype_name } + in + let type_decl'' = match type_decl'.ptype_kind with + | Ptype_record lst when !rename_labels -> + { type_decl' + with ptype_kind = Ptype_record (List.map (fun lbl -> + { lbl with pld_name = map_name lbl.pld_name }) + lst) } + | _ -> type_decl' + in + super#type_declaration type_decl'' + + method! core_type typ = super#core_type (map_core_type f typ) + + method! class_declaration class_decl = + let class_decl' = + { class_decl + with pci_name = map_name class_decl.pci_name + ; pci_expr = map_class_expr f class_decl.pci_expr + } + in + super#class_declaration class_decl' + + method! class_field class_field = + let class_field_desc' = match class_field.pcf_desc with + | Pcf_inherit (ovf, e, lo) -> + Pcf_inherit (ovf, map_class_expr f e, lo) + | Pcf_val (lbl, mut, kind) -> + Pcf_val ({lbl with txt = f lbl.txt}, mut, kind) + | Pcf_method (lbl, priv, kind) -> + Pcf_method ({lbl with txt = f lbl.txt}, priv, kind) + | x -> x + in + super#class_field { class_field with pcf_desc = class_field_desc' } + + method! class_type_field class_type_field = + let class_type_field_desc' = match class_type_field.pctf_desc with + | Pctf_inherit class_type -> + Pctf_inherit (map_class_type f class_type) + | Pctf_val (lbl, mut, vf, ct) -> + Pctf_val ({ lbl with txt = f lbl.txt }, mut, vf, ct) + | Pctf_method (lbl, pf, vf, ct) -> + Pctf_method ({ lbl with txt = f lbl.txt }, pf, vf, ct) + | x -> x + in + super#class_type_field + { class_type_field + with pctf_desc = class_type_field_desc' } + + method! class_type_declaration class_type_decl = + let class_type_decl' = + { class_type_decl + with pci_name = map_name class_type_decl.pci_name } + in + super#class_type_declaration class_type_decl' + + method! module_type_declaration module_type_decl = + let module_type_decl' = + { module_type_decl + with pmtd_name = map_name module_type_decl.pmtd_name } + in + super#module_type_declaration module_type_decl' + end + +let remove_stylistic_attrs_mapper_maker = + object + inherit Ast_traverse.map as super + + method! expression expr = + let {Reason_attributes.stylisticAttrs; arityAttrs; docAttrs; stdAttrs; jsxAttrs} = + Reason_attributes.partitionAttributes ~allowUncurry:false expr.pexp_attributes + in + let expr = if stylisticAttrs != [] then + { expr with pexp_attributes = arityAttrs @ docAttrs @ stdAttrs @ jsxAttrs } + else expr + in + super#expression expr + + method! pattern pat = + let {Reason_attributes.stylisticAttrs; arityAttrs; docAttrs; stdAttrs; jsxAttrs} = + Reason_attributes.partitionAttributes ~allowUncurry:false pat.ppat_attributes + in + let pat = if stylisticAttrs != [] then + { pat with ppat_attributes = arityAttrs @ docAttrs @ stdAttrs @ jsxAttrs } + else pat + in + super#pattern pat + end let escape_stars_slashes str = if String.contains str '/' then @@ -585,7 +587,7 @@ let escape_stars_slashes str = str let remove_stylistic_attrs_mapper = - remove_stylistic_attrs_mapper_maker Ast_mapper.default_mapper + remove_stylistic_attrs_mapper_maker let let_monad_symbols = [ '$'; '&'; '*'; '+'; '-'; '/'; '<'; '='; '>'; '@'; '^'; '|'; '.'; '!'] @@ -625,16 +627,8 @@ let is_andop s = #endif #if OCAML_VERSION >= (4, 8, 0) -let noop_mapper super = - let noop = fun _mapper x -> x in - { super with - expr = noop; - structure = noop; - structure_item = noop; - signature = noop; - signature_item = noop; } (* Don't need to backport past 4.08 *) -let backport_letopt_mapper = noop_mapper +let backport_letopt_mapper = new Ast_traverse.map let expand_letop_identifier s = s let compress_letop_identifier s = s #else @@ -728,64 +722,70 @@ let compress_letop_identifier s = s * * (let+)((and+)(y, b), ((x, a)) => x + a) *) -let backport_letopt_mapper super = - let open Ast_411 in - let open Ast_mapper in -{ super with - expr = fun mapper expr -> - match expr.pexp_desc with - | Pexp_letop { let_; ands; body } -> - (* coalesce the initial 'let' and any subsequent 'and's into a final - Pattern (for the argument of the continuation function) and - Expression (the first arg ot the let function) - - let+ a = b - and+ c = d - and+ e = f - and+ g = h - - produces the pattern (a, (c, (e, g))) - and the expression (and+)(b, (and+)(d, (and+)(f, h))) - *) - let rec loop = function - | [] -> assert false - | {pbop_op; pbop_pat; pbop_exp}::[] -> (pbop_pat, pbop_exp, pbop_op) - | {pbop_op; pbop_pat; pbop_exp; pbop_loc}::rest -> - let (pattern, expr, op) = loop rest in - let and_op_ident = Ast_helper.Exp.ident - ~loc:op.loc - (Location.mkloc (Longident.Lident op.txt) op.loc) - in - ( - Ast_helper.Pat.tuple ~loc:pbop_loc [pbop_pat; pattern], - Ast_helper.Exp.apply ~loc:pbop_loc and_op_ident [(Nolabel, pbop_exp); (Nolabel, expr)], - pbop_op - ) - in - let (pattern, expr, _) = loop (let_::ands) in - let let_op_ident = Ast_helper.Exp.ident - ~loc:let_.pbop_op.loc - (Location.mkloc (Longident.Lident let_.pbop_op.txt) let_.pbop_op.loc) - in - super.expr mapper {expr with - pexp_desc = Pexp_apply (let_op_ident, [ - (Nolabel, expr); - (Nolabel, Ast_helper.Exp.fun_ ~loc:let_.pbop_loc Nolabel None pattern body) - ])} - | _ -> super.expr mapper expr -} +let backport_letopt_mapper = + object + inherit Ast_traverse.map as super + + method! expression expr = + match expr.pexp_desc with + | Pexp_letop { let_; ands; body } -> + (* coalesce the initial 'let' and any subsequent 'and's into a final + Pattern (for the argument of the continuation function) and + Expression (the first arg ot the let function) + + let+ a = b + and+ c = d + and+ e = f + and+ g = h + + produces the pattern (a, (c, (e, g))) + and the expression (and+)(b, (and+)(d, (and+)(f, h))) + *) + let rec loop = function + | [] -> assert false + | {pbop_op; pbop_pat; pbop_exp}::[] -> (pbop_pat, pbop_exp, pbop_op) + | {pbop_op; pbop_pat; pbop_exp; pbop_loc}::rest -> + let (pattern, expr, op) = loop rest in + let and_op_ident = Ast_helper.Exp.ident + ~loc:op.loc + {Location.txt = (Longident.Lident op.txt); loc = op.loc} + in + ( + Ast_helper.Pat.tuple ~loc:pbop_loc [pbop_pat; pattern], + Ast_helper.Exp.apply ~loc:pbop_loc and_op_ident [(Nolabel, pbop_exp); (Nolabel, expr)], + pbop_op + ) + in + let (pattern, expr, _) = loop (let_::ands) in + let let_op_ident = Ast_helper.Exp.ident + ~loc:let_.pbop_op.loc + { Location.txt = (Longident.Lident let_.pbop_op.txt); loc = let_.pbop_op.loc } + in + super#expression {expr with + pexp_desc = Pexp_apply (let_op_ident, [ + (Nolabel, expr); + (Nolabel, Ast_helper.Exp.fun_ ~loc:let_.pbop_loc Nolabel None pattern body) + ])} + | _ -> super#expression expr + end #endif (** escape_stars_slashes_mapper escapes all stars and slashes in an AST *) -let escape_stars_slashes_mapper = identifier_mapper escape_stars_slashes +class escape_stars_slashes_mapper = object + inherit identifier_mapper escape_stars_slashes +end (* To be used in parser, transform a token into an ast node with different identifier *) -let reason_to_ml_swap_operator_mapper = identifier_mapper reason_to_ml_swap +class reason_to_ml_swap_operator_mapper = object + inherit identifier_mapper reason_to_ml_swap +end (* To be used in printer, transform an ast node into a token with different identifier *) -let ml_to_reason_swap_operator_mapper = identifier_mapper ml_to_reason_swap +class ml_to_reason_swap_operator_mapper = object + inherit identifier_mapper ml_to_reason_swap +end (* attribute_equals tests an attribute is txt *) @@ -809,19 +809,19 @@ let normalized_attributes attribute attributes = List.filter (fun x -> not (attribute_equals attribute x)) attributes (* apply_mapper family applies an ast_mapper to an ast *) -let apply_mapper_to_structure s mapper = mapper.structure mapper s -let apply_mapper_to_signature s mapper = mapper.signature mapper s -let apply_mapper_to_type s mapper = mapper.typ mapper s -let apply_mapper_to_expr s mapper = mapper.expr mapper s -let apply_mapper_to_pattern s mapper = mapper.pat mapper s +let apply_mapper_to_structure mapper s= mapper#structure s +let apply_mapper_to_signature mapper s= mapper#signature s +let apply_mapper_to_type mapper s= mapper#core_type s +let apply_mapper_to_expr mapper s= mapper#expression s +let apply_mapper_to_pattern mapper s= mapper#pattern s -let apply_mapper_to_toplevel_phrase toplevel_phrase mapper = +let apply_mapper_to_toplevel_phrase mapper toplevel_phrase = match toplevel_phrase with - | Ptop_def x -> Ptop_def (apply_mapper_to_structure x mapper) + | Ptop_def x -> Ptop_def (apply_mapper_to_structure mapper x) | x -> x -let apply_mapper_to_use_file use_file mapper = - List.map (fun x -> apply_mapper_to_toplevel_phrase x mapper) use_file +let apply_mapper_to_use_file mapper use_file = + List.map (fun x -> apply_mapper_to_toplevel_phrase mapper x) use_file let map_first f = function | [] -> invalid_arg "Syntax_util.map_first: empty list" @@ -842,11 +842,11 @@ let location_contains loc1 loc2 = loc1.loc_end.Lexing.pos_cnum >= loc2.loc_end.Lexing.pos_cnum #if OCAML_VERSION >= (4, 8, 0) -let split_compiler_error (err : Location.error) = - (err.main.loc, Format.asprintf "%t" err.main.txt) +let split_compiler_error (err : Location.Error.t) = + (Location.Error.get_location err, Format.asprintf "%s" (Location.Error.message err)) #else -let split_compiler_error (err : Location.error) = - (err.loc, err.msg) +let split_compiler_error (err : Location.Error.t) = + (Location.Error.get_location err, Location.Error.message err) #endif let explode_str str = @@ -856,7 +856,7 @@ let explode_str str = loop [] (String.length str - 1) module Clflags = struct - include Clflags + include Ocaml_common.Clflags #if OCAML_VERSION >= (4, 8, 0) let fast = unsafe @@ -865,7 +865,12 @@ end let parse_lid s = #if OCAML_VERSION >= (4, 6, 0) - match Longident.unflatten (String.split_on_char '.' s) with + let unflatten l = + match l with + | [] -> None + | hd :: tl -> Some (List.fold_left (fun p s -> Ldot(p, s)) (Lident hd) tl) + in + match unflatten (String.split_on_char '.' s) with | Some lid -> lid | None -> failwith (Format.asprintf "parse_lid: unable to parse '%s' to longident" s) #else diff --git a/src/reason-parser/reason_syntax_util.cppo.mli b/src/reason-parser/reason_syntax_util.cppo.mli index 155d685fb..9c9e2fff6 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 Reason_omp.Ast_411 +open Ppxlib val ml_to_reason_swap : string -> string @@ -34,25 +34,22 @@ val processLineEndingsAndStarts : string -> string val isLineComment : string -> bool -val remove_stylistic_attrs_mapper : Ast_mapper.mapper +val remove_stylistic_attrs_mapper : Ast_traverse.map val is_letop : string -> bool val is_andop : string -> bool val compress_letop_identifier : string -> string val expand_letop_identifier : string -> string -val backport_letopt_mapper : Ast_mapper.mapper -> Ast_mapper.mapper +val backport_letopt_mapper : Ast_traverse.map val escape_stars_slashes : string -> string -val escape_stars_slashes_mapper : - Ast_mapper.mapper -> Ast_mapper.mapper +class escape_stars_slashes_mapper : Ast_traverse.map -val reason_to_ml_swap_operator_mapper : - Ast_mapper.mapper -> Ast_mapper.mapper +class reason_to_ml_swap_operator_mapper : Ast_traverse.map -val ml_to_reason_swap_operator_mapper : - Ast_mapper.mapper -> Ast_mapper.mapper +class ml_to_reason_swap_operator_mapper : Ast_traverse.map val attribute_exists : string -> Parsetree.attributes -> bool @@ -62,25 +59,27 @@ val attributes_conflicted : val normalized_attributes : string -> Parsetree.attributes -> Parsetree.attributes val apply_mapper_to_structure : - Parsetree.structure -> Ast_mapper.mapper -> Parsetree.structure + Ast_traverse.map -> Parsetree.structure -> Parsetree.structure val apply_mapper_to_signature : - Parsetree.signature -> Ast_mapper.mapper -> Parsetree.signature + Ast_traverse.map -> Parsetree.signature -> Parsetree.signature val apply_mapper_to_type : - Parsetree.core_type -> Ast_mapper.mapper -> Parsetree.core_type + Ast_traverse.map -> Parsetree.core_type -> Parsetree.core_type val apply_mapper_to_expr : - Parsetree.expression -> Ast_mapper.mapper -> Parsetree.expression + Ast_traverse.map -> Parsetree.expression -> Parsetree.expression val apply_mapper_to_pattern : - Parsetree.pattern -> Ast_mapper.mapper -> Parsetree.pattern + Ast_traverse.map -> Parsetree.pattern -> Parsetree.pattern val apply_mapper_to_toplevel_phrase : - Parsetree.toplevel_phrase -> Ast_mapper.mapper -> Parsetree.toplevel_phrase + Ast_traverse.map -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase -val apply_mapper_to_use_file : Parsetree.toplevel_phrase list -> - Ast_mapper.mapper -> Parsetree.toplevel_phrase list +val apply_mapper_to_use_file + : Ast_traverse.map + -> Parsetree.toplevel_phrase list + -> Parsetree.toplevel_phrase list val map_first : ('a -> 'a) -> 'a list -> 'a list @@ -90,12 +89,12 @@ val location_is_before : Location.t -> Location.t -> bool val location_contains : Location.t -> Location.t -> bool -val split_compiler_error : Location.error -> Location.t * string +val split_compiler_error : Location.Error.t -> Location.t * string val explode_str : string -> char list module Clflags : sig - include module type of Clflags + include module type of Ocaml_common.Clflags #if OCAML_VERSION >= (4, 8, 0) val fast : bool ref diff --git a/src/reason-parser/reason_toolchain.ml b/src/reason-parser/reason_toolchain.ml index 73b00aeed..8c53b1efb 100644 --- a/src/reason-parser/reason_toolchain.ml +++ b/src/reason-parser/reason_toolchain.ml @@ -79,8 +79,7 @@ *) open Reason_toolchain_conf -open Reason_omp -open Ast_411 +open Ppxlib open Location open Lexing @@ -285,7 +284,7 @@ module Create_parse_entrypoint (Toolchain_impl: Toolchain_spec) :Toolchain = str Reason_errors.report_error Format.str_formatter ~loc e; (loc, Format.flush_str_formatter ()) | exn -> - (Location.curr lexbuf, "default_error: " ^ Printexc.to_string exn) + (Location.of_lexbuf lexbuf, "default_error: " ^ Printexc.to_string exn) in (loc, Reason_errors.error_extension_node loc msg) else diff --git a/src/reason-parser/reason_toolchain_conf.ml b/src/reason-parser/reason_toolchain_conf.ml index 2b7cc1c19..afb1ef87a 100644 --- a/src/reason-parser/reason_toolchain_conf.ml +++ b/src/reason-parser/reason_toolchain_conf.ml @@ -1,8 +1,13 @@ -open Reason_omp -include Ast_411 +open Ppxlib -module From_current = Convert(OCaml_current)(OCaml_411) -module To_current = Convert(OCaml_411)(OCaml_current) +module From_current = struct + include Ppxlib.Selected_ast.Of_ocaml + include Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) +end +module To_current = struct + include Ppxlib.Selected_ast.To_ocaml + include Reason_omp.Convert (Reason_omp.OCaml_414) (Reason_omp.OCaml_current) +end module type Toolchain = sig (* Parsing *) diff --git a/src/reason-parser/reason_toolchain_ocaml.ml b/src/reason-parser/reason_toolchain_ocaml.ml index e37a7ddfb..57cda180e 100644 --- a/src/reason-parser/reason_toolchain_ocaml.ml +++ b/src/reason-parser/reason_toolchain_ocaml.ml @@ -1,24 +1,28 @@ +open Ppxlib open Reason_toolchain_conf (* The OCaml parser keep doc strings in the comment list. To avoid duplicating comments, we need to filter comments that appear as doc strings is the AST out of the comment list. *) let doc_comments_filter () = - let open Ast_mapper in let open Parsetree in let seen = Hashtbl.create 7 in - let attribute mapper = function - | { attr_name = { Location. txt = ("ocaml.doc" | "ocaml.text")}; - attr_payload = - PStr [{ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string(_text, _loc, None)) } , _); - pstr_loc = loc }]} as attribute -> - (* Workaround: OCaml 4.02.3 kept an initial '*' in docstrings. - * For other versions, we have to put the '*' back. *) - Hashtbl.add seen loc (); - default_mapper.attribute mapper attribute - | attribute -> default_mapper.attribute mapper attribute + let mapper = + object + inherit Ast_traverse.map as super + method! attribute attr = + match attr with + | { attr_name = { Location. txt = ("ocaml.doc" | "ocaml.text")}; + attr_payload = + PStr [{ pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string(_text, _loc, None)) } , _); + pstr_loc = loc }]} as attribute -> + (* Workaround: OCaml 4.02.3 kept an initial '*' in docstrings. + * For other versions, we have to put the '*' back. *) + Hashtbl.add seen loc (); + super#attribute attribute + | attribute -> super#attribute attribute + end in - let mapper = {default_mapper with attribute} in let filter (_text, loc) = not (Hashtbl.mem seen loc) in (mapper, filter) @@ -33,7 +37,7 @@ module Lexer_impl = struct filtered_comments := List.filter filter (Lexer.comments ()) let get_comments _lexbuf _docstrings = !filtered_comments end -module OCaml_parser = Parser +module OCaml_parser = Ocaml_common.Parser type token = OCaml_parser.token type invalid_docstrings = unit @@ -49,34 +53,34 @@ let parse_and_filter_doc_comments iter fn lexbuf= let implementation lexbuf = parse_and_filter_doc_comments - (fun it -> it.Ast_mapper.structure it) + (fun it stru -> it#structure stru) (fun lexbuf -> From_current.copy_structure - (Parser.implementation Lexer.token lexbuf)) + (OCaml_parser.implementation Lexer.token lexbuf)) lexbuf let core_type lexbuf = parse_and_filter_doc_comments - (fun it -> it.Ast_mapper.typ it) + (fun it ty -> it#core_type ty) (fun lexbuf -> From_current.copy_core_type - (Parser.parse_core_type Lexer.token lexbuf)) + (OCaml_parser.parse_core_type Lexer.token lexbuf)) lexbuf let interface lexbuf = parse_and_filter_doc_comments - (fun it -> it.Ast_mapper.signature it) + (fun it sig_ -> it#signature sig_) (fun lexbuf -> From_current.copy_signature - (Parser.interface Lexer.token lexbuf)) + (OCaml_parser.interface Lexer.token lexbuf)) lexbuf let filter_toplevel_phrase it = function - | Parsetree.Ptop_def str -> ignore (it.Ast_mapper.structure it str) + | Parsetree.Ptop_def str -> ignore (it#structure str) | Parsetree.Ptop_dir _ -> () let toplevel_phrase lexbuf = parse_and_filter_doc_comments filter_toplevel_phrase (fun lexbuf -> From_current.copy_toplevel_phrase - (Parser.toplevel_phrase Lexer.token lexbuf)) + (OCaml_parser.toplevel_phrase Lexer.token lexbuf)) lexbuf let use_file lexbuf = @@ -85,7 +89,7 @@ let use_file lexbuf = (fun lexbuf -> List.map From_current.copy_toplevel_phrase - (Parser.use_file Lexer.token lexbuf)) + (OCaml_parser.use_file Lexer.token lexbuf)) lexbuf (* Skip tokens to the end of the phrase *) @@ -109,6 +113,8 @@ let maybe_skip_phrase lexbuf = then () else skip_phrase lexbuf +module Location = Ocaml_common.Location + let safeguard_parsing lexbuf fn = try fn () with @@ -132,15 +138,16 @@ let safeguard_parsing lexbuf fn = (* Unfortunately we drop the comments because there doesn't exist an ML * printer that formats comments *and* line wrapping! (yet) *) let format_interface_with_comments (signature, _) formatter = - Pprintast.signature formatter + Ocaml_common.Pprintast.signature formatter (To_current.copy_signature signature) + let format_implementation_with_comments (structure, _) formatter = let structure = - Reason_syntax_util.(apply_mapper_to_structure - structure - (backport_letopt_mapper remove_stylistic_attrs_mapper)) + structure + |> Reason_syntax_util.(apply_mapper_to_structure backport_letopt_mapper) + |> Reason_syntax_util.(apply_mapper_to_structure remove_stylistic_attrs_mapper) in - Pprintast.structure formatter + Ocaml_common.Pprintast.structure formatter (To_current.copy_structure structure) module Lexer = Lexer_impl diff --git a/src/reason-parser/reason_toolchain_reason.ml b/src/reason-parser/reason_toolchain_reason.ml index 1a6c4dcf2..ca4623fd1 100644 --- a/src/reason-parser/reason_toolchain_reason.ml +++ b/src/reason-parser/reason_toolchain_reason.ml @@ -1,4 +1,3 @@ -open Reason_toolchain_conf open Reason_errors module P = Reason_recover_parser diff --git a/src/refmt/printer_maker.ml b/src/refmt/printer_maker.ml index b7eb108f5..b938cb482 100644 --- a/src/refmt/printer_maker.ml +++ b/src/refmt/printer_maker.ml @@ -1,5 +1,3 @@ -open Reason_omp - type parse_itype = [ `ML | `Reason | `Binary | `BinaryReason | `Auto ] type print_itype = [ `ML | `Reason | `Binary | `BinaryReason | `AST | `None ] @@ -36,22 +34,16 @@ let close_output_file output_file output_chan = | None -> () let ocamlBinaryParser use_stdin filename = - let chan = + let module Ast_io = Ppxlib__.Utils.Ast_io in + let input_source = match use_stdin with - | true -> stdin - | false -> - let file_chan = open_in_bin filename in - seek_in file_chan 0; - file_chan + | true -> Ast_io.Stdin + | false -> File filename in - match Ast_io.from_channel chan with + match Ast_io.read input_source ~input_kind:Necessarily_binary with | Error _ -> assert false - | Ok (_, Ast_io.Impl ((module Version), ast)) -> - let module Convert = Convert(Version)(OCaml_411) in - ((Obj.magic (Convert.copy_structure ast), []), true, false) - | Ok (_, Ast_io.Intf ((module Version), ast)) -> - let module Convert = Convert(Version)(OCaml_411) in - ((Obj.magic (Convert.copy_signature ast), []), true, true) + | Ok ({ ast = Impl ast; _ }) -> ((Obj.magic ast, []), true, false) + | Ok ({ ast = Intf ast; _ }) -> ((Obj.magic ast, []), true, true) let reasonBinaryParser use_stdin filename = let chan = diff --git a/src/refmt/reason_implementation_printer.ml b/src/refmt/reason_implementation_printer.ml index 8f49f8a07..11b0e6b6d 100644 --- a/src/refmt/reason_implementation_printer.ml +++ b/src/refmt/reason_implementation_printer.ml @@ -1,5 +1,4 @@ -open Reason_omp -open Ast_411 +open Ppxlib type t = Parsetree.structure let err = Printer_maker.err @@ -46,18 +45,24 @@ let print printtype filename parsedAsML output_chan output_formatter = * interface file. *) output_value output_chan ( - Config.ast_impl_magic_number, filename, ast, comments, parsedAsML, false + Ocaml_common.Config.ast_impl_magic_number, filename, ast, comments, parsedAsML, false ); ) | `Binary -> fun (ast, _) -> let ast = - Reason_syntax_util.(apply_mapper_to_structure ast (backport_letopt_mapper remove_stylistic_attrs_mapper)) + ast + |> Reason_syntax_util.(apply_mapper_to_structure remove_stylistic_attrs_mapper) + |> Reason_syntax_util.(apply_mapper_to_structure backport_letopt_mapper) in - Ast_io.to_channel output_chan filename - (Ast_io.Impl ((module OCaml_current), - Reason_toolchain.To_current.copy_structure ast)) + Ppxlib__.Utils.Ast_io.write + output_chan + { Ppxlib__.Utils.Ast_io.input_name = filename; + input_version = Obj.magic (module Ppxlib_ast.Compiler_version: Ppxlib_ast.OCaml_version); + ast = Impl ast + } + ~add_ppx_context:false | `AST -> fun (ast, _) -> ( - Printast.implementation output_formatter + Ocaml_common.Printast.implementation output_formatter (Reason_toolchain.To_current.copy_structure ast) ) | `None -> (fun _ -> ()) diff --git a/src/refmt/reason_interface_printer.ml b/src/refmt/reason_interface_printer.ml index bcd2c5078..8aaf9b2ea 100644 --- a/src/refmt/reason_interface_printer.ml +++ b/src/refmt/reason_interface_printer.ml @@ -1,5 +1,4 @@ -open Reason_omp -open Ast_411 +open Ppxlib type t = Parsetree.signature let err = Printer_maker.err @@ -45,19 +44,25 @@ let print printtype filename parsedAsML output_chan output_formatter = * interface file. *) output_value output_chan ( - Config.ast_intf_magic_number, filename, ast, comments, parsedAsML, true + Ocaml_common.Config.ast_intf_magic_number, filename, ast, comments, parsedAsML, true ); ) | `Binary -> fun (ast, _) -> ( let ast = - Reason_syntax_util.(apply_mapper_to_signature ast (backport_letopt_mapper remove_stylistic_attrs_mapper)) + ast + |> Reason_syntax_util.(apply_mapper_to_signature remove_stylistic_attrs_mapper) + |> Reason_syntax_util.(apply_mapper_to_signature backport_letopt_mapper) in - Ast_io.to_channel output_chan filename - (Ast_io.Intf ((module OCaml_current), - Reason_toolchain.To_current.copy_signature ast)) + Ppxlib__.Utils.Ast_io.write + output_chan + { Ppxlib__.Utils.Ast_io.input_name = filename; + input_version = Obj.magic (module Ppxlib_ast.Compiler_version: Ppxlib_ast.OCaml_version); + ast = Intf ast + } + ~add_ppx_context:false ) | `AST -> fun (ast, _) -> ( - Printast.interface output_formatter + Ocaml_common.Printast.interface output_formatter (Reason_toolchain.To_current.copy_signature ast) ) | `None -> (fun _ -> ()) diff --git a/src/vendored-omp/src/ast_402.ml b/src/vendored-omp/src/ast_402.ml index 036cdf05a..ae0c43311 100644 --- a/src/vendored-omp/src/ast_402.ml +++ b/src/vendored-omp/src/ast_402.ml @@ -60,2572 +60,6 @@ module Asttypes = struct | Invariant end -module Parsetree = struct - (** Abstract syntax tree produced by parsing *) - - open Asttypes - - (** {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 - | 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 label * core_type * core_type - (* T1 -> 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 *) @@ -2742,110 +176,3 @@ module Outcometree = struct | 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-omp/src/ast_403.ml b/src/vendored-omp/src/ast_403.ml index 800c36187..f2f6f859a 100644 --- a/src/vendored-omp/src/ast_403.ml +++ b/src/vendored-omp/src/ast_403.ml @@ -66,2654 +66,6 @@ module Asttypes = struct | 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 *) @@ -2841,110 +193,3 @@ module Outcometree = struct | 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-omp/src/ast_404.ml b/src/vendored-omp/src/ast_404.ml index 21874d11b..a47445820 100644 --- a/src/vendored-omp/src/ast_404.ml +++ b/src/vendored-omp/src/ast_404.ml @@ -66,2671 +66,6 @@ module Asttypes = struct | 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 *) @@ -2859,110 +194,3 @@ module Outcometree = struct | 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-omp/src/ast_405.ml b/src/vendored-omp/src/ast_405.ml index de350f163..e69c7faec 100644 --- a/src/vendored-omp/src/ast_405.ml +++ b/src/vendored-omp/src/ast_405.ml @@ -66,2744 +66,6 @@ module Asttypes = struct | 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 *) @@ -2933,109 +195,3 @@ module Outcometree = struct 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-omp/src/ast_406.ml b/src/vendored-omp/src/ast_406.ml index 245808474..c95805f92 100644 --- a/src/vendored-omp/src/ast_406.ml +++ b/src/vendored-omp/src/ast_406.ml @@ -75,2773 +75,6 @@ module Asttypes = struct | 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 *) @@ -2974,110 +207,3 @@ module Outcometree = struct | 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-omp/src/ast_407.ml b/src/vendored-omp/src/ast_407.ml index d906f7acc..56be09531 100644 --- a/src/vendored-omp/src/ast_407.ml +++ b/src/vendored-omp/src/ast_407.ml @@ -76,2788 +76,6 @@ module Asttypes = struct | 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 *) @@ -2990,110 +208,3 @@ module Outcometree = struct | 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-omp/src/ast_408.ml b/src/vendored-omp/src/ast_408.ml index 97ed6ce09..511d1823b 100644 --- a/src/vendored-omp/src/ast_408.ml +++ b/src/vendored-omp/src/ast_408.ml @@ -28,3877 +28,53 @@ 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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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. *) +module Location = Location +module Longident = Longident - 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. *) +module Asttypes = struct - include Locations.Helpers_intf + 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 - (** {1 Helper functions to call external mappers} *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - 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. *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - (** {1 Cookies} *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (** 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). *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option -end = struct - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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 ()); - 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) - | "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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | Invariant - let register_function = ref (fun _name f -> run_main f) - let register name f = !register_function name f end module Outcometree = struct @@ -4037,117 +213,3 @@ module Outcometree = struct | 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-omp/src/ast_409.ml b/src/vendored-omp/src/ast_409.ml index ab43e0d97..e60576b3d 100644 --- a/src/vendored-omp/src/ast_409.ml +++ b/src/vendored-omp/src/ast_409.ml @@ -17,3877 +17,53 @@ (* *) (**************************************************************************) -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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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. *) +module Location = Location +module Longident = Longident - 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. *) +module Asttypes = struct - include Locations.Helpers_intf + 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 - (** {1 Helper functions to call external mappers} *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - 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. *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - (** {1 Cookies} *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (** 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). *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option -end = struct - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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 ()); - 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) - | "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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | Invariant - let register_function = ref (fun _name f -> run_main f) - let register name f = !register_function name f end module Outcometree = struct @@ -4025,118 +201,3 @@ module Outcometree = struct | 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-omp/src/ast_410.ml b/src/vendored-omp/src/ast_410.ml index 749b14aa5..f74e922c8 100644 --- a/src/vendored-omp/src/ast_410.ml +++ b/src/vendored-omp/src/ast_410.ml @@ -17,3891 +17,53 @@ (* *) (**************************************************************************) -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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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. *) +module Location = Location +module Longident = Longident - 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. *) +[@@@warning "-9"] - include Locations.Helpers_intf +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 - (** {1 Helper functions to call external mappers} *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - 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. *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - (** {1 Cookies} *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (** 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). *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option -end = struct - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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 ()); - 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) - | "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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | Invariant end module Type_immediacy = struct @@ -4046,118 +208,3 @@ module Outcometree = struct | 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-omp/src/ast_411.ml b/src/vendored-omp/src/ast_411.ml index 4904f42d0..979ca2c36 100644 --- a/src/vendored-omp/src/ast_411.ml +++ b/src/vendored-omp/src/ast_411.ml @@ -17,3908 +17,53 @@ (* *) (**************************************************************************) -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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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. *) +module Location = Location +module Longident = Longident - 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. *) +[@@@warning "-9"] - include Locations.Helpers_intf +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 - (** {1 Helper functions to call external mappers} *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - 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. *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - (** {1 Cookies} *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (** 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). *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option -end = struct - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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 ()); - 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) - | "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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | Invariant end module Type_immediacy = struct @@ -4063,120 +208,3 @@ module Outcometree = struct | 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-omp/src/ast_412.ml b/src/vendored-omp/src/ast_412.ml index 2be503080..666ba3985 100644 --- a/src/vendored-omp/src/ast_412.ml +++ b/src/vendored-omp/src/ast_412.ml @@ -17,3924 +17,53 @@ (* *) (**************************************************************************) -open Ast_409_helper - -module Asttypes = struct - type constant (*IF_CURRENT = Asttypes.constant *) = - Const_int of int - | Const_char of char - | Const_string of string * Location.t * string option - | Const_float of string - | Const_int32 of int32 - | Const_int64 of int64 - | Const_nativeint of nativeint - - type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - - type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - - (* Order matters, used in polymorphic comparison *) - type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - - type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - - type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - - type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - - type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - - type label = string - - type arg_label (*IF_CURRENT = Asttypes.arg_label *) = - Nolabel - | Labelled of string (* label:T -> ... *) - | Optional of string (* ?label:T -> ... *) - - type 'a loc = 'a Location.loc = { - txt : 'a; - loc : Location.t; - } - - type variance (*IF_CURRENT = Asttypes.variance *) = - | Covariant - | Contravariant - | NoVariance - - type injectivity (*IF_CURRENT = Asttypes.injectivity *) = - | Injective - | NoInjectivity -end - -module Parsetree = struct - open Asttypes - - type constant (*IF_CURRENT = Parsetree.constant *) = - Pconst_integer of string * char option - (* 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 * injectivity)) 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 * injectivity)) 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 * injectivity)) 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 -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Leo White *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -open Location - -(* 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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = doc_loc; - attr_payload = PStr [item]; - attr_loc = loc } - -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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = text_loc; - attr_payload = PStr [item]; - attr_loc = loc } - -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 * injectivity)) 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 * injectivity)) 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 * injectivity)) 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 (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 ?(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; - } +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 -end + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive -(** 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; - } + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) - constructor = - { - ptyexn_constructor = constructor; - ptyexn_loc = loc; - ptyexn_attributes = add_docs_attrs docs attrs; - } + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - 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); - } + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - 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); - } + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - 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); - } + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh -end + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open -module Csig = struct - let mk self fields = - { - pcsig_self = self; - pcsig_fields = fields; - } -end + type label = string -module Cstr = struct - let mk self fields = - { - pcstr_self = self; - pcstr_fields = fields; - } -end + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) -(** Row fields *) -module Rf = struct - let mk ?(loc = !default_loc) ?(attrs = []) desc = { - prf_desc = desc; - prf_loc = loc; - prf_attributes = attrs; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity 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: 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. *) - -(** {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.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)))])) - - 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 ()); - 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) - | "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 @@ -4079,120 +208,3 @@ module Outcometree = struct | 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 = "Caml1999M029" - let ast_intf_magic_number = "Caml1999N029" -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-omp/src/ast_413.ml b/src/vendored-omp/src/ast_413.ml index 212efd026..ed2026ff9 100644 --- a/src/vendored-omp/src/ast_413.ml +++ b/src/vendored-omp/src/ast_413.ml @@ -17,3952 +17,51 @@ (* *) (**************************************************************************) -open Ast_409_helper - -module Asttypes = struct - type constant (*IF_CURRENT = Asttypes.constant *) = - Const_int of int - | Const_char of char - | Const_string of string * Location.t * string option - | Const_float of string - | Const_int32 of int32 - | Const_int64 of int64 - | Const_nativeint of nativeint - - type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - - type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - - (* Order matters, used in polymorphic comparison *) - type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - - type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - - type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - - type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - - type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - - type label = string - - type arg_label (*IF_CURRENT = Asttypes.arg_label *) = - Nolabel - | Labelled of string (* label:T -> ... *) - | Optional of string (* ?label:T -> ... *) - - type 'a loc = 'a Location.loc = { - txt : 'a; - loc : Location.t; - } - - type variance (*IF_CURRENT = Asttypes.variance *) = - | Covariant - | Contravariant - | NoVariance - - type injectivity (*IF_CURRENT = Asttypes.injectivity *) = - | Injective - | NoInjectivity -end - -module Parsetree = struct - open Asttypes - - type constant (*IF_CURRENT = Parsetree.constant *) = - Pconst_integer of string * char option - (* 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 * (string loc list * pattern) option - (* C None - C P Some ([], P) - C (P1, ..., Pn) Some ([], Ppat_tuple [P1; ...; Pn]) - C (type a b) P Some ([a; b], P) - *) - | 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 * injectivity)) 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 * injectivity)) 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 * injectivity)) 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_modtypesubst of module_type_declaration - (* module type S := ... *) - | Psig_open of open_description - (* open X *) - | Psig_include of include_description - (* include MT *) - | Psig_class of class_description list - (* class c1 : ... and ... and cn : ... *) - | Psig_class_type of class_type_declaration list - (* class type ct1 = ... and ... and ctn = ... *) - | Psig_attribute of attribute - (* [@@@id] *) - | Psig_extension of extension * attributes - (* [%%id] *) - - and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = - { - pmd_name: string option loc; - pmd_type: module_type; - pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) - pmd_loc: Location.t; - } - (* 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_modtype of Longident.t loc * module_type - (* with module type X.Y = Z *) - | Pwith_modtypesubst of Longident.t loc * module_type - (* with module type X.Y := sig end *) - | Pwith_typesubst of Longident.t loc * type_declaration - (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_modsubst of Longident.t loc * Longident.t loc - (* with module X.Y := Z *) - - (* 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 - -(** Documentation comments - - {b Warning:} this module is unstable and part of - {{!Compiler_libs}compiler-libs}. - -*) - -(** (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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = doc_loc; - attr_payload = PStr [item]; - attr_loc = loc } - -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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = text_loc; - attr_payload = PStr [item]; - attr_loc = loc } - -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 - -(** Helpers to produce Parsetree fragments - - {b Warning} This module is unstable and part of - {{!Compiler_libs}compiler-libs}. - -*) - -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 -> (str list * 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 * injectivity)) 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 * injectivity)) 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 modtype_subst: ?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 * injectivity)) 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 -(** Helpers to produce Parsetree fragments *) - -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 (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 ?(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 modtype_subst ?loc a = mk ?loc (Psig_modtypesubst 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: 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. *) - -(** {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 - -(* A generic Parsetree mapping class *) - -(* -[@@@ocaml.warning "+9"] - (* Ensure that record patterns don't miss any field. *) -*) - -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_modtype (lid, mty) -> - Pwith_modtype (map_loc sub lid, sub.module_type sub mty) - | 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) - | Pwith_modtypesubst (lid, mty) -> - Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty) - - 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_modtypesubst x -> - modtype_subst ~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 (sub.constant sub c1) (sub.constant sub 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 - (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p) - 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) - ); +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 - 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) - ); + 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 - 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) - ); + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - 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) - ); + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - 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; - } - ); + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open + type label = string - location = (fun _this l -> l); + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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) - ); + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } -let extension_of_error error = - 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)))])) - -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 ()); - 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) - | "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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity end module Type_immediacy = struct @@ -4110,121 +209,3 @@ and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Ophr_exception of (exn * out_value) end - -module Config = struct - let ast_impl_magic_number = "Caml1999M030" - let ast_intf_magic_number = "Caml1999N030" -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-omp/src/ast_414.ml b/src/vendored-omp/src/ast_414.ml index dd5095164..02aff7c32 100644 --- a/src/vendored-omp/src/ast_414.ml +++ b/src/vendored-omp/src/ast_414.ml @@ -17,4009 +17,60 @@ (* *) (**************************************************************************) -open Ast_409_helper - -module Asttypes = struct - type constant (*IF_CURRENT = Asttypes.constant *) = - Const_int of int - | Const_char of char - | Const_string of string * Location.t * string option - | Const_float of string - | Const_int32 of int32 - | Const_int64 of int64 - | Const_nativeint of nativeint - - type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - - type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - - (* Order matters, used in polymorphic comparison *) - type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - - type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - - type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - - type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - - type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - - type label = string - - type arg_label (*IF_CURRENT = Asttypes.arg_label *) = - Nolabel - | Labelled of string (* label:T -> ... *) - | Optional of string (* ?label:T -> ... *) - - type 'a loc = 'a Location.loc = { - txt : 'a; - loc : Location.t; - } - - type variance (*IF_CURRENT = Asttypes.variance *) = - | Covariant - | Contravariant - | NoVariance - - type injectivity (*IF_CURRENT = Asttypes.injectivity *) = - | Injective - | NoInjectivity -end - -module Parsetree = struct - open Asttypes - - type constant (*IF_CURRENT = Parsetree.constant *) = - Pconst_integer of string * char option - (* 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. - - - As the pval_type field of a value_description. - *) - - | Ptyp_package of package_type - (* (module S) *) - | Ptyp_extension of extension - (* [%id] *) - - and package_type = Longident.t loc * (Longident.t loc * core_type) list - (* - (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 * (string loc list * pattern) option - (* C None - C P Some ([], P) - C (P1, ..., Pn) Some ([], Ppat_tuple [P1; ...; Pn]) - C (type a b) P Some ([a; b], P) - *) - | 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 * injectivity)) 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_vars: string loc list; - pcd_args: constructor_arguments; - pcd_res: core_type option; - pcd_loc: Location.t; - pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) - } - - and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = - | Pcstr_tuple of core_type list - | Pcstr_record of label_declaration list - -(* - | 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 * injectivity)) 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 string loc list * constructor_arguments * core_type option - (* - | C of T1 * ... * Tn ([], [T1; ...; Tn], None) - | C: T0 ([], [], Some T0) - | C: T1 * ... * Tn -> T0 ([], [T1; ...; Tn], Some T0) - | C: 'a... . T1... -> T0 (['a;...]; [T1;...], 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 * injectivity)) 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_modtypesubst of module_type_declaration - (* module type S := ... *) - | Psig_open of open_description - (* open X *) - | Psig_include of include_description - (* include MT *) - | Psig_class of class_description list - (* class c1 : ... and ... and cn : ... *) - | Psig_class_type of class_type_declaration list - (* class type ct1 = ... and ... and ctn = ... *) - | Psig_attribute of attribute - (* [@@@id] *) - | Psig_extension of extension * attributes - (* [%%id] *) - - and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = - { - pmd_name: string option loc; - pmd_type: module_type; - pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) - pmd_loc: Location.t; - } - (* 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_modtype of Longident.t loc * module_type - (* with module type X.Y = Z *) - | Pwith_modtypesubst of Longident.t loc * module_type - (* with module type X.Y := sig end *) - | Pwith_typesubst of Longident.t loc * type_declaration - (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_modsubst of Longident.t loc * Longident.t loc - (* with module X.Y := Z *) - - (* 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 - (** Documentation comments - - {b Warning:} this module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - (** (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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true)) - (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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = doc_loc; - attr_payload = PStr [item]; - attr_loc = loc } - - 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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = text_loc; - attr_payload = PStr [item]; - attr_loc = loc } - - 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 - (** Helpers to produce Parsetree fragments - - {b Warning} This module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - 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 -> (str list * 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 * injectivity)) 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 -> - ?vars:str list -> ?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 * injectivity)) 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 -> - ?vars:str list -> ?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 modtype_subst: ?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 * injectivity)) 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 - (** Helpers to produce Parsetree fragments *) - - 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 (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 ?(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 modtype_subst ?loc a = mk ?loc (Psig_modtypesubst 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) - ?(vars = []) ?(args = Pcstr_tuple []) ?res name = - { - pcd_name = name; - pcd_vars = vars; - 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) ?(vars = []) ?(args = Pcstr_tuple []) ?res name = - { - pext_name = name; - pext_kind = Pext_decl(vars, 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 - (** 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} enables 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]. - - {b Warning:} this module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - 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: 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. *) - - (** {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. *) +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 - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - (** {1 Cookies} *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - (** 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). *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option - end = struct - (* A generic Parsetree mapping class *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (* - [@@@ocaml.warning "+9"] - (* Ensure that record patterns don't miss any field. *) - *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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(vars, ctl, cto) -> - Pext_decl(List.map (map_loc sub) vars, - 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_modtype (lid, mty) -> - Pwith_modtype (map_loc sub lid, sub.module_type sub mty) - | 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) - | Pwith_modtypesubst (lid, mty) -> - Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty) - - 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_modtypesubst x -> - modtype_subst ~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 (sub.constant sub c1) (sub.constant sub 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 - (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p) - 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_vars; pcd_args; - pcd_res; pcd_loc; pcd_attributes} -> - Type.constructor - (map_loc this pcd_name) - ~vars:(List.map (map_loc this) pcd_vars) - ~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.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)))])) - - 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 ()); - 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) - | "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 extension_of_exn exn = *) - (* match error_of_exn exn with *) - (* | Some (`Ok error) -> extension_of_error error *) - (* | Some `Already_displayed -> *) - (* { loc = Location.none; txt = "ocaml.error" }, PStr [] *) - (* | None -> raise 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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance - let register_function = ref (fun _name f -> run_main f) - let register name f = !register_function name f + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity 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 *) @@ -4163,121 +214,3 @@ module Outcometree = struct | 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 = "Caml1999M031" - let ast_intf_magic_number = "Caml1999N031" -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-omp/src/ast_500.ml b/src/vendored-omp/src/ast_500.ml index 314246bc9..02aff7c32 100644 --- a/src/vendored-omp/src/ast_500.ml +++ b/src/vendored-omp/src/ast_500.ml @@ -17,4009 +17,60 @@ (* *) (**************************************************************************) -open Ast_409_helper - -module Asttypes = struct - type constant (*IF_CURRENT = Asttypes.constant *) = - Const_int of int - | Const_char of char - | Const_string of string * Location.t * string option - | Const_float of string - | Const_int32 of int32 - | Const_int64 of int64 - | Const_nativeint of nativeint - - type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - - type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - - (* Order matters, used in polymorphic comparison *) - type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - - type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - - type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - - type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - - type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - - type label = string - - type arg_label (*IF_CURRENT = Asttypes.arg_label *) = - Nolabel - | Labelled of string (* label:T -> ... *) - | Optional of string (* ?label:T -> ... *) - - type 'a loc = 'a Location.loc = { - txt : 'a; - loc : Location.t; - } - - type variance (*IF_CURRENT = Asttypes.variance *) = - | Covariant - | Contravariant - | NoVariance - - type injectivity (*IF_CURRENT = Asttypes.injectivity *) = - | Injective - | NoInjectivity -end - -module Parsetree = struct - open Asttypes - - type constant (*IF_CURRENT = Parsetree.constant *) = - Pconst_integer of string * char option - (* 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. - - - As the pval_type field of a value_description. - *) - - | Ptyp_package of package_type - (* (module S) *) - | Ptyp_extension of extension - (* [%id] *) - - and package_type = Longident.t loc * (Longident.t loc * core_type) list - (* - (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 * (string loc list * pattern) option - (* C None - C P Some ([], P) - C (P1, ..., Pn) Some ([], Ppat_tuple [P1; ...; Pn]) - C (type a b) P Some ([a; b], P) - *) - | 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 * injectivity)) 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_vars: string loc list; - pcd_args: constructor_arguments; - pcd_res: core_type option; - pcd_loc: Location.t; - pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) - } - - and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = - | Pcstr_tuple of core_type list - | Pcstr_record of label_declaration list - -(* - | 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 * injectivity)) 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 string loc list * constructor_arguments * core_type option - (* - | C of T1 * ... * Tn ([], [T1; ...; Tn], None) - | C: T0 ([], [], Some T0) - | C: T1 * ... * Tn -> T0 ([], [T1; ...; Tn], Some T0) - | C: 'a... . T1... -> T0 (['a;...]; [T1;...], 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 * injectivity)) 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_modtypesubst of module_type_declaration - (* module type S := ... *) - | Psig_open of open_description - (* open X *) - | Psig_include of include_description - (* include MT *) - | Psig_class of class_description list - (* class c1 : ... and ... and cn : ... *) - | Psig_class_type of class_type_declaration list - (* class type ct1 = ... and ... and ctn = ... *) - | Psig_attribute of attribute - (* [@@@id] *) - | Psig_extension of extension * attributes - (* [%%id] *) - - and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = - { - pmd_name: string option loc; - pmd_type: module_type; - pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) - pmd_loc: Location.t; - } - (* 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_modtype of Longident.t loc * module_type - (* with module type X.Y = Z *) - | Pwith_modtypesubst of Longident.t loc * module_type - (* with module type X.Y := sig end *) - | Pwith_typesubst of Longident.t loc * type_declaration - (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_modsubst of Longident.t loc * Longident.t loc - (* with module X.Y := Z *) - - (* 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 - (** Documentation comments - - {b Warning:} this module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - (** (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 (Migrate_parsetree_compiler_functions.bad_docstring true) then begin - List.iter - (fun ds -> - match ds.ds_attached with - | Info -> () - | Unattached -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true) - | Docs -> - match ds.ds_associated with - | Zero | One -> () - | Many -> - prerr_warning ds.ds_loc (Migrate_parsetree_compiler_functions.bad_docstring true)) - (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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = doc_loc; - attr_payload = PStr [item]; - attr_loc = loc } - - 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 body = ds.ds_body in - let loc = ds.ds_loc in - let exp = - { pexp_desc = Pexp_constant (Pconst_string(body, loc, None)); - pexp_loc = loc; - pexp_loc_stack = []; - pexp_attributes = []; } - in - let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = loc } - in - { attr_name = text_loc; - attr_payload = PStr [item]; - attr_loc = loc } - - 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 - (** Helpers to produce Parsetree fragments - - {b Warning} This module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - 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 -> (str list * 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 * injectivity)) 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 -> - ?vars:str list -> ?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 * injectivity)) 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 -> - ?vars:str list -> ?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 modtype_subst: ?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 * injectivity)) 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 - (** Helpers to produce Parsetree fragments *) - - 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 (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 ?(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 modtype_subst ?loc a = mk ?loc (Psig_modtypesubst 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) - ?(vars = []) ?(args = Pcstr_tuple []) ?res name = - { - pcd_name = name; - pcd_vars = vars; - 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) ?(vars = []) ?(args = Pcstr_tuple []) ?res name = - { - pext_name = name; - pext_kind = Pext_decl(vars, 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 - (** 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} enables 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]. - - {b Warning:} this module is unstable and part of - {{!Compiler_libs}compiler-libs}. - - *) - - 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: 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. *) - - (** {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. *) +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 - val add_ppx_context_sig: - tool_name:string -> Parsetree.signature -> Parsetree.signature - (** Same as [add_ppx_context_str], but for signatures. *) + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive - 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. *) + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto - val drop_ppx_context_sig: - restore:bool -> Parsetree.signature -> Parsetree.signature - (** Same as [drop_ppx_context_str], but for signatures. *) + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public - (** {1 Cookies} *) + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable - (** 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). *) + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete - val set_cookie: string -> Parsetree.expression -> unit - val get_cookie: string -> Parsetree.expression option - end = struct - (* A generic Parsetree mapping class *) + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh - (* - [@@@ocaml.warning "+9"] - (* Ensure that record patterns don't miss any field. *) - *) + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open - open Parsetree - open Ast_helper - open Location + type label = string - module String = Misc.Stdlib.String + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (* label:T -> ... *) + | Optional of string (* ?label:T -> ... *) - 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; + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; } - 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(vars, ctl, cto) -> - Pext_decl(List.map (map_loc sub) vars, - 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_modtype (lid, mty) -> - Pwith_modtype (map_loc sub lid, sub.module_type sub mty) - | 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) - | Pwith_modtypesubst (lid, mty) -> - Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty) - - 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_modtypesubst x -> - modtype_subst ~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 (sub.constant sub c1) (sub.constant sub 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 - (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p) - 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_vars; pcd_args; - pcd_res; pcd_loc; pcd_attributes} -> - Type.constructor - (map_loc this pcd_name) - ~vars:(List.map (map_loc this) pcd_vars) - ~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.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)))])) - - 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 ()); - 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) - | "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 extension_of_exn exn = *) - (* match error_of_exn exn with *) - (* | Some (`Ok error) -> extension_of_error error *) - (* | Some `Already_displayed -> *) - (* { loc = Location.none; txt = "ocaml.error" }, PStr [] *) - (* | None -> raise 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 + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance - let register_function = ref (fun _name f -> run_main f) - let register name f = !register_function name f + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity 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 *) @@ -4163,121 +214,3 @@ module Outcometree = struct | 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 = "Caml1999M032" - let ast_intf_magic_number = "Caml1999N032" -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-omp/src/migrate_parsetree_402_403.ml b/src/vendored-omp/src/migrate_parsetree_402_403.ml index b67d68dff..750dc03e0 100644 --- a/src/vendored-omp/src/migrate_parsetree_402_403.ml +++ b/src/vendored-omp/src/migrate_parsetree_402_403.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_402_403_migrate.ml b/src/vendored-omp/src/migrate_parsetree_402_403_migrate.ml index bda5b2f33..f1a84ffc4 100644 --- a/src/vendored-omp/src/migrate_parsetree_402_403_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_402_403_migrate.ml @@ -1,1884 +1,278 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_402.Outcometree.out_type_extension -> + Ast_403.Outcometree.out_type_extension = fun - { From.Parsetree.pexp_desc = pexp_desc; - From.Parsetree.pexp_loc = pexp_loc; - From.Parsetree.pexp_attributes = pexp_attributes } - -> + { Ast_402.Outcometree.otyext_name = otyext_name; + Ast_402.Outcometree.otyext_params = otyext_params; + Ast_402.Outcometree.otyext_constructors = otyext_constructors; + Ast_402.Outcometree.otyext_private = otyext_private } + -> { - 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 + Ast_403.Outcometree.otyext_name = otyext_name; + Ast_403.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_403.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_403.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -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 = +and copy_out_phrase : + Ast_402.Outcometree.out_phrase -> Ast_403.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 + | Ast_402.Outcometree.Ophr_eval (x0, x1) -> + Ast_403.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_402.Outcometree.Ophr_signature x0 -> + Ast_403.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_402.Outcometree.Ophr_exception x0 -> + Ast_403.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_402.Outcometree.out_sig_item -> Ast_403.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_402.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_403.Outcometree.Osig_class + (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, + (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_402.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_403.Outcometree.Osig_class_type + (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) -> + (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_402.Outcometree.Osig_typext (x0, x1) -> + Ast_403.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_402.Outcometree.Osig_modtype (x0, x1) -> + Ast_403.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_402.Outcometree.Osig_module (x0, x1, x2) -> + Ast_403.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_402.Outcometree.Osig_type (x0, x1) -> + Ast_403.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_402.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 = + Ast_402.Outcometree.out_type_decl -> Ast_403.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 } - -> + { Ast_402.Outcometree.otype_name = otype_name; + Ast_402.Outcometree.otype_params = otype_params; + Ast_402.Outcometree.otype_type = otype_type; + Ast_402.Outcometree.otype_private = otype_private; + Ast_402.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_403.Outcometree.otype_name = otype_name; + Ast_403.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_403.Outcometree.otype_type = (copy_out_type otype_type); + Ast_403.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_403.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs); + (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) - + Ast_402.Outcometree.out_module_type -> Ast_403.Outcometree.out_module_type + = + function + | Ast_402.Outcometree.Omty_abstract -> Ast_403.Outcometree.Omty_abstract + | Ast_402.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_403.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_402.Outcometree.Omty_ident x0 -> + Ast_403.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_402.Outcometree.Omty_signature x0 -> + Ast_403.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_402.Outcometree.Omty_alias x0 -> + Ast_403.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_402.Outcometree.out_ext_status -> Ast_403.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 - + | Ast_402.Outcometree.Oext_first -> Ast_403.Outcometree.Oext_first + | Ast_402.Outcometree.Oext_next -> Ast_403.Outcometree.Oext_next + | Ast_402.Outcometree.Oext_exception -> Ast_403.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_402.Outcometree.out_extension_constructor -> + Ast_403.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 } - -> + { Ast_402.Outcometree.oext_name = oext_name; + Ast_402.Outcometree.oext_type_name = oext_type_name; + Ast_402.Outcometree.oext_type_params = oext_type_params; + Ast_402.Outcometree.oext_args = oext_args; + Ast_402.Outcometree.oext_ret_type = oext_ret_type; + Ast_402.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) + Ast_403.Outcometree.oext_name = oext_name; + Ast_403.Outcometree.oext_type_name = oext_type_name; + Ast_403.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_403.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_403.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_403.Outcometree.oext_private = (copy_private_flag oext_private) } - +and copy_private_flag : + Ast_402.Asttypes.private_flag -> Ast_403.Asttypes.private_flag = + function + | Ast_402.Asttypes.Private -> Ast_403.Asttypes.Private + | Ast_402.Asttypes.Public -> Ast_403.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_402.Outcometree.out_rec_status -> Ast_403.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 - + | Ast_402.Outcometree.Orec_not -> Ast_403.Outcometree.Orec_not + | Ast_402.Outcometree.Orec_first -> Ast_403.Outcometree.Orec_first + | Ast_402.Outcometree.Orec_next -> Ast_403.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), + Ast_402.Outcometree.out_class_type -> Ast_403.Outcometree.out_class_type = + function + | Ast_402.Outcometree.Octy_constr (x0, x1) -> + Ast_403.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_402.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_403.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_402.Outcometree.Octy_signature (x0, x1) -> + Ast_403.Outcometree.Octy_signature + ((Option.map 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 + Ast_402.Outcometree.out_class_sig_item -> + Ast_403.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)) - + | Ast_402.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_403.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_402.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_403.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_402.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_403.Outcometree.Ocsg_value (x0, x1, 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 + Ast_402.Outcometree.out_type -> Ast_403.Outcometree.out_type = + function + | Ast_402.Outcometree.Otyp_abstract -> Ast_403.Outcometree.Otyp_abstract + | Ast_402.Outcometree.Otyp_open -> Ast_403.Outcometree.Otyp_open + | Ast_402.Outcometree.Otyp_alias (x0, x1) -> + Ast_403.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_402.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_403.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_402.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_403.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_402.Outcometree.Otyp_constr (x0, x1) -> + Ast_403.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_402.Outcometree.Otyp_manifest (x0, x1) -> + Ast_403.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_402.Outcometree.Otyp_object (x0, x1) -> + Ast_403.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_402.Outcometree.Otyp_record x0 -> + Ast_403.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_402.Outcometree.Otyp_stuff x0 -> Ast_403.Outcometree.Otyp_stuff x0 + | Ast_402.Outcometree.Otyp_sum x0 -> + Ast_403.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_402.Outcometree.Otyp_tuple x0 -> + Ast_403.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_402.Outcometree.Otyp_var (x0, x1) -> + Ast_403.Outcometree.Otyp_var (x0, x1) + | Ast_402.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_403.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_402.Outcometree.Otyp_poly (x0, x1) -> + Ast_403.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_402.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_403.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 = + Ast_402.Outcometree.out_variant -> Ast_403.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_402.Outcometree.Ovar_fields x0 -> + Ast_403.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)) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_402.Outcometree.Ovar_name (x0, x1) -> + Ast_403.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 + Ast_402.Outcometree.out_value -> Ast_403.Outcometree.out_value = + function + | Ast_402.Outcometree.Oval_array x0 -> + Ast_403.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_402.Outcometree.Oval_char x0 -> Ast_403.Outcometree.Oval_char x0 + | Ast_402.Outcometree.Oval_constr (x0, x1) -> + Ast_403.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_402.Outcometree.Oval_ellipsis -> Ast_403.Outcometree.Oval_ellipsis + | Ast_402.Outcometree.Oval_float x0 -> Ast_403.Outcometree.Oval_float x0 + | Ast_402.Outcometree.Oval_int x0 -> Ast_403.Outcometree.Oval_int x0 + | Ast_402.Outcometree.Oval_int32 x0 -> Ast_403.Outcometree.Oval_int32 x0 + | Ast_402.Outcometree.Oval_int64 x0 -> Ast_403.Outcometree.Oval_int64 x0 + | Ast_402.Outcometree.Oval_nativeint x0 -> + Ast_403.Outcometree.Oval_nativeint x0 + | Ast_402.Outcometree.Oval_list x0 -> + Ast_403.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_402.Outcometree.Oval_printer x0 -> + Ast_403.Outcometree.Oval_printer x0 + | Ast_402.Outcometree.Oval_record x0 -> + Ast_403.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_402.Outcometree.Oval_string x0 -> Ast_403.Outcometree.Oval_string x0 + | Ast_402.Outcometree.Oval_stuff x0 -> Ast_403.Outcometree.Oval_stuff x0 + | Ast_402.Outcometree.Oval_tuple x0 -> + Ast_403.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_402.Outcometree.Oval_variant (x0, x1) -> + Ast_403.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_402.Outcometree.out_ident -> Ast_403.Outcometree.out_ident = + function + | Ast_402.Outcometree.Oide_apply (x0, x1) -> + Ast_403.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_402.Outcometree.Oide_dot (x0, x1) -> + Ast_403.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_402.Outcometree.Oide_ident x0 -> Ast_403.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_403_402.ml b/src/vendored-omp/src/migrate_parsetree_403_402.ml index d24b9674a..076613439 100644 --- a/src/vendored-omp/src/migrate_parsetree_403_402.ml +++ b/src/vendored-omp/src/migrate_parsetree_403_402.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_403_402_migrate.ml b/src/vendored-omp/src/migrate_parsetree_403_402_migrate.ml index efdd06aa0..36d8b61cb 100644 --- a/src/vendored-omp/src/migrate_parsetree_403_402_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_403_402_migrate.ml @@ -1,1608 +1,72 @@ -(**************************************************************************) -(* *) -(* 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 +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_403.Outcometree.out_type_extension -> + Ast_402.Outcometree.out_type_extension = fun - { From.Parsetree.pexp_desc = pexp_desc; - From.Parsetree.pexp_loc = pexp_loc; - From.Parsetree.pexp_attributes = pexp_attributes } - -> + { Ast_403.Outcometree.otyext_name = otyext_name; + Ast_403.Outcometree.otyext_params = otyext_params; + Ast_403.Outcometree.otyext_constructors = otyext_constructors; + Ast_403.Outcometree.otyext_private = otyext_private } + -> { - 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 + Ast_402.Outcometree.otyext_name = otyext_name; + Ast_402.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_402.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_402.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -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 = +and copy_out_phrase : + Ast_403.Outcometree.out_phrase -> Ast_402.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 + | Ast_403.Outcometree.Ophr_eval (x0, x1) -> + Ast_402.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_403.Outcometree.Ophr_signature x0 -> + Ast_402.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_403.Outcometree.Ophr_exception x0 -> + Ast_402.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_403.Outcometree.out_sig_item -> Ast_402.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_403.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_402.Outcometree.Osig_class + (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, + (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_403.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_402.Outcometree.Osig_class_type + (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 -> + (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_403.Outcometree.Osig_typext (x0, x1) -> + Ast_402.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_403.Outcometree.Osig_modtype (x0, x1) -> + Ast_402.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_403.Outcometree.Osig_module (x0, x1, x2) -> + Ast_402.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_403.Outcometree.Osig_type (x0, x1) -> + Ast_402.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_403.Outcometree.Osig_value x0 -> (copy_out_val_decl x0) + | Ast_403.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_value ("...", To.Outcometree.Otyp_abstract, []) and copy_out_val_decl : @@ -1619,6 +83,12 @@ and copy_out_val_decl : List.map (fun x -> x) oval_prims ) +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_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun @@ -1635,7 +105,7 @@ and copy_out_type_decl : (List.map (fun x -> let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (x0, (let (x0,x1) = x1 in (x0, x1)))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); @@ -1649,293 +119,190 @@ and copy_out_type_decl : ((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) - + Ast_403.Outcometree.out_module_type -> Ast_402.Outcometree.out_module_type + = + function + | Ast_403.Outcometree.Omty_abstract -> Ast_402.Outcometree.Omty_abstract + | Ast_403.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_402.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_403.Outcometree.Omty_ident x0 -> + Ast_402.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_403.Outcometree.Omty_signature x0 -> + Ast_402.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_403.Outcometree.Omty_alias x0 -> + Ast_402.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_403.Outcometree.out_ext_status -> Ast_402.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 - + | Ast_403.Outcometree.Oext_first -> Ast_402.Outcometree.Oext_first + | Ast_403.Outcometree.Oext_next -> Ast_402.Outcometree.Oext_next + | Ast_403.Outcometree.Oext_exception -> Ast_402.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_403.Outcometree.out_extension_constructor -> + Ast_402.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 } - -> + { Ast_403.Outcometree.oext_name = oext_name; + Ast_403.Outcometree.oext_type_name = oext_type_name; + Ast_403.Outcometree.oext_type_params = oext_type_params; + Ast_403.Outcometree.oext_args = oext_args; + Ast_403.Outcometree.oext_ret_type = oext_ret_type; + Ast_403.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) + Ast_402.Outcometree.oext_name = oext_name; + Ast_402.Outcometree.oext_type_name = oext_type_name; + Ast_402.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_402.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_402.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_402.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_403.Asttypes.private_flag -> Ast_402.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_403.Asttypes.Private -> Ast_402.Asttypes.Private + | Ast_403.Asttypes.Public -> Ast_402.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_403.Outcometree.out_rec_status -> Ast_402.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 - + | Ast_403.Outcometree.Orec_not -> Ast_402.Outcometree.Orec_not + | Ast_403.Outcometree.Orec_first -> Ast_402.Outcometree.Orec_first + | Ast_403.Outcometree.Orec_next -> Ast_402.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), + Ast_403.Outcometree.out_class_type -> Ast_402.Outcometree.out_class_type = + function + | Ast_403.Outcometree.Octy_constr (x0, x1) -> + Ast_402.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_403.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_402.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_403.Outcometree.Octy_signature (x0, x1) -> + Ast_402.Outcometree.Octy_signature + ((Option.map 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 + Ast_403.Outcometree.out_class_sig_item -> + Ast_402.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)) - + | Ast_403.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_402.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_403.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_402.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_403.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_402.Outcometree.Ocsg_value (x0, x1, 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 + Ast_403.Outcometree.out_type -> Ast_402.Outcometree.out_type = + function + | Ast_403.Outcometree.Otyp_abstract -> Ast_402.Outcometree.Otyp_abstract + | Ast_403.Outcometree.Otyp_open -> Ast_402.Outcometree.Otyp_open + | Ast_403.Outcometree.Otyp_alias (x0, x1) -> + Ast_402.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_403.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_402.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_403.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_402.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_403.Outcometree.Otyp_constr (x0, x1) -> + Ast_402.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_403.Outcometree.Otyp_manifest (x0, x1) -> + Ast_402.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_403.Outcometree.Otyp_object (x0, x1) -> + Ast_402.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_403.Outcometree.Otyp_record x0 -> + Ast_402.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_403.Outcometree.Otyp_stuff x0 -> Ast_402.Outcometree.Otyp_stuff x0 + | Ast_403.Outcometree.Otyp_sum x0 -> + Ast_402.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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 }*) - + (Option.map copy_out_type x2))) x0) + | Ast_403.Outcometree.Otyp_tuple x0 -> + Ast_402.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_403.Outcometree.Otyp_var (x0, x1) -> + Ast_402.Outcometree.Otyp_var (x0, x1) + | Ast_403.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_402.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_403.Outcometree.Otyp_poly (x0, x1) -> + Ast_402.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_403.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_402.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_403.Outcometree.Otyp_attribute _ -> + Ast_402.Outcometree.Otyp_abstract + (* ((copy_out_type x0), (copy_out_attribute x1)) *) +(* and copy_out_attribute : *) + (* Ast_403.Outcometree.out_attribute -> Ast_402.Outcometree.out_attribute = *) + (* fun { Ast_403.Outcometree.oattr_name = oattr_name } -> *) + (* { Ast_402.Outcometree.oattr_name = oattr_name } *) and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_403.Outcometree.out_variant -> Ast_402.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_403.Outcometree.Ovar_fields x0 -> + Ast_402.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)) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_403.Outcometree.Ovar_name (x0, x1) -> + Ast_402.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 + Ast_403.Outcometree.out_value -> Ast_402.Outcometree.out_value = + function + | Ast_403.Outcometree.Oval_array x0 -> + Ast_402.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_char x0 -> Ast_402.Outcometree.Oval_char x0 + | Ast_403.Outcometree.Oval_constr (x0, x1) -> + Ast_402.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_403.Outcometree.Oval_ellipsis -> Ast_402.Outcometree.Oval_ellipsis + | Ast_403.Outcometree.Oval_float x0 -> Ast_402.Outcometree.Oval_float x0 + | Ast_403.Outcometree.Oval_int x0 -> Ast_402.Outcometree.Oval_int x0 + | Ast_403.Outcometree.Oval_int32 x0 -> Ast_402.Outcometree.Oval_int32 x0 + | Ast_403.Outcometree.Oval_int64 x0 -> Ast_402.Outcometree.Oval_int64 x0 + | Ast_403.Outcometree.Oval_nativeint x0 -> + Ast_402.Outcometree.Oval_nativeint x0 + | Ast_403.Outcometree.Oval_list x0 -> + Ast_402.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_printer x0 -> + Ast_402.Outcometree.Oval_printer x0 + | Ast_403.Outcometree.Oval_record x0 -> + Ast_402.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_403.Outcometree.Oval_string x0 -> Ast_402.Outcometree.Oval_string x0 + | Ast_403.Outcometree.Oval_stuff x0 -> Ast_402.Outcometree.Oval_stuff x0 + | Ast_403.Outcometree.Oval_tuple x0 -> + Ast_402.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_variant (x0, x1) -> + Ast_402.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_403.Outcometree.out_ident -> Ast_402.Outcometree.out_ident = + function + | Ast_403.Outcometree.Oide_apply (x0, x1) -> + Ast_402.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_403.Outcometree.Oide_dot (x0, x1) -> + Ast_402.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_403.Outcometree.Oide_ident x0 -> Ast_402.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_403_404.ml b/src/vendored-omp/src/migrate_parsetree_403_404.ml index 06a5a6831..b03096444 100644 --- a/src/vendored-omp/src/migrate_parsetree_403_404.ml +++ b/src/vendored-omp/src/migrate_parsetree_403_404.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_403_404_migrate.ml b/src/vendored-omp/src/migrate_parsetree_403_404_migrate.ml index 2fa97c316..139259cf1 100644 --- a/src/vendored-omp/src/migrate_parsetree_403_404_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_403_404_migrate.ml @@ -1,1596 +1,95 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 module From = Ast_403 module To = Ast_404 - -let rec copy_expression : - From.Parsetree.expression -> - To.Parsetree.expression +let rec copy_out_type_extension : + Ast_403.Outcometree.out_type_extension -> + Ast_404.Outcometree.out_type_extension = fun - { From.Parsetree.pexp_desc = pexp_desc; - From.Parsetree.pexp_loc = pexp_loc; - From.Parsetree.pexp_attributes = pexp_attributes } - -> + { Ast_403.Outcometree.otyext_name = otyext_name; + Ast_403.Outcometree.otyext_params = otyext_params; + Ast_403.Outcometree.otyext_constructors = otyext_constructors; + Ast_403.Outcometree.otyext_private = otyext_private } + -> { - 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 + Ast_404.Outcometree.otyext_name = otyext_name; + Ast_404.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_404.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_404.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_403.Outcometree.out_phrase -> Ast_404.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 + | Ast_403.Outcometree.Ophr_eval (x0, x1) -> + Ast_404.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_403.Outcometree.Ophr_signature x0 -> + Ast_404.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_403.Outcometree.Ophr_exception x0 -> + Ast_404.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_403.Outcometree.out_sig_item -> Ast_404.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_403.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_404.Outcometree.Osig_class + (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, + (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_403.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_404.Outcometree.Osig_class_type + (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 - + (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_403.Outcometree.Osig_typext (x0, x1) -> + Ast_404.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_403.Outcometree.Osig_modtype (x0, x1) -> + Ast_404.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_403.Outcometree.Osig_module (x0, x1, x2) -> + Ast_404.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_403.Outcometree.Osig_type (x0, x1) -> + Ast_404.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_403.Outcometree.Osig_value x0 -> + Ast_404.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_403.Outcometree.Osig_ellipsis -> Ast_404.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_403.Outcometree.out_val_decl -> Ast_404.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 } - -> + { Ast_403.Outcometree.oval_name = oval_name; + Ast_403.Outcometree.oval_type = oval_type; + Ast_403.Outcometree.oval_prims = oval_prims; + Ast_403.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 = + Ast_404.Outcometree.oval_name = oval_name; + Ast_404.Outcometree.oval_type = (copy_out_type oval_type); + Ast_404.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_404.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } +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_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun @@ -1607,13 +106,13 @@ and copy_out_type_decl : (List.map (fun x -> let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (x0, (let (x0,x1) = x1 in (x0, 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_immediate = otype_immediate; To.Outcometree.otype_unboxed = false; To.Outcometree.otype_cstrs = (List.map @@ -1622,286 +121,190 @@ and copy_out_type_decl : ((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) - + Ast_403.Outcometree.out_module_type -> Ast_404.Outcometree.out_module_type + = + function + | Ast_403.Outcometree.Omty_abstract -> Ast_404.Outcometree.Omty_abstract + | Ast_403.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_404.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_403.Outcometree.Omty_ident x0 -> + Ast_404.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_403.Outcometree.Omty_signature x0 -> + Ast_404.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_403.Outcometree.Omty_alias x0 -> + Ast_404.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_403.Outcometree.out_ext_status -> Ast_404.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 - + | Ast_403.Outcometree.Oext_first -> Ast_404.Outcometree.Oext_first + | Ast_403.Outcometree.Oext_next -> Ast_404.Outcometree.Oext_next + | Ast_403.Outcometree.Oext_exception -> Ast_404.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_403.Outcometree.out_extension_constructor -> + Ast_404.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 } - -> + { Ast_403.Outcometree.oext_name = oext_name; + Ast_403.Outcometree.oext_type_name = oext_type_name; + Ast_403.Outcometree.oext_type_params = oext_type_params; + Ast_403.Outcometree.oext_args = oext_args; + Ast_403.Outcometree.oext_ret_type = oext_ret_type; + Ast_403.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) + Ast_404.Outcometree.oext_name = oext_name; + Ast_404.Outcometree.oext_type_name = oext_type_name; + Ast_404.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_404.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_404.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_404.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_403.Asttypes.private_flag -> Ast_404.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_403.Asttypes.Private -> Ast_404.Asttypes.Private + | Ast_403.Asttypes.Public -> Ast_404.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_403.Outcometree.out_rec_status -> Ast_404.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 - + | Ast_403.Outcometree.Orec_not -> Ast_404.Outcometree.Orec_not + | Ast_403.Outcometree.Orec_first -> Ast_404.Outcometree.Orec_first + | Ast_403.Outcometree.Orec_next -> Ast_404.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), + Ast_403.Outcometree.out_class_type -> Ast_404.Outcometree.out_class_type = + function + | Ast_403.Outcometree.Octy_constr (x0, x1) -> + Ast_404.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_403.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_404.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_403.Outcometree.Octy_signature (x0, x1) -> + Ast_404.Outcometree.Octy_signature + ((Option.map 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 + Ast_403.Outcometree.out_class_sig_item -> + Ast_404.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)) - + | Ast_403.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_404.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_403.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_404.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_403.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_404.Outcometree.Ocsg_value (x0, x1, 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 + Ast_403.Outcometree.out_type -> Ast_404.Outcometree.out_type = + function + | Ast_403.Outcometree.Otyp_abstract -> Ast_404.Outcometree.Otyp_abstract + | Ast_403.Outcometree.Otyp_open -> Ast_404.Outcometree.Otyp_open + | Ast_403.Outcometree.Otyp_alias (x0, x1) -> + Ast_404.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_403.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_403.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_403.Outcometree.Otyp_constr (x0, x1) -> + Ast_404.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_403.Outcometree.Otyp_manifest (x0, x1) -> + Ast_404.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_403.Outcometree.Otyp_object (x0, x1) -> + Ast_404.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_403.Outcometree.Otyp_record x0 -> + Ast_404.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_403.Outcometree.Otyp_stuff x0 -> Ast_404.Outcometree.Otyp_stuff x0 + | Ast_403.Outcometree.Otyp_sum x0 -> + Ast_404.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_403.Outcometree.Otyp_tuple x0 -> + Ast_404.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_403.Outcometree.Otyp_var (x0, x1) -> + Ast_404.Outcometree.Otyp_var (x0, x1) + | Ast_403.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_404.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_403.Outcometree.Otyp_poly (x0, x1) -> + Ast_404.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_403.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_403.Outcometree.Otyp_attribute (x0, x1) -> + Ast_404.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 } - + Ast_403.Outcometree.out_attribute -> Ast_404.Outcometree.out_attribute = + fun { Ast_403.Outcometree.oattr_name = oattr_name } -> + { Ast_404.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_403.Outcometree.out_variant -> Ast_404.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_403.Outcometree.Ovar_fields x0 -> + Ast_404.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)) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_403.Outcometree.Ovar_name (x0, x1) -> + Ast_404.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 + Ast_403.Outcometree.out_value -> Ast_404.Outcometree.out_value = + function + | Ast_403.Outcometree.Oval_array x0 -> + Ast_404.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_char x0 -> Ast_404.Outcometree.Oval_char x0 + | Ast_403.Outcometree.Oval_constr (x0, x1) -> + Ast_404.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_403.Outcometree.Oval_ellipsis -> Ast_404.Outcometree.Oval_ellipsis + | Ast_403.Outcometree.Oval_float x0 -> Ast_404.Outcometree.Oval_float x0 + | Ast_403.Outcometree.Oval_int x0 -> Ast_404.Outcometree.Oval_int x0 + | Ast_403.Outcometree.Oval_int32 x0 -> Ast_404.Outcometree.Oval_int32 x0 + | Ast_403.Outcometree.Oval_int64 x0 -> Ast_404.Outcometree.Oval_int64 x0 + | Ast_403.Outcometree.Oval_nativeint x0 -> + Ast_404.Outcometree.Oval_nativeint x0 + | Ast_403.Outcometree.Oval_list x0 -> + Ast_404.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_printer x0 -> + Ast_404.Outcometree.Oval_printer x0 + | Ast_403.Outcometree.Oval_record x0 -> + Ast_404.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_403.Outcometree.Oval_string x0 -> Ast_404.Outcometree.Oval_string x0 + | Ast_403.Outcometree.Oval_stuff x0 -> Ast_404.Outcometree.Oval_stuff x0 + | Ast_403.Outcometree.Oval_tuple x0 -> + Ast_404.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_403.Outcometree.Oval_variant (x0, x1) -> + Ast_404.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_403.Outcometree.out_ident -> Ast_404.Outcometree.out_ident = + function + | Ast_403.Outcometree.Oide_apply (x0, x1) -> + Ast_404.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_403.Outcometree.Oide_dot (x0, x1) -> + Ast_404.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_403.Outcometree.Oide_ident x0 -> Ast_404.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_404_403.ml b/src/vendored-omp/src/migrate_parsetree_404_403.ml index 4dc190899..e989d67a8 100644 --- a/src/vendored-omp/src/migrate_parsetree_404_403.ml +++ b/src/vendored-omp/src/migrate_parsetree_404_403.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_404_403_migrate.ml b/src/vendored-omp/src/migrate_parsetree_404_403_migrate.ml index 2f69e3fd4..0ffe324a8 100644 --- a/src/vendored-omp/src/migrate_parsetree_404_403_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_404_403_migrate.ml @@ -1,1605 +1,95 @@ -(**************************************************************************) -(* *) -(* 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 +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_404.Outcometree.out_type_extension -> + Ast_403.Outcometree.out_type_extension = 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 } - -> + { Ast_404.Outcometree.otyext_name = otyext_name; + Ast_404.Outcometree.otyext_params = otyext_params; + Ast_404.Outcometree.otyext_constructors = otyext_constructors; + Ast_404.Outcometree.otyext_private = otyext_private } + -> { - To.Parsetree.ptype_name = - (copy_loc (fun x -> x) ptype_name); - To.Parsetree.ptype_params = + Ast_403.Outcometree.otyext_name = otyext_name; + Ast_403.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_403.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_403.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_404.Outcometree.out_phrase -> Ast_403.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 + | Ast_404.Outcometree.Ophr_eval (x0, x1) -> + Ast_403.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_404.Outcometree.Ophr_signature x0 -> + Ast_403.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_404.Outcometree.Ophr_exception x0 -> + Ast_403.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_404.Outcometree.out_sig_item -> Ast_403.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_404.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_403.Outcometree.Osig_class + (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, + (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_404.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_403.Outcometree.Osig_class_type + (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 - + (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_404.Outcometree.Osig_typext (x0, x1) -> + Ast_403.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_404.Outcometree.Osig_modtype (x0, x1) -> + Ast_403.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_404.Outcometree.Osig_module (x0, x1, x2) -> + Ast_403.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_404.Outcometree.Osig_type (x0, x1) -> + Ast_403.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_404.Outcometree.Osig_value x0 -> + Ast_403.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_404.Outcometree.Osig_ellipsis -> Ast_403.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_404.Outcometree.out_val_decl -> Ast_403.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 } - -> + { Ast_404.Outcometree.oval_name = oval_name; + Ast_404.Outcometree.oval_type = oval_type; + Ast_404.Outcometree.oval_prims = oval_prims; + Ast_404.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 = + Ast_403.Outcometree.oval_name = oval_name; + Ast_403.Outcometree.oval_type = (copy_out_type oval_type); + Ast_403.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_403.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } +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_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun @@ -1617,13 +107,13 @@ and copy_out_type_decl : (List.map (fun x -> let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (x0, (let (x0,x1) = x1 in (x0, 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_immediate = otype_immediate; To.Outcometree.otype_cstrs = (List.map (fun x -> @@ -1631,286 +121,190 @@ and copy_out_type_decl : ((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) - + Ast_404.Outcometree.out_module_type -> Ast_403.Outcometree.out_module_type + = + function + | Ast_404.Outcometree.Omty_abstract -> Ast_403.Outcometree.Omty_abstract + | Ast_404.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_403.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_404.Outcometree.Omty_ident x0 -> + Ast_403.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_404.Outcometree.Omty_signature x0 -> + Ast_403.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_404.Outcometree.Omty_alias x0 -> + Ast_403.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_404.Outcometree.out_ext_status -> Ast_403.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 - + | Ast_404.Outcometree.Oext_first -> Ast_403.Outcometree.Oext_first + | Ast_404.Outcometree.Oext_next -> Ast_403.Outcometree.Oext_next + | Ast_404.Outcometree.Oext_exception -> Ast_403.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_404.Outcometree.out_extension_constructor -> + Ast_403.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 } - -> + { Ast_404.Outcometree.oext_name = oext_name; + Ast_404.Outcometree.oext_type_name = oext_type_name; + Ast_404.Outcometree.oext_type_params = oext_type_params; + Ast_404.Outcometree.oext_args = oext_args; + Ast_404.Outcometree.oext_ret_type = oext_ret_type; + Ast_404.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) + Ast_403.Outcometree.oext_name = oext_name; + Ast_403.Outcometree.oext_type_name = oext_type_name; + Ast_403.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_403.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_403.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_403.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_404.Asttypes.private_flag -> Ast_403.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_404.Asttypes.Private -> Ast_403.Asttypes.Private + | Ast_404.Asttypes.Public -> Ast_403.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_404.Outcometree.out_rec_status -> Ast_403.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 - + | Ast_404.Outcometree.Orec_not -> Ast_403.Outcometree.Orec_not + | Ast_404.Outcometree.Orec_first -> Ast_403.Outcometree.Orec_first + | Ast_404.Outcometree.Orec_next -> Ast_403.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), + Ast_404.Outcometree.out_class_type -> Ast_403.Outcometree.out_class_type = + function + | Ast_404.Outcometree.Octy_constr (x0, x1) -> + Ast_403.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_404.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_403.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_404.Outcometree.Octy_signature (x0, x1) -> + Ast_403.Outcometree.Octy_signature + ((Option.map 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 + Ast_404.Outcometree.out_class_sig_item -> + Ast_403.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)) - + | Ast_404.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_403.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_404.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_403.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_404.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_403.Outcometree.Ocsg_value (x0, x1, 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 + Ast_404.Outcometree.out_type -> Ast_403.Outcometree.out_type = + function + | Ast_404.Outcometree.Otyp_abstract -> Ast_403.Outcometree.Otyp_abstract + | Ast_404.Outcometree.Otyp_open -> Ast_403.Outcometree.Otyp_open + | Ast_404.Outcometree.Otyp_alias (x0, x1) -> + Ast_403.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_404.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_403.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_404.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_403.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_404.Outcometree.Otyp_constr (x0, x1) -> + Ast_403.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_404.Outcometree.Otyp_manifest (x0, x1) -> + Ast_403.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_404.Outcometree.Otyp_object (x0, x1) -> + Ast_403.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_404.Outcometree.Otyp_record x0 -> + Ast_403.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_404.Outcometree.Otyp_stuff x0 -> Ast_403.Outcometree.Otyp_stuff x0 + | Ast_404.Outcometree.Otyp_sum x0 -> + Ast_403.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_404.Outcometree.Otyp_tuple x0 -> + Ast_403.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_404.Outcometree.Otyp_var (x0, x1) -> + Ast_403.Outcometree.Otyp_var (x0, x1) + | Ast_404.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_403.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_404.Outcometree.Otyp_poly (x0, x1) -> + Ast_403.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_404.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_403.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_404.Outcometree.Otyp_attribute (x0, x1) -> + Ast_403.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 } - + Ast_404.Outcometree.out_attribute -> Ast_403.Outcometree.out_attribute = + fun { Ast_404.Outcometree.oattr_name = oattr_name } -> + { Ast_403.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_404.Outcometree.out_variant -> Ast_403.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_404.Outcometree.Ovar_fields x0 -> + Ast_403.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)) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_404.Outcometree.Ovar_name (x0, x1) -> + Ast_403.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 + Ast_404.Outcometree.out_value -> Ast_403.Outcometree.out_value = + function + | Ast_404.Outcometree.Oval_array x0 -> + Ast_403.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_char x0 -> Ast_403.Outcometree.Oval_char x0 + | Ast_404.Outcometree.Oval_constr (x0, x1) -> + Ast_403.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_404.Outcometree.Oval_ellipsis -> Ast_403.Outcometree.Oval_ellipsis + | Ast_404.Outcometree.Oval_float x0 -> Ast_403.Outcometree.Oval_float x0 + | Ast_404.Outcometree.Oval_int x0 -> Ast_403.Outcometree.Oval_int x0 + | Ast_404.Outcometree.Oval_int32 x0 -> Ast_403.Outcometree.Oval_int32 x0 + | Ast_404.Outcometree.Oval_int64 x0 -> Ast_403.Outcometree.Oval_int64 x0 + | Ast_404.Outcometree.Oval_nativeint x0 -> + Ast_403.Outcometree.Oval_nativeint x0 + | Ast_404.Outcometree.Oval_list x0 -> + Ast_403.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_printer x0 -> + Ast_403.Outcometree.Oval_printer x0 + | Ast_404.Outcometree.Oval_record x0 -> + Ast_403.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_404.Outcometree.Oval_string x0 -> Ast_403.Outcometree.Oval_string x0 + | Ast_404.Outcometree.Oval_stuff x0 -> Ast_403.Outcometree.Oval_stuff x0 + | Ast_404.Outcometree.Oval_tuple x0 -> + Ast_403.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_variant (x0, x1) -> + Ast_403.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_404.Outcometree.out_ident -> Ast_403.Outcometree.out_ident = + function + | Ast_404.Outcometree.Oide_apply (x0, x1) -> + Ast_403.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_404.Outcometree.Oide_dot (x0, x1) -> + Ast_403.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_404.Outcometree.Oide_ident x0 -> Ast_403.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_404_405.ml b/src/vendored-omp/src/migrate_parsetree_404_405.ml index ad6594ee6..268102952 100644 --- a/src/vendored-omp/src/migrate_parsetree_404_405.ml +++ b/src/vendored-omp/src/migrate_parsetree_404_405.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_404_405_migrate.ml b/src/vendored-omp/src/migrate_parsetree_404_405_migrate.ml index d62423a8d..2f188a237 100644 --- a/src/vendored-omp/src/migrate_parsetree_404_405_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_404_405_migrate.ml @@ -1,1716 +1,302 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_404.Outcometree.out_type_extension -> + Ast_405.Outcometree.out_type_extension = 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 } - -> + { Ast_404.Outcometree.otyext_name = otyext_name; + Ast_404.Outcometree.otyext_params = otyext_params; + Ast_404.Outcometree.otyext_constructors = otyext_constructors; + Ast_404.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_405.Outcometree.otyext_name = otyext_name; + Ast_405.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_405.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_405.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_404.Outcometree.out_phrase -> Ast_405.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 + | Ast_404.Outcometree.Ophr_eval (x0, x1) -> + Ast_405.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_404.Outcometree.Ophr_signature x0 -> + Ast_405.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_404.Outcometree.Ophr_exception x0 -> + Ast_405.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_404.Outcometree.out_sig_item -> Ast_405.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_404.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_405.Outcometree.Osig_class + (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, + (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_404.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_405.Outcometree.Osig_class_type + (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 - + (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_404.Outcometree.Osig_typext (x0, x1) -> + Ast_405.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_404.Outcometree.Osig_modtype (x0, x1) -> + Ast_405.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_404.Outcometree.Osig_module (x0, x1, x2) -> + Ast_405.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_404.Outcometree.Osig_type (x0, x1) -> + Ast_405.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_404.Outcometree.Osig_value x0 -> + Ast_405.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_404.Outcometree.Osig_ellipsis -> Ast_405.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_404.Outcometree.out_val_decl -> Ast_405.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 } - -> + { Ast_404.Outcometree.oval_name = oval_name; + Ast_404.Outcometree.oval_type = oval_type; + Ast_404.Outcometree.oval_prims = oval_prims; + Ast_404.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 = + Ast_405.Outcometree.oval_name = oval_name; + Ast_405.Outcometree.oval_type = (copy_out_type oval_type); + Ast_405.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_405.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 = + Ast_404.Outcometree.out_type_decl -> Ast_405.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 } - -> + { Ast_404.Outcometree.otype_name = otype_name; + Ast_404.Outcometree.otype_params = otype_params; + Ast_404.Outcometree.otype_type = otype_type; + Ast_404.Outcometree.otype_private = otype_private; + Ast_404.Outcometree.otype_immediate = otype_immediate; + Ast_404.Outcometree.otype_unboxed = otype_unboxed; + Ast_404.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_405.Outcometree.otype_name = otype_name; + Ast_405.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_405.Outcometree.otype_type = (copy_out_type otype_type); + Ast_405.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_405.Outcometree.otype_immediate = otype_immediate; + Ast_405.Outcometree.otype_unboxed = otype_unboxed; + Ast_405.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_404.Outcometree.out_module_type -> Ast_405.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) - + | Ast_404.Outcometree.Omty_abstract -> Ast_405.Outcometree.Omty_abstract + | Ast_404.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_405.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_404.Outcometree.Omty_ident x0 -> + Ast_405.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_404.Outcometree.Omty_signature x0 -> + Ast_405.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_404.Outcometree.Omty_alias x0 -> + Ast_405.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_404.Outcometree.out_ext_status -> Ast_405.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 - + | Ast_404.Outcometree.Oext_first -> Ast_405.Outcometree.Oext_first + | Ast_404.Outcometree.Oext_next -> Ast_405.Outcometree.Oext_next + | Ast_404.Outcometree.Oext_exception -> Ast_405.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_404.Outcometree.out_extension_constructor -> + Ast_405.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 } - -> + { Ast_404.Outcometree.oext_name = oext_name; + Ast_404.Outcometree.oext_type_name = oext_type_name; + Ast_404.Outcometree.oext_type_params = oext_type_params; + Ast_404.Outcometree.oext_args = oext_args; + Ast_404.Outcometree.oext_ret_type = oext_ret_type; + Ast_404.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) + Ast_405.Outcometree.oext_name = oext_name; + Ast_405.Outcometree.oext_type_name = oext_type_name; + Ast_405.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_405.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_405.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_405.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_404.Asttypes.private_flag -> Ast_405.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_404.Asttypes.Private -> Ast_405.Asttypes.Private + | Ast_404.Asttypes.Public -> Ast_405.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_404.Outcometree.out_rec_status -> Ast_405.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 - + | Ast_404.Outcometree.Orec_not -> Ast_405.Outcometree.Orec_not + | Ast_404.Outcometree.Orec_first -> Ast_405.Outcometree.Orec_first + | Ast_404.Outcometree.Orec_next -> Ast_405.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), + Ast_404.Outcometree.out_class_type -> Ast_405.Outcometree.out_class_type = + function + | Ast_404.Outcometree.Octy_constr (x0, x1) -> + Ast_405.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_404.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_405.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_404.Outcometree.Octy_signature (x0, x1) -> + Ast_405.Outcometree.Octy_signature + ((Option.map 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 + Ast_404.Outcometree.out_class_sig_item -> + Ast_405.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)) - + | Ast_404.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_405.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_404.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_405.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_404.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_405.Outcometree.Ocsg_value (x0, x1, 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 + Ast_404.Outcometree.out_type -> Ast_405.Outcometree.out_type = + function + | Ast_404.Outcometree.Otyp_abstract -> Ast_405.Outcometree.Otyp_abstract + | Ast_404.Outcometree.Otyp_open -> Ast_405.Outcometree.Otyp_open + | Ast_404.Outcometree.Otyp_alias (x0, x1) -> + Ast_405.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_404.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_404.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_404.Outcometree.Otyp_constr (x0, x1) -> + Ast_405.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_404.Outcometree.Otyp_manifest (x0, x1) -> + Ast_405.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_404.Outcometree.Otyp_object (x0, x1) -> + Ast_405.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_404.Outcometree.Otyp_record x0 -> + Ast_405.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_404.Outcometree.Otyp_stuff x0 -> Ast_405.Outcometree.Otyp_stuff x0 + | Ast_404.Outcometree.Otyp_sum x0 -> + Ast_405.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_404.Outcometree.Otyp_tuple x0 -> + Ast_405.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_404.Outcometree.Otyp_var (x0, x1) -> + Ast_405.Outcometree.Otyp_var (x0, x1) + | Ast_404.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_405.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_404.Outcometree.Otyp_poly (x0, x1) -> + Ast_405.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_404.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_404.Outcometree.Otyp_attribute (x0, x1) -> + Ast_405.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 } - + Ast_404.Outcometree.out_attribute -> Ast_405.Outcometree.out_attribute = + fun { Ast_404.Outcometree.oattr_name = oattr_name } -> + { Ast_405.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_404.Outcometree.out_variant -> Ast_405.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_404.Outcometree.Ovar_fields x0 -> + Ast_405.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) -> + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_404.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 + Ast_404.Outcometree.out_value -> Ast_405.Outcometree.out_value = + function + | Ast_404.Outcometree.Oval_array x0 -> + Ast_405.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_char x0 -> Ast_405.Outcometree.Oval_char x0 + | Ast_404.Outcometree.Oval_constr (x0, x1) -> + Ast_405.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_404.Outcometree.Oval_ellipsis -> Ast_405.Outcometree.Oval_ellipsis + | Ast_404.Outcometree.Oval_float x0 -> Ast_405.Outcometree.Oval_float x0 + | Ast_404.Outcometree.Oval_int x0 -> Ast_405.Outcometree.Oval_int x0 + | Ast_404.Outcometree.Oval_int32 x0 -> Ast_405.Outcometree.Oval_int32 x0 + | Ast_404.Outcometree.Oval_int64 x0 -> Ast_405.Outcometree.Oval_int64 x0 + | Ast_404.Outcometree.Oval_nativeint x0 -> + Ast_405.Outcometree.Oval_nativeint x0 + | Ast_404.Outcometree.Oval_list x0 -> + Ast_405.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_printer x0 -> + Ast_405.Outcometree.Oval_printer x0 + | Ast_404.Outcometree.Oval_record x0 -> + Ast_405.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_404.Outcometree.Oval_string x0 -> Ast_405.Outcometree.Oval_string x0 + | Ast_404.Outcometree.Oval_stuff x0 -> Ast_405.Outcometree.Oval_stuff x0 + | Ast_404.Outcometree.Oval_tuple x0 -> + Ast_405.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_404.Outcometree.Oval_variant (x0, x1) -> + Ast_405.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_404.Outcometree.out_ident -> Ast_405.Outcometree.out_ident = + function + | Ast_404.Outcometree.Oide_apply (x0, x1) -> + Ast_405.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_404.Outcometree.Oide_dot (x0, x1) -> + Ast_405.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_404.Outcometree.Oide_ident x0 -> Ast_405.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_405_404.ml b/src/vendored-omp/src/migrate_parsetree_405_404.ml index 82cb5cd5d..f73046403 100644 --- a/src/vendored-omp/src/migrate_parsetree_405_404.ml +++ b/src/vendored-omp/src/migrate_parsetree_405_404.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_405_404_migrate.ml b/src/vendored-omp/src/migrate_parsetree_405_404_migrate.ml index e34ac74c5..5861c0ed6 100644 --- a/src/vendored-omp/src/migrate_parsetree_405_404_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_405_404_migrate.ml @@ -1,1716 +1,302 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_405.Outcometree.out_type_extension -> + Ast_404.Outcometree.out_type_extension = 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 } - -> + { Ast_405.Outcometree.otyext_name = otyext_name; + Ast_405.Outcometree.otyext_params = otyext_params; + Ast_405.Outcometree.otyext_constructors = otyext_constructors; + Ast_405.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_404.Outcometree.otyext_name = otyext_name; + Ast_404.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_404.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_404.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_405.Outcometree.out_phrase -> Ast_404.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 + | Ast_405.Outcometree.Ophr_eval (x0, x1) -> + Ast_404.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_405.Outcometree.Ophr_signature x0 -> + Ast_404.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_405.Outcometree.Ophr_exception x0 -> + Ast_404.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_405.Outcometree.out_sig_item -> Ast_404.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_405.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_404.Outcometree.Osig_class + (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, + (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_405.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_404.Outcometree.Osig_class_type + (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 - + (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_405.Outcometree.Osig_typext (x0, x1) -> + Ast_404.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_405.Outcometree.Osig_modtype (x0, x1) -> + Ast_404.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_405.Outcometree.Osig_module (x0, x1, x2) -> + Ast_404.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_405.Outcometree.Osig_type (x0, x1) -> + Ast_404.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_405.Outcometree.Osig_value x0 -> + Ast_404.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_405.Outcometree.Osig_ellipsis -> Ast_404.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_405.Outcometree.out_val_decl -> Ast_404.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 } - -> + { Ast_405.Outcometree.oval_name = oval_name; + Ast_405.Outcometree.oval_type = oval_type; + Ast_405.Outcometree.oval_prims = oval_prims; + Ast_405.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 = + Ast_404.Outcometree.oval_name = oval_name; + Ast_404.Outcometree.oval_type = (copy_out_type oval_type); + Ast_404.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_404.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 = + Ast_405.Outcometree.out_type_decl -> Ast_404.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 } - -> + { Ast_405.Outcometree.otype_name = otype_name; + Ast_405.Outcometree.otype_params = otype_params; + Ast_405.Outcometree.otype_type = otype_type; + Ast_405.Outcometree.otype_private = otype_private; + Ast_405.Outcometree.otype_immediate = otype_immediate; + Ast_405.Outcometree.otype_unboxed = otype_unboxed; + Ast_405.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_404.Outcometree.otype_name = otype_name; + Ast_404.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_404.Outcometree.otype_type = (copy_out_type otype_type); + Ast_404.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_404.Outcometree.otype_immediate = otype_immediate; + Ast_404.Outcometree.otype_unboxed = otype_unboxed; + Ast_404.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_405.Outcometree.out_module_type -> Ast_404.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) - + | Ast_405.Outcometree.Omty_abstract -> Ast_404.Outcometree.Omty_abstract + | Ast_405.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_404.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_405.Outcometree.Omty_ident x0 -> + Ast_404.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_405.Outcometree.Omty_signature x0 -> + Ast_404.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_405.Outcometree.Omty_alias x0 -> + Ast_404.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_405.Outcometree.out_ext_status -> Ast_404.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 - + | Ast_405.Outcometree.Oext_first -> Ast_404.Outcometree.Oext_first + | Ast_405.Outcometree.Oext_next -> Ast_404.Outcometree.Oext_next + | Ast_405.Outcometree.Oext_exception -> Ast_404.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_405.Outcometree.out_extension_constructor -> + Ast_404.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 } - -> + { Ast_405.Outcometree.oext_name = oext_name; + Ast_405.Outcometree.oext_type_name = oext_type_name; + Ast_405.Outcometree.oext_type_params = oext_type_params; + Ast_405.Outcometree.oext_args = oext_args; + Ast_405.Outcometree.oext_ret_type = oext_ret_type; + Ast_405.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) + Ast_404.Outcometree.oext_name = oext_name; + Ast_404.Outcometree.oext_type_name = oext_type_name; + Ast_404.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_404.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_404.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_404.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_405.Asttypes.private_flag -> Ast_404.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_405.Asttypes.Private -> Ast_404.Asttypes.Private + | Ast_405.Asttypes.Public -> Ast_404.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_405.Outcometree.out_rec_status -> Ast_404.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 - + | Ast_405.Outcometree.Orec_not -> Ast_404.Outcometree.Orec_not + | Ast_405.Outcometree.Orec_first -> Ast_404.Outcometree.Orec_first + | Ast_405.Outcometree.Orec_next -> Ast_404.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), + Ast_405.Outcometree.out_class_type -> Ast_404.Outcometree.out_class_type = + function + | Ast_405.Outcometree.Octy_constr (x0, x1) -> + Ast_404.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_405.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_404.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_405.Outcometree.Octy_signature (x0, x1) -> + Ast_404.Outcometree.Octy_signature + ((Option.map 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 + Ast_405.Outcometree.out_class_sig_item -> + Ast_404.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)) - + | Ast_405.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_404.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_405.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_404.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_405.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_404.Outcometree.Ocsg_value (x0, x1, 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 + Ast_405.Outcometree.out_type -> Ast_404.Outcometree.out_type = + function + | Ast_405.Outcometree.Otyp_abstract -> Ast_404.Outcometree.Otyp_abstract + | Ast_405.Outcometree.Otyp_open -> Ast_404.Outcometree.Otyp_open + | Ast_405.Outcometree.Otyp_alias (x0, x1) -> + Ast_404.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_405.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_405.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_405.Outcometree.Otyp_constr (x0, x1) -> + Ast_404.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_405.Outcometree.Otyp_manifest (x0, x1) -> + Ast_404.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_405.Outcometree.Otyp_object (x0, x1) -> + Ast_404.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_405.Outcometree.Otyp_record x0 -> + Ast_404.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_405.Outcometree.Otyp_stuff x0 -> Ast_404.Outcometree.Otyp_stuff x0 + | Ast_405.Outcometree.Otyp_sum x0 -> + Ast_404.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_405.Outcometree.Otyp_tuple x0 -> + Ast_404.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_405.Outcometree.Otyp_var (x0, x1) -> + Ast_404.Outcometree.Otyp_var (x0, x1) + | Ast_405.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_404.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_405.Outcometree.Otyp_poly (x0, x1) -> + Ast_404.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_405.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_404.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_405.Outcometree.Otyp_attribute (x0, x1) -> + Ast_404.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 } - + Ast_405.Outcometree.out_attribute -> Ast_404.Outcometree.out_attribute = + fun { Ast_405.Outcometree.oattr_name = oattr_name } -> + { Ast_404.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_405.Outcometree.out_variant -> Ast_404.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_405.Outcometree.Ovar_fields x0 -> + Ast_404.Outcometree.Ovar_fields (List.map - (fun x -> - let (x0,x1,x2) = x in - (x0, (copy_bool x1), - (List.map copy_out_type x2))) x0) + (fun x -> + let (x0, x1, x2) = x in (x0, 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 + Ast_405.Outcometree.out_value -> Ast_404.Outcometree.out_value = + function + | Ast_405.Outcometree.Oval_array x0 -> + Ast_404.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_char x0 -> Ast_404.Outcometree.Oval_char x0 + | Ast_405.Outcometree.Oval_constr (x0, x1) -> + Ast_404.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_405.Outcometree.Oval_ellipsis -> Ast_404.Outcometree.Oval_ellipsis + | Ast_405.Outcometree.Oval_float x0 -> Ast_404.Outcometree.Oval_float x0 + | Ast_405.Outcometree.Oval_int x0 -> Ast_404.Outcometree.Oval_int x0 + | Ast_405.Outcometree.Oval_int32 x0 -> Ast_404.Outcometree.Oval_int32 x0 + | Ast_405.Outcometree.Oval_int64 x0 -> Ast_404.Outcometree.Oval_int64 x0 + | Ast_405.Outcometree.Oval_nativeint x0 -> + Ast_404.Outcometree.Oval_nativeint x0 + | Ast_405.Outcometree.Oval_list x0 -> + Ast_404.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_printer x0 -> + Ast_404.Outcometree.Oval_printer x0 + | Ast_405.Outcometree.Oval_record x0 -> + Ast_404.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_405.Outcometree.Oval_string x0 -> Ast_404.Outcometree.Oval_string x0 + | Ast_405.Outcometree.Oval_stuff x0 -> Ast_404.Outcometree.Oval_stuff x0 + | Ast_405.Outcometree.Oval_tuple x0 -> + Ast_404.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_variant (x0, x1) -> + Ast_404.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_405.Outcometree.out_ident -> Ast_404.Outcometree.out_ident = + function + | Ast_405.Outcometree.Oide_apply (x0, x1) -> + Ast_404.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_405.Outcometree.Oide_dot (x0, x1) -> + Ast_404.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_405.Outcometree.Oide_ident x0 -> Ast_404.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_405_406.ml b/src/vendored-omp/src/migrate_parsetree_405_406.ml index c3e84c754..d312d78d2 100644 --- a/src/vendored-omp/src/migrate_parsetree_405_406.ml +++ b/src/vendored-omp/src/migrate_parsetree_405_406.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_405_406_migrate.ml b/src/vendored-omp/src/migrate_parsetree_405_406_migrate.ml index c795a1d5c..5429bac20 100644 --- a/src/vendored-omp/src/migrate_parsetree_405_406_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_405_406_migrate.ml @@ -1,1714 +1,300 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_405.Outcometree.out_type_extension -> + Ast_406.Outcometree.out_type_extension = 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 } - -> + { Ast_405.Outcometree.otyext_name = otyext_name; + Ast_405.Outcometree.otyext_params = otyext_params; + Ast_405.Outcometree.otyext_constructors = otyext_constructors; + Ast_405.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_406.Outcometree.otyext_name = otyext_name; + Ast_406.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_406.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_406.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_405.Outcometree.out_phrase -> Ast_406.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 + | Ast_405.Outcometree.Ophr_eval (x0, x1) -> + Ast_406.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_405.Outcometree.Ophr_signature x0 -> + Ast_406.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_405.Outcometree.Ophr_exception x0 -> + Ast_406.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_405.Outcometree.out_sig_item -> Ast_406.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_405.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_406.Outcometree.Osig_class + (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, + (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_405.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_406.Outcometree.Osig_class_type + (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 - + (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_405.Outcometree.Osig_typext (x0, x1) -> + Ast_406.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_405.Outcometree.Osig_modtype (x0, x1) -> + Ast_406.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_405.Outcometree.Osig_module (x0, x1, x2) -> + Ast_406.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_405.Outcometree.Osig_type (x0, x1) -> + Ast_406.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_405.Outcometree.Osig_value x0 -> + Ast_406.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_405.Outcometree.Osig_ellipsis -> Ast_406.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_405.Outcometree.out_val_decl -> Ast_406.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 } - -> + { Ast_405.Outcometree.oval_name = oval_name; + Ast_405.Outcometree.oval_type = oval_type; + Ast_405.Outcometree.oval_prims = oval_prims; + Ast_405.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 = + Ast_406.Outcometree.oval_name = oval_name; + Ast_406.Outcometree.oval_type = (copy_out_type oval_type); + Ast_406.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_406.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 = + Ast_405.Outcometree.out_type_decl -> Ast_406.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 } - -> + { Ast_405.Outcometree.otype_name = otype_name; + Ast_405.Outcometree.otype_params = otype_params; + Ast_405.Outcometree.otype_type = otype_type; + Ast_405.Outcometree.otype_private = otype_private; + Ast_405.Outcometree.otype_immediate = otype_immediate; + Ast_405.Outcometree.otype_unboxed = otype_unboxed; + Ast_405.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_406.Outcometree.otype_name = otype_name; + Ast_406.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_406.Outcometree.otype_type = (copy_out_type otype_type); + Ast_406.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_406.Outcometree.otype_immediate = otype_immediate; + Ast_406.Outcometree.otype_unboxed = otype_unboxed; + Ast_406.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_405.Outcometree.out_module_type -> Ast_406.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) - + | Ast_405.Outcometree.Omty_abstract -> Ast_406.Outcometree.Omty_abstract + | Ast_405.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_406.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_405.Outcometree.Omty_ident x0 -> + Ast_406.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_405.Outcometree.Omty_signature x0 -> + Ast_406.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_405.Outcometree.Omty_alias x0 -> + Ast_406.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_405.Outcometree.out_ext_status -> Ast_406.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 - + | Ast_405.Outcometree.Oext_first -> Ast_406.Outcometree.Oext_first + | Ast_405.Outcometree.Oext_next -> Ast_406.Outcometree.Oext_next + | Ast_405.Outcometree.Oext_exception -> Ast_406.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_405.Outcometree.out_extension_constructor -> + Ast_406.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 } - -> + { Ast_405.Outcometree.oext_name = oext_name; + Ast_405.Outcometree.oext_type_name = oext_type_name; + Ast_405.Outcometree.oext_type_params = oext_type_params; + Ast_405.Outcometree.oext_args = oext_args; + Ast_405.Outcometree.oext_ret_type = oext_ret_type; + Ast_405.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) + Ast_406.Outcometree.oext_name = oext_name; + Ast_406.Outcometree.oext_type_name = oext_type_name; + Ast_406.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_406.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_406.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_406.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_405.Asttypes.private_flag -> Ast_406.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_405.Asttypes.Private -> Ast_406.Asttypes.Private + | Ast_405.Asttypes.Public -> Ast_406.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_405.Outcometree.out_rec_status -> Ast_406.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 - + | Ast_405.Outcometree.Orec_not -> Ast_406.Outcometree.Orec_not + | Ast_405.Outcometree.Orec_first -> Ast_406.Outcometree.Orec_first + | Ast_405.Outcometree.Orec_next -> Ast_406.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), + Ast_405.Outcometree.out_class_type -> Ast_406.Outcometree.out_class_type = + function + | Ast_405.Outcometree.Octy_constr (x0, x1) -> + Ast_406.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_405.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_406.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_405.Outcometree.Octy_signature (x0, x1) -> + Ast_406.Outcometree.Octy_signature + ((Option.map 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 + Ast_405.Outcometree.out_class_sig_item -> + Ast_406.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)) - + | Ast_405.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_406.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_405.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_406.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_405.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_406.Outcometree.Ocsg_value (x0, x1, 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 + Ast_405.Outcometree.out_type -> Ast_406.Outcometree.out_type = + function + | Ast_405.Outcometree.Otyp_abstract -> Ast_406.Outcometree.Otyp_abstract + | Ast_405.Outcometree.Otyp_open -> Ast_406.Outcometree.Otyp_open + | Ast_405.Outcometree.Otyp_alias (x0, x1) -> + Ast_406.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_405.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_405.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_405.Outcometree.Otyp_constr (x0, x1) -> + Ast_406.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_405.Outcometree.Otyp_manifest (x0, x1) -> + Ast_406.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_405.Outcometree.Otyp_object (x0, x1) -> + Ast_406.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_405.Outcometree.Otyp_record x0 -> + Ast_406.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_405.Outcometree.Otyp_stuff x0 -> Ast_406.Outcometree.Otyp_stuff x0 + | Ast_405.Outcometree.Otyp_sum x0 -> + Ast_406.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_405.Outcometree.Otyp_tuple x0 -> + Ast_406.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_405.Outcometree.Otyp_var (x0, x1) -> + Ast_406.Outcometree.Otyp_var (x0, x1) + | Ast_405.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_406.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_405.Outcometree.Otyp_poly (x0, x1) -> + Ast_406.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_405.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_405.Outcometree.Otyp_attribute (x0, x1) -> + Ast_406.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 } - + Ast_405.Outcometree.out_attribute -> Ast_406.Outcometree.out_attribute = + fun { Ast_405.Outcometree.oattr_name = oattr_name } -> + { Ast_406.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_405.Outcometree.out_variant -> Ast_406.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_405.Outcometree.Ovar_fields x0 -> + Ast_406.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_405.Outcometree.Ovar_typ x0 -> + Ast_406.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 + Ast_405.Outcometree.out_value -> Ast_406.Outcometree.out_value = + function + | Ast_405.Outcometree.Oval_array x0 -> + Ast_406.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_char x0 -> Ast_406.Outcometree.Oval_char x0 + | Ast_405.Outcometree.Oval_constr (x0, x1) -> + Ast_406.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_405.Outcometree.Oval_ellipsis -> Ast_406.Outcometree.Oval_ellipsis + | Ast_405.Outcometree.Oval_float x0 -> Ast_406.Outcometree.Oval_float x0 + | Ast_405.Outcometree.Oval_int x0 -> Ast_406.Outcometree.Oval_int x0 + | Ast_405.Outcometree.Oval_int32 x0 -> Ast_406.Outcometree.Oval_int32 x0 + | Ast_405.Outcometree.Oval_int64 x0 -> Ast_406.Outcometree.Oval_int64 x0 + | Ast_405.Outcometree.Oval_nativeint x0 -> + Ast_406.Outcometree.Oval_nativeint x0 + | Ast_405.Outcometree.Oval_list x0 -> + Ast_406.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_printer x0 -> + Ast_406.Outcometree.Oval_printer x0 + | Ast_405.Outcometree.Oval_record x0 -> + Ast_406.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 -> + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_405.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 - + | Ast_405.Outcometree.Oval_stuff x0 -> Ast_406.Outcometree.Oval_stuff x0 + | Ast_405.Outcometree.Oval_tuple x0 -> + Ast_406.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_405.Outcometree.Oval_variant (x0, x1) -> + Ast_406.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_405.Outcometree.out_ident -> Ast_406.Outcometree.out_ident = + function + | Ast_405.Outcometree.Oide_apply (x0, x1) -> + Ast_406.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_405.Outcometree.Oide_dot (x0, x1) -> + Ast_406.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_405.Outcometree.Oide_ident x0 -> Ast_406.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_406_405.ml b/src/vendored-omp/src/migrate_parsetree_406_405.ml index 944378c8b..a97014380 100644 --- a/src/vendored-omp/src/migrate_parsetree_406_405.ml +++ b/src/vendored-omp/src/migrate_parsetree_406_405.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_406_405_migrate.ml b/src/vendored-omp/src/migrate_parsetree_406_405_migrate.ml index b0757d534..88b994f2e 100644 --- a/src/vendored-omp/src/migrate_parsetree_406_405_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_406_405_migrate.ml @@ -1,1724 +1,300 @@ -(**************************************************************************) -(* *) -(* 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 +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_406.Outcometree.out_type_extension -> + Ast_405.Outcometree.out_type_extension = 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 } - -> + { Ast_406.Outcometree.otyext_name = otyext_name; + Ast_406.Outcometree.otyext_params = otyext_params; + Ast_406.Outcometree.otyext_constructors = otyext_constructors; + Ast_406.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_405.Outcometree.otyext_name = otyext_name; + Ast_405.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_405.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_405.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_406.Outcometree.out_phrase -> Ast_405.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 + | Ast_406.Outcometree.Ophr_eval (x0, x1) -> + Ast_405.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_406.Outcometree.Ophr_signature x0 -> + Ast_405.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_406.Outcometree.Ophr_exception x0 -> + Ast_405.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_406.Outcometree.out_sig_item -> Ast_405.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_406.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_405.Outcometree.Osig_class + (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, + (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_406.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_405.Outcometree.Osig_class_type + (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 - + (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_406.Outcometree.Osig_typext (x0, x1) -> + Ast_405.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_406.Outcometree.Osig_modtype (x0, x1) -> + Ast_405.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_406.Outcometree.Osig_module (x0, x1, x2) -> + Ast_405.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_406.Outcometree.Osig_type (x0, x1) -> + Ast_405.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_406.Outcometree.Osig_value x0 -> + Ast_405.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_406.Outcometree.Osig_ellipsis -> Ast_405.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_406.Outcometree.out_val_decl -> Ast_405.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 } - -> + { Ast_406.Outcometree.oval_name = oval_name; + Ast_406.Outcometree.oval_type = oval_type; + Ast_406.Outcometree.oval_prims = oval_prims; + Ast_406.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 = + Ast_405.Outcometree.oval_name = oval_name; + Ast_405.Outcometree.oval_type = (copy_out_type oval_type); + Ast_405.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_405.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 = + Ast_406.Outcometree.out_type_decl -> Ast_405.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 } - -> + { Ast_406.Outcometree.otype_name = otype_name; + Ast_406.Outcometree.otype_params = otype_params; + Ast_406.Outcometree.otype_type = otype_type; + Ast_406.Outcometree.otype_private = otype_private; + Ast_406.Outcometree.otype_immediate = otype_immediate; + Ast_406.Outcometree.otype_unboxed = otype_unboxed; + Ast_406.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_405.Outcometree.otype_name = otype_name; + Ast_405.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_405.Outcometree.otype_type = (copy_out_type otype_type); + Ast_405.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_405.Outcometree.otype_immediate = otype_immediate; + Ast_405.Outcometree.otype_unboxed = otype_unboxed; + Ast_405.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_406.Outcometree.out_module_type -> Ast_405.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) - + | Ast_406.Outcometree.Omty_abstract -> Ast_405.Outcometree.Omty_abstract + | Ast_406.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_405.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_406.Outcometree.Omty_ident x0 -> + Ast_405.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_406.Outcometree.Omty_signature x0 -> + Ast_405.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_406.Outcometree.Omty_alias x0 -> + Ast_405.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_406.Outcometree.out_ext_status -> Ast_405.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 - + | Ast_406.Outcometree.Oext_first -> Ast_405.Outcometree.Oext_first + | Ast_406.Outcometree.Oext_next -> Ast_405.Outcometree.Oext_next + | Ast_406.Outcometree.Oext_exception -> Ast_405.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_406.Outcometree.out_extension_constructor -> + Ast_405.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 } - -> + { Ast_406.Outcometree.oext_name = oext_name; + Ast_406.Outcometree.oext_type_name = oext_type_name; + Ast_406.Outcometree.oext_type_params = oext_type_params; + Ast_406.Outcometree.oext_args = oext_args; + Ast_406.Outcometree.oext_ret_type = oext_ret_type; + Ast_406.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) + Ast_405.Outcometree.oext_name = oext_name; + Ast_405.Outcometree.oext_type_name = oext_type_name; + Ast_405.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_405.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_405.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_405.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_406.Asttypes.private_flag -> Ast_405.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_406.Asttypes.Private -> Ast_405.Asttypes.Private + | Ast_406.Asttypes.Public -> Ast_405.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_406.Outcometree.out_rec_status -> Ast_405.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 - + | Ast_406.Outcometree.Orec_not -> Ast_405.Outcometree.Orec_not + | Ast_406.Outcometree.Orec_first -> Ast_405.Outcometree.Orec_first + | Ast_406.Outcometree.Orec_next -> Ast_405.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), + Ast_406.Outcometree.out_class_type -> Ast_405.Outcometree.out_class_type = + function + | Ast_406.Outcometree.Octy_constr (x0, x1) -> + Ast_405.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_406.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_405.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_406.Outcometree.Octy_signature (x0, x1) -> + Ast_405.Outcometree.Octy_signature + ((Option.map 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 + Ast_406.Outcometree.out_class_sig_item -> + Ast_405.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)) - + | Ast_406.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_405.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_406.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_405.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_406.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_405.Outcometree.Ocsg_value (x0, x1, 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 + Ast_406.Outcometree.out_type -> Ast_405.Outcometree.out_type = + function + | Ast_406.Outcometree.Otyp_abstract -> Ast_405.Outcometree.Otyp_abstract + | Ast_406.Outcometree.Otyp_open -> Ast_405.Outcometree.Otyp_open + | Ast_406.Outcometree.Otyp_alias (x0, x1) -> + Ast_405.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_406.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_406.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_406.Outcometree.Otyp_constr (x0, x1) -> + Ast_405.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_406.Outcometree.Otyp_manifest (x0, x1) -> + Ast_405.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_406.Outcometree.Otyp_object (x0, x1) -> + Ast_405.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_406.Outcometree.Otyp_record x0 -> + Ast_405.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_406.Outcometree.Otyp_stuff x0 -> Ast_405.Outcometree.Otyp_stuff x0 + | Ast_406.Outcometree.Otyp_sum x0 -> + Ast_405.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) - + (Option.map copy_out_type x2))) x0) + | Ast_406.Outcometree.Otyp_tuple x0 -> + Ast_405.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_406.Outcometree.Otyp_var (x0, x1) -> + Ast_405.Outcometree.Otyp_var (x0, x1) + | Ast_406.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_405.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_406.Outcometree.Otyp_poly (x0, x1) -> + Ast_405.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_406.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_405.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_406.Outcometree.Otyp_attribute (x0, x1) -> + Ast_405.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 } - + Ast_406.Outcometree.out_attribute -> Ast_405.Outcometree.out_attribute = + fun { Ast_406.Outcometree.oattr_name = oattr_name } -> + { Ast_405.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_406.Outcometree.out_variant -> Ast_405.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_406.Outcometree.Ovar_fields x0 -> + Ast_405.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_406.Outcometree.Ovar_typ x0 -> + Ast_405.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 + Ast_406.Outcometree.out_value -> Ast_405.Outcometree.out_value = + function + | Ast_406.Outcometree.Oval_array x0 -> + Ast_405.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_char x0 -> Ast_405.Outcometree.Oval_char x0 + | Ast_406.Outcometree.Oval_constr (x0, x1) -> + Ast_405.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_406.Outcometree.Oval_ellipsis -> Ast_405.Outcometree.Oval_ellipsis + | Ast_406.Outcometree.Oval_float x0 -> Ast_405.Outcometree.Oval_float x0 + | Ast_406.Outcometree.Oval_int x0 -> Ast_405.Outcometree.Oval_int x0 + | Ast_406.Outcometree.Oval_int32 x0 -> Ast_405.Outcometree.Oval_int32 x0 + | Ast_406.Outcometree.Oval_int64 x0 -> Ast_405.Outcometree.Oval_int64 x0 + | Ast_406.Outcometree.Oval_nativeint x0 -> + Ast_405.Outcometree.Oval_nativeint x0 + | Ast_406.Outcometree.Oval_list x0 -> + Ast_405.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_printer x0 -> + Ast_405.Outcometree.Oval_printer x0 + | Ast_406.Outcometree.Oval_record x0 -> + Ast_405.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 - + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_406.Outcometree.Oval_string (x0, _, _) -> + Ast_405.Outcometree.Oval_string x0 + | Ast_406.Outcometree.Oval_stuff x0 -> Ast_405.Outcometree.Oval_stuff x0 + | Ast_406.Outcometree.Oval_tuple x0 -> + Ast_405.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_variant (x0, x1) -> + Ast_405.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) 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 + Ast_406.Outcometree.out_ident -> Ast_405.Outcometree.out_ident = + function + | Ast_406.Outcometree.Oide_apply (x0, x1) -> + Ast_405.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_406.Outcometree.Oide_dot (x0, x1) -> + Ast_405.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_406.Outcometree.Oide_ident x0 -> Ast_405.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_406_407.ml b/src/vendored-omp/src/migrate_parsetree_406_407.ml index 3159e5ce5..1c4ba0ae6 100644 --- a/src/vendored-omp/src/migrate_parsetree_406_407.ml +++ b/src/vendored-omp/src/migrate_parsetree_406_407.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_406_407_migrate.ml b/src/vendored-omp/src/migrate_parsetree_406_407_migrate.ml index f96ed71eb..482fe73bf 100644 --- a/src/vendored-omp/src/migrate_parsetree_406_407_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_406_407_migrate.ml @@ -1,1734 +1,305 @@ -(**************************************************************************) -(* *) -(* 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 +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_406.Outcometree.out_type_extension -> + Ast_407.Outcometree.out_type_extension = - 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 } - -> + { Ast_406.Outcometree.otyext_name = otyext_name; + Ast_406.Outcometree.otyext_params = otyext_params; + Ast_406.Outcometree.otyext_constructors = otyext_constructors; + Ast_406.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_407.Outcometree.otyext_name = otyext_name; + Ast_407.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_407.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_407.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_406.Outcometree.out_phrase -> Ast_407.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 + | Ast_406.Outcometree.Ophr_eval (x0, x1) -> + Ast_407.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_406.Outcometree.Ophr_signature x0 -> + Ast_407.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_406.Outcometree.Ophr_exception x0 -> + Ast_407.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_406.Outcometree.out_sig_item -> Ast_407.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_406.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_407.Outcometree.Osig_class + (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, + (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_406.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_407.Outcometree.Osig_class_type + (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 - + (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_406.Outcometree.Osig_typext (x0, x1) -> + Ast_407.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_406.Outcometree.Osig_modtype (x0, x1) -> + Ast_407.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_406.Outcometree.Osig_module (x0, x1, x2) -> + Ast_407.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_406.Outcometree.Osig_type (x0, x1) -> + Ast_407.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_406.Outcometree.Osig_value x0 -> + Ast_407.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_406.Outcometree.Osig_ellipsis -> Ast_407.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_406.Outcometree.out_val_decl -> Ast_407.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 } - -> + { Ast_406.Outcometree.oval_name = oval_name; + Ast_406.Outcometree.oval_type = oval_type; + Ast_406.Outcometree.oval_prims = oval_prims; + Ast_406.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 = + Ast_407.Outcometree.oval_name = oval_name; + Ast_407.Outcometree.oval_type = (copy_out_type oval_type); + Ast_407.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_407.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 = + Ast_406.Outcometree.out_type_decl -> Ast_407.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 } - -> + { Ast_406.Outcometree.otype_name = otype_name; + Ast_406.Outcometree.otype_params = otype_params; + Ast_406.Outcometree.otype_type = otype_type; + Ast_406.Outcometree.otype_private = otype_private; + Ast_406.Outcometree.otype_immediate = otype_immediate; + Ast_406.Outcometree.otype_unboxed = otype_unboxed; + Ast_406.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_407.Outcometree.otype_name = otype_name; + Ast_407.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_407.Outcometree.otype_type = (copy_out_type otype_type); + Ast_407.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_407.Outcometree.otype_immediate = otype_immediate; + Ast_407.Outcometree.otype_unboxed = otype_unboxed; + Ast_407.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_406.Outcometree.out_module_type -> Ast_407.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) - + | Ast_406.Outcometree.Omty_abstract -> Ast_407.Outcometree.Omty_abstract + | Ast_406.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_407.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_406.Outcometree.Omty_ident x0 -> + Ast_407.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_406.Outcometree.Omty_signature x0 -> + Ast_407.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_406.Outcometree.Omty_alias x0 -> + Ast_407.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_406.Outcometree.out_ext_status -> Ast_407.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 - + | Ast_406.Outcometree.Oext_first -> Ast_407.Outcometree.Oext_first + | Ast_406.Outcometree.Oext_next -> Ast_407.Outcometree.Oext_next + | Ast_406.Outcometree.Oext_exception -> Ast_407.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_406.Outcometree.out_extension_constructor -> + Ast_407.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 } - -> + { Ast_406.Outcometree.oext_name = oext_name; + Ast_406.Outcometree.oext_type_name = oext_type_name; + Ast_406.Outcometree.oext_type_params = oext_type_params; + Ast_406.Outcometree.oext_args = oext_args; + Ast_406.Outcometree.oext_ret_type = oext_ret_type; + Ast_406.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) + Ast_407.Outcometree.oext_name = oext_name; + Ast_407.Outcometree.oext_type_name = oext_type_name; + Ast_407.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_407.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_407.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_407.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_406.Asttypes.private_flag -> Ast_407.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_406.Asttypes.Private -> Ast_407.Asttypes.Private + | Ast_406.Asttypes.Public -> Ast_407.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_406.Outcometree.out_rec_status -> Ast_407.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 - + | Ast_406.Outcometree.Orec_not -> Ast_407.Outcometree.Orec_not + | Ast_406.Outcometree.Orec_first -> Ast_407.Outcometree.Orec_first + | Ast_406.Outcometree.Orec_next -> Ast_407.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), + Ast_406.Outcometree.out_class_type -> Ast_407.Outcometree.out_class_type = + function + | Ast_406.Outcometree.Octy_constr (x0, x1) -> + Ast_407.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_406.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_407.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_406.Outcometree.Octy_signature (x0, x1) -> + Ast_407.Outcometree.Octy_signature + ((Option.map 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 + Ast_406.Outcometree.out_class_sig_item -> + Ast_407.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)) - + | Ast_406.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_407.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_406.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_407.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_406.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_407.Outcometree.Ocsg_value (x0, x1, 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 + Ast_406.Outcometree.out_type -> Ast_407.Outcometree.out_type = + function + | Ast_406.Outcometree.Otyp_abstract -> Ast_407.Outcometree.Otyp_abstract + | Ast_406.Outcometree.Otyp_open -> Ast_407.Outcometree.Otyp_open + | Ast_406.Outcometree.Otyp_alias (x0, x1) -> + Ast_407.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_406.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_407.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_406.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_407.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_406.Outcometree.Otyp_constr (x0, x1) -> + Ast_407.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_406.Outcometree.Otyp_manifest (x0, x1) -> + Ast_407.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_406.Outcometree.Otyp_object (x0, x1) -> + Ast_407.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_406.Outcometree.Otyp_record x0 -> + Ast_407.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_406.Outcometree.Otyp_stuff x0 -> Ast_407.Outcometree.Otyp_stuff x0 + | Ast_406.Outcometree.Otyp_sum x0 -> + Ast_407.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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 - + (Option.map copy_out_type x2))) x0) + | Ast_406.Outcometree.Otyp_tuple x0 -> + Ast_407.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_406.Outcometree.Otyp_var (x0, x1) -> + Ast_407.Outcometree.Otyp_var (x0, x1) + | Ast_406.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_407.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_406.Outcometree.Otyp_poly (x0, x1) -> + Ast_407.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_406.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_407.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_406.Outcometree.Otyp_attribute (x0, x1) -> + Ast_407.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 } - + Ast_406.Outcometree.out_attribute -> Ast_407.Outcometree.out_attribute = + fun { Ast_406.Outcometree.oattr_name = oattr_name } -> + { Ast_407.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_406.Outcometree.out_variant -> Ast_407.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_406.Outcometree.Ovar_fields x0 -> + Ast_407.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_406.Outcometree.Ovar_typ x0 -> + Ast_407.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 + Ast_406.Outcometree.out_value -> Ast_407.Outcometree.out_value = + function + | Ast_406.Outcometree.Oval_array x0 -> + Ast_407.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_char x0 -> Ast_407.Outcometree.Oval_char x0 + | Ast_406.Outcometree.Oval_constr (x0, x1) -> + Ast_407.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_406.Outcometree.Oval_ellipsis -> Ast_407.Outcometree.Oval_ellipsis + | Ast_406.Outcometree.Oval_float x0 -> Ast_407.Outcometree.Oval_float x0 + | Ast_406.Outcometree.Oval_int x0 -> Ast_407.Outcometree.Oval_int x0 + | Ast_406.Outcometree.Oval_int32 x0 -> Ast_407.Outcometree.Oval_int32 x0 + | Ast_406.Outcometree.Oval_int64 x0 -> Ast_407.Outcometree.Oval_int64 x0 + | Ast_406.Outcometree.Oval_nativeint x0 -> + Ast_407.Outcometree.Oval_nativeint x0 + | Ast_406.Outcometree.Oval_list x0 -> + Ast_407.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_printer x0 -> + Ast_407.Outcometree.Oval_printer x0 + | Ast_406.Outcometree.Oval_record x0 -> + Ast_407.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 = + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_406.Outcometree.Oval_string (x0, x1, x2) -> + Ast_407.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_406.Outcometree.Oval_stuff x0 -> Ast_407.Outcometree.Oval_stuff x0 + | Ast_406.Outcometree.Oval_tuple x0 -> + Ast_407.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_406.Outcometree.Oval_variant (x0, x1) -> + Ast_407.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_406.Outcometree.out_string -> Ast_407.Outcometree.out_string = 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 + | Ast_406.Outcometree.Ostr_string -> Ast_407.Outcometree.Ostr_string + | Ast_406.Outcometree.Ostr_bytes -> Ast_407.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_406.Outcometree.out_ident -> Ast_407.Outcometree.out_ident = + function + | Ast_406.Outcometree.Oide_apply (x0, x1) -> + Ast_407.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_406.Outcometree.Oide_dot (x0, x1) -> + Ast_407.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_406.Outcometree.Oide_ident x0 -> Ast_407.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_407_406.ml b/src/vendored-omp/src/migrate_parsetree_407_406.ml index 67831d72c..15bd79c03 100644 --- a/src/vendored-omp/src/migrate_parsetree_407_406.ml +++ b/src/vendored-omp/src/migrate_parsetree_407_406.ml @@ -15,116 +15,3 @@ 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-omp/src/migrate_parsetree_407_406_migrate.ml b/src/vendored-omp/src/migrate_parsetree_407_406_migrate.ml index 047c8c58a..b17b28e0c 100644 --- a/src/vendored-omp/src/migrate_parsetree_407_406_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_407_406_migrate.ml @@ -1,1730 +1,305 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_407.Outcometree.out_type_extension -> + Ast_406.Outcometree.out_type_extension = - 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 } - -> + { Ast_407.Outcometree.otyext_name = otyext_name; + Ast_407.Outcometree.otyext_params = otyext_params; + Ast_407.Outcometree.otyext_constructors = otyext_constructors; + Ast_407.Outcometree.otyext_private = otyext_private } + -> { - 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 = + Ast_406.Outcometree.otyext_name = otyext_name; + Ast_406.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_406.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_406.Outcometree.otyext_private = (copy_private_flag otyext_private) } - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_407.Outcometree.out_phrase -> Ast_406.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 + | Ast_407.Outcometree.Ophr_eval (x0, x1) -> + Ast_406.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_407.Outcometree.Ophr_signature x0 -> + Ast_406.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_407.Outcometree.Ophr_exception x0 -> + Ast_406.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_407.Outcometree.out_sig_item -> Ast_406.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_407.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_406.Outcometree.Osig_class + (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, + (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_407.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_406.Outcometree.Osig_class_type + (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 - + (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_407.Outcometree.Osig_typext (x0, x1) -> + Ast_406.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_407.Outcometree.Osig_modtype (x0, x1) -> + Ast_406.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_407.Outcometree.Osig_module (x0, x1, x2) -> + Ast_406.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_407.Outcometree.Osig_type (x0, x1) -> + Ast_406.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_407.Outcometree.Osig_value x0 -> + Ast_406.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_407.Outcometree.Osig_ellipsis -> Ast_406.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_407.Outcometree.out_val_decl -> Ast_406.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 } - -> + { Ast_407.Outcometree.oval_name = oval_name; + Ast_407.Outcometree.oval_type = oval_type; + Ast_407.Outcometree.oval_prims = oval_prims; + Ast_407.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 = + Ast_406.Outcometree.oval_name = oval_name; + Ast_406.Outcometree.oval_type = (copy_out_type oval_type); + Ast_406.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_406.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 = + Ast_407.Outcometree.out_type_decl -> Ast_406.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 } - -> + { Ast_407.Outcometree.otype_name = otype_name; + Ast_407.Outcometree.otype_params = otype_params; + Ast_407.Outcometree.otype_type = otype_type; + Ast_407.Outcometree.otype_private = otype_private; + Ast_407.Outcometree.otype_immediate = otype_immediate; + Ast_407.Outcometree.otype_unboxed = otype_unboxed; + Ast_407.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_406.Outcometree.otype_name = otype_name; + Ast_406.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_406.Outcometree.otype_type = (copy_out_type otype_type); + Ast_406.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_406.Outcometree.otype_immediate = otype_immediate; + Ast_406.Outcometree.otype_unboxed = otype_unboxed; + Ast_406.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_407.Outcometree.out_module_type -> Ast_406.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) - + | Ast_407.Outcometree.Omty_abstract -> Ast_406.Outcometree.Omty_abstract + | Ast_407.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_406.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_407.Outcometree.Omty_ident x0 -> + Ast_406.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_407.Outcometree.Omty_signature x0 -> + Ast_406.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_407.Outcometree.Omty_alias x0 -> + Ast_406.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_407.Outcometree.out_ext_status -> Ast_406.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 - + | Ast_407.Outcometree.Oext_first -> Ast_406.Outcometree.Oext_first + | Ast_407.Outcometree.Oext_next -> Ast_406.Outcometree.Oext_next + | Ast_407.Outcometree.Oext_exception -> Ast_406.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_407.Outcometree.out_extension_constructor -> + Ast_406.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 } - -> + { Ast_407.Outcometree.oext_name = oext_name; + Ast_407.Outcometree.oext_type_name = oext_type_name; + Ast_407.Outcometree.oext_type_params = oext_type_params; + Ast_407.Outcometree.oext_args = oext_args; + Ast_407.Outcometree.oext_ret_type = oext_ret_type; + Ast_407.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) + Ast_406.Outcometree.oext_name = oext_name; + Ast_406.Outcometree.oext_type_name = oext_type_name; + Ast_406.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_406.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_406.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_406.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_407.Asttypes.private_flag -> Ast_406.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_407.Asttypes.Private -> Ast_406.Asttypes.Private + | Ast_407.Asttypes.Public -> Ast_406.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_407.Outcometree.out_rec_status -> Ast_406.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 - + | Ast_407.Outcometree.Orec_not -> Ast_406.Outcometree.Orec_not + | Ast_407.Outcometree.Orec_first -> Ast_406.Outcometree.Orec_first + | Ast_407.Outcometree.Orec_next -> Ast_406.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), + Ast_407.Outcometree.out_class_type -> Ast_406.Outcometree.out_class_type = + function + | Ast_407.Outcometree.Octy_constr (x0, x1) -> + Ast_406.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_407.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_406.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_407.Outcometree.Octy_signature (x0, x1) -> + Ast_406.Outcometree.Octy_signature + ((Option.map 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 + Ast_407.Outcometree.out_class_sig_item -> + Ast_406.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)) - + | Ast_407.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_406.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_407.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_406.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_407.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_406.Outcometree.Ocsg_value (x0, x1, 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 + Ast_407.Outcometree.out_type -> Ast_406.Outcometree.out_type = + function + | Ast_407.Outcometree.Otyp_abstract -> Ast_406.Outcometree.Otyp_abstract + | Ast_407.Outcometree.Otyp_open -> Ast_406.Outcometree.Otyp_open + | Ast_407.Outcometree.Otyp_alias (x0, x1) -> + Ast_406.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_407.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_407.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_407.Outcometree.Otyp_constr (x0, x1) -> + Ast_406.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_407.Outcometree.Otyp_manifest (x0, x1) -> + Ast_406.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_407.Outcometree.Otyp_object (x0, x1) -> + Ast_406.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_407.Outcometree.Otyp_record x0 -> + Ast_406.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_407.Outcometree.Otyp_stuff x0 -> Ast_406.Outcometree.Otyp_stuff x0 + | Ast_407.Outcometree.Otyp_sum x0 -> + Ast_406.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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 - + (Option.map copy_out_type x2))) x0) + | Ast_407.Outcometree.Otyp_tuple x0 -> + Ast_406.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_407.Outcometree.Otyp_var (x0, x1) -> + Ast_406.Outcometree.Otyp_var (x0, x1) + | Ast_407.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_406.Outcometree.Otyp_variant + (x0, (copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_407.Outcometree.Otyp_poly (x0, x1) -> + Ast_406.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_407.Outcometree.Otyp_module (x0, x1, x2) -> + Ast_406.Outcometree.Otyp_module + (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) + | Ast_407.Outcometree.Otyp_attribute (x0, x1) -> + Ast_406.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 } - + Ast_407.Outcometree.out_attribute -> Ast_406.Outcometree.out_attribute = + fun { Ast_407.Outcometree.oattr_name = oattr_name } -> + { Ast_406.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_407.Outcometree.out_variant -> Ast_406.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_407.Outcometree.Ovar_fields x0 -> + Ast_406.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_407.Outcometree.Ovar_typ x0 -> + Ast_406.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 + Ast_407.Outcometree.out_value -> Ast_406.Outcometree.out_value = + function + | Ast_407.Outcometree.Oval_array x0 -> + Ast_406.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_char x0 -> Ast_406.Outcometree.Oval_char x0 + | Ast_407.Outcometree.Oval_constr (x0, x1) -> + Ast_406.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_407.Outcometree.Oval_ellipsis -> Ast_406.Outcometree.Oval_ellipsis + | Ast_407.Outcometree.Oval_float x0 -> Ast_406.Outcometree.Oval_float x0 + | Ast_407.Outcometree.Oval_int x0 -> Ast_406.Outcometree.Oval_int x0 + | Ast_407.Outcometree.Oval_int32 x0 -> Ast_406.Outcometree.Oval_int32 x0 + | Ast_407.Outcometree.Oval_int64 x0 -> Ast_406.Outcometree.Oval_int64 x0 + | Ast_407.Outcometree.Oval_nativeint x0 -> + Ast_406.Outcometree.Oval_nativeint x0 + | Ast_407.Outcometree.Oval_list x0 -> + Ast_406.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_printer x0 -> + Ast_406.Outcometree.Oval_printer x0 + | Ast_407.Outcometree.Oval_record x0 -> + Ast_406.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 = + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_407.Outcometree.Oval_string (x0, x1, x2) -> + Ast_406.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_407.Outcometree.Oval_stuff x0 -> Ast_406.Outcometree.Oval_stuff x0 + | Ast_407.Outcometree.Oval_tuple x0 -> + Ast_406.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_variant (x0, x1) -> + Ast_406.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_407.Outcometree.out_string -> Ast_406.Outcometree.out_string = 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 + | Ast_407.Outcometree.Ostr_string -> Ast_406.Outcometree.Ostr_string + | Ast_407.Outcometree.Ostr_bytes -> Ast_406.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_407.Outcometree.out_ident -> Ast_406.Outcometree.out_ident = + function + | Ast_407.Outcometree.Oide_apply (x0, x1) -> + Ast_406.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_407.Outcometree.Oide_dot (x0, x1) -> + Ast_406.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_407.Outcometree.Oide_ident x0 -> Ast_406.Outcometree.Oide_ident x0 diff --git a/src/vendored-omp/src/migrate_parsetree_407_408.ml b/src/vendored-omp/src/migrate_parsetree_407_408.ml index f9af1f5cd..9c8514983 100644 --- a/src/vendored-omp/src/migrate_parsetree_407_408.ml +++ b/src/vendored-omp/src/migrate_parsetree_407_408.ml @@ -15,124 +15,3 @@ 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-omp/src/migrate_parsetree_407_408_migrate.ml b/src/vendored-omp/src/migrate_parsetree_407_408_migrate.ml index a0429ec92..e26aa2292 100644 --- a/src/vendored-omp/src/migrate_parsetree_407_408_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_407_408_migrate.ml @@ -1,1808 +1,309 @@ +open Stdlib0 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 +let rec copy_out_type_extension : + Ast_407.Outcometree.out_type_extension -> + Ast_408.Outcometree.out_type_extension = - 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 } + { Ast_407.Outcometree.otyext_name = otyext_name; + Ast_407.Outcometree.otyext_params = otyext_params; + Ast_407.Outcometree.otyext_constructors = otyext_constructors; + Ast_407.Outcometree.otyext_private = otyext_private } -> - 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 = + 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 - ((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 + (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) } - -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 = +and copy_out_phrase : + Ast_407.Outcometree.out_phrase -> Ast_408.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 + | Ast_407.Outcometree.Ophr_eval (x0, x1) -> + Ast_408.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_407.Outcometree.Ophr_signature x0 -> + Ast_408.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 - + (fun x -> + let (x0, x1) = x in + ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) + | Ast_407.Outcometree.Ophr_exception x0 -> + Ast_408.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_407.Outcometree.out_sig_item -> Ast_408.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_407.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 ((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, + (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_407.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 ((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 - + (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_407.Outcometree.Osig_typext (x0, x1) -> + Ast_408.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_407.Outcometree.Osig_modtype (x0, x1) -> + Ast_408.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_407.Outcometree.Osig_module (x0, x1, x2) -> + Ast_408.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_407.Outcometree.Osig_type (x0, x1) -> + Ast_408.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_407.Outcometree.Osig_value x0 -> + Ast_408.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_407.Outcometree.Osig_ellipsis -> Ast_408.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_407.Outcometree.out_val_decl -> Ast_408.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 } - -> + { Ast_407.Outcometree.oval_name = oval_name; + Ast_407.Outcometree.oval_type = oval_type; + Ast_407.Outcometree.oval_prims = oval_prims; + Ast_407.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 = + 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 : - From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = + Ast_407.Outcometree.out_type_decl -> Ast_408.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 } - -> + { Ast_407.Outcometree.otype_name = otype_name; + Ast_407.Outcometree.otype_params = otype_params; + Ast_407.Outcometree.otype_type = otype_type; + Ast_407.Outcometree.otype_private = otype_private; + Ast_407.Outcometree.otype_immediate = otype_immediate; + Ast_407.Outcometree.otype_unboxed = otype_unboxed; + Ast_407.Outcometree.otype_cstrs = otype_cstrs } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + 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 ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + 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) + (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 + Ast_407.Outcometree.out_module_type -> Ast_408.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) - + | Ast_407.Outcometree.Omty_abstract -> Ast_408.Outcometree.Omty_abstract + | Ast_407.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_407.Outcometree.Omty_ident x0 -> + Ast_408.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_407.Outcometree.Omty_signature x0 -> + Ast_408.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_407.Outcometree.Omty_alias x0 -> + Ast_408.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_407.Outcometree.out_ext_status -> Ast_408.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 - + | Ast_407.Outcometree.Oext_first -> Ast_408.Outcometree.Oext_first + | Ast_407.Outcometree.Oext_next -> Ast_408.Outcometree.Oext_next + | Ast_407.Outcometree.Oext_exception -> Ast_408.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_407.Outcometree.out_extension_constructor -> + Ast_408.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 } - -> + { Ast_407.Outcometree.oext_name = oext_name; + Ast_407.Outcometree.oext_type_name = oext_type_name; + Ast_407.Outcometree.oext_type_params = oext_type_params; + Ast_407.Outcometree.oext_args = oext_args; + Ast_407.Outcometree.oext_ret_type = oext_ret_type; + Ast_407.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) + 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_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_407.Asttypes.private_flag -> Ast_408.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_407.Asttypes.Private -> Ast_408.Asttypes.Private + | Ast_407.Asttypes.Public -> Ast_408.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_407.Outcometree.out_rec_status -> Ast_408.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 - + | Ast_407.Outcometree.Orec_not -> Ast_408.Outcometree.Orec_not + | Ast_407.Outcometree.Orec_first -> Ast_408.Outcometree.Orec_first + | Ast_407.Outcometree.Orec_next -> Ast_408.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), + Ast_407.Outcometree.out_class_type -> Ast_408.Outcometree.out_class_type = + function + | Ast_407.Outcometree.Octy_constr (x0, x1) -> + Ast_408.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_407.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_408.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_407.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 : - From.Outcometree.out_class_sig_item -> - To.Outcometree.out_class_sig_item + Ast_407.Outcometree.out_class_sig_item -> + Ast_408.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)) - + | Ast_407.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_408.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_407.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_408.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_407.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_408.Outcometree.Ocsg_value (x0, x1, 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 + Ast_407.Outcometree.out_type -> Ast_408.Outcometree.out_type = + function + | Ast_407.Outcometree.Otyp_abstract -> Ast_408.Outcometree.Otyp_abstract + | Ast_407.Outcometree.Otyp_open -> Ast_408.Outcometree.Otyp_open + | Ast_407.Outcometree.Otyp_alias (x0, x1) -> + Ast_408.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_407.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_408.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_407.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_408.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_407.Outcometree.Otyp_constr (x0, x1) -> + Ast_408.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_407.Outcometree.Otyp_manifest (x0, x1) -> + Ast_408.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_407.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_407.Outcometree.Otyp_record x0 -> + Ast_408.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_407.Outcometree.Otyp_stuff x0 -> Ast_408.Outcometree.Otyp_stuff x0 + | Ast_407.Outcometree.Otyp_sum x0 -> + Ast_408.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) + (Option.map copy_out_type x2))) x0) + | Ast_407.Outcometree.Otyp_tuple x0 -> + Ast_408.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_407.Outcometree.Otyp_var (x0, x1) -> + Ast_408.Outcometree.Otyp_var (x0, x1) + | Ast_407.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_407.Outcometree.Otyp_poly (x0, x1) -> + Ast_408.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 - + | Ast_407.Outcometree.Otyp_attribute (x0, x1) -> + Ast_408.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 } - + Ast_407.Outcometree.out_attribute -> Ast_408.Outcometree.out_attribute = + fun { Ast_407.Outcometree.oattr_name = oattr_name } -> + { Ast_408.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_407.Outcometree.out_variant -> Ast_408.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_407.Outcometree.Ovar_fields x0 -> + Ast_408.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_407.Outcometree.Ovar_typ x0 -> + Ast_408.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 + Ast_407.Outcometree.out_value -> Ast_408.Outcometree.out_value = + function + | Ast_407.Outcometree.Oval_array x0 -> + Ast_408.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_char x0 -> Ast_408.Outcometree.Oval_char x0 + | Ast_407.Outcometree.Oval_constr (x0, x1) -> + Ast_408.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_407.Outcometree.Oval_ellipsis -> Ast_408.Outcometree.Oval_ellipsis + | Ast_407.Outcometree.Oval_float x0 -> Ast_408.Outcometree.Oval_float x0 + | Ast_407.Outcometree.Oval_int x0 -> Ast_408.Outcometree.Oval_int x0 + | Ast_407.Outcometree.Oval_int32 x0 -> Ast_408.Outcometree.Oval_int32 x0 + | Ast_407.Outcometree.Oval_int64 x0 -> Ast_408.Outcometree.Oval_int64 x0 + | Ast_407.Outcometree.Oval_nativeint x0 -> + Ast_408.Outcometree.Oval_nativeint x0 + | Ast_407.Outcometree.Oval_list x0 -> + Ast_408.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_printer x0 -> + Ast_408.Outcometree.Oval_printer x0 + | Ast_407.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) - | 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 = + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_407.Outcometree.Oval_string (x0, x1, x2) -> + Ast_408.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_407.Outcometree.Oval_stuff x0 -> Ast_408.Outcometree.Oval_stuff x0 + | Ast_407.Outcometree.Oval_tuple x0 -> + Ast_408.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_407.Outcometree.Oval_variant (x0, x1) -> + Ast_408.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_407.Outcometree.out_string -> Ast_408.Outcometree.out_string = 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 -> + | Ast_407.Outcometree.Ostr_string -> Ast_408.Outcometree.Ostr_string + | Ast_407.Outcometree.Ostr_bytes -> Ast_408.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_407.Outcometree.out_ident -> Ast_408.Outcometree.out_ident = + function + | Ast_407.Outcometree.Oide_apply (x0, x1) -> + Ast_408.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_407.Outcometree.Oide_dot (x0, x1) -> + Ast_408.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_407.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-omp/src/migrate_parsetree_408_407.ml b/src/vendored-omp/src/migrate_parsetree_408_407.ml index 050d412e1..44e99a233 100644 --- a/src/vendored-omp/src/migrate_parsetree_408_407.ml +++ b/src/vendored-omp/src/migrate_parsetree_408_407.ml @@ -15,121 +15,3 @@ 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-omp/src/migrate_parsetree_408_407_migrate.ml b/src/vendored-omp/src/migrate_parsetree_408_407_migrate.ml index a9952e4a9..46b0a744a 100644 --- a/src/vendored-omp/src/migrate_parsetree_408_407_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_408_407_migrate.ml @@ -1,1707 +1,245 @@ -module From = Ast_408 -module To = Ast_407 - +open Stdlib0 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 +module From = Ast_408 +module To = Ast_407 +let rec copy_out_type_extension : + Ast_408.Outcometree.out_type_extension -> + Ast_407.Outcometree.out_type_extension = - 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 } + { 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 } -> - { 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 = + Ast_407.Outcometree.otyext_name = otyext_name; + Ast_407.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_407.Outcometree.otyext_constructors = (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 + (fun x -> + let (x0, x1, x2) = x in + (x0, (List.map copy_out_type x1), + (Option.map copy_out_type x2))) otyext_constructors); + Ast_407.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 - -let rec copy_out_phrase : - From.Outcometree.out_phrase -> To.Outcometree.out_phrase = +and copy_out_phrase : + Ast_408.Outcometree.out_phrase -> Ast_407.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 + | Ast_408.Outcometree.Ophr_eval (x0, x1) -> + Ast_407.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_408.Outcometree.Ophr_signature x0 -> + Ast_407.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 - + (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_407.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : - From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = + Ast_408.Outcometree.out_sig_item -> Ast_407.Outcometree.out_sig_item = function - | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> - To.Outcometree.Osig_class - ((copy_bool x0), x1, + | Ast_408.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_407.Outcometree.Osig_class + (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, + (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_407.Outcometree.Osig_class_type + (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 - + (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_407.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_408.Outcometree.Osig_modtype (x0, x1) -> + Ast_407.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_408.Outcometree.Osig_module (x0, x1, x2) -> + Ast_407.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_408.Outcometree.Osig_type (x0, x1) -> + Ast_407.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_408.Outcometree.Osig_value x0 -> + Ast_407.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_408.Outcometree.Osig_ellipsis -> Ast_407.Outcometree.Osig_ellipsis and copy_out_val_decl : - From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = + Ast_408.Outcometree.out_val_decl -> Ast_407.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 } - -> + { 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 } + -> { - 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 = + Ast_407.Outcometree.oval_name = oval_name; + Ast_407.Outcometree.oval_type = (copy_out_type oval_type); + Ast_407.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_407.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 } - -> + Ast_408.Outcometree.out_type_decl -> Ast_407.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 } + -> { - To.Outcometree.otype_name = otype_name; - To.Outcometree.otype_params = + Ast_407.Outcometree.otype_name = otype_name; + Ast_407.Outcometree.otype_params = (List.map - (fun x -> - let (x0,x1) = x in - (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) + (fun x -> + let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, 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 = + Ast_407.Outcometree.otype_type = (copy_out_type otype_type); + Ast_407.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_407.Outcometree.otype_immediate = otype_immediate; + Ast_407.Outcometree.otype_unboxed = otype_unboxed; + Ast_407.Outcometree.otype_cstrs = (List.map - (fun x -> - let (x0,x1) = x in - ((copy_out_type x0), - (copy_out_type x1))) otype_cstrs) + (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 + Ast_408.Outcometree.out_module_type -> Ast_407.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) - + | Ast_408.Outcometree.Omty_abstract -> Ast_407.Outcometree.Omty_abstract + | Ast_408.Outcometree.Omty_functor (x0, x1, x2) -> + Ast_407.Outcometree.Omty_functor + (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) + | Ast_408.Outcometree.Omty_ident x0 -> + Ast_407.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_408.Outcometree.Omty_signature x0 -> + Ast_407.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_408.Outcometree.Omty_alias x0 -> + Ast_407.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : - From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = + Ast_408.Outcometree.out_ext_status -> Ast_407.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 - + | Ast_408.Outcometree.Oext_first -> Ast_407.Outcometree.Oext_first + | Ast_408.Outcometree.Oext_next -> Ast_407.Outcometree.Oext_next + | Ast_408.Outcometree.Oext_exception -> Ast_407.Outcometree.Oext_exception and copy_out_extension_constructor : - From.Outcometree.out_extension_constructor -> - To.Outcometree.out_extension_constructor + Ast_408.Outcometree.out_extension_constructor -> + Ast_407.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 } - -> + { 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 } + -> { - 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) + Ast_407.Outcometree.oext_name = oext_name; + Ast_407.Outcometree.oext_type_name = oext_type_name; + Ast_407.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_407.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_407.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_407.Outcometree.oext_private = (copy_private_flag oext_private) } - -and copy_From_Asttypes_private_flag : - From.Asttypes.private_flag -> To.Asttypes.private_flag = +and copy_private_flag : + Ast_408.Asttypes.private_flag -> Ast_407.Asttypes.private_flag = function - | From.Asttypes.Private -> To.Asttypes.Private - | From.Asttypes.Public -> To.Asttypes.Public - + | Ast_408.Asttypes.Private -> Ast_407.Asttypes.Private + | Ast_408.Asttypes.Public -> Ast_407.Asttypes.Public and copy_out_rec_status : - From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = + Ast_408.Outcometree.out_rec_status -> Ast_407.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 - + | Ast_408.Outcometree.Orec_not -> Ast_407.Outcometree.Orec_not + | Ast_408.Outcometree.Orec_first -> Ast_407.Outcometree.Orec_first + | Ast_408.Outcometree.Orec_next -> Ast_407.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), + Ast_408.Outcometree.out_class_type -> Ast_407.Outcometree.out_class_type = + function + | Ast_408.Outcometree.Octy_constr (x0, x1) -> + Ast_407.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_408.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_407.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_408.Outcometree.Octy_signature (x0, x1) -> + Ast_407.Outcometree.Octy_signature + ((Option.map 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 + Ast_408.Outcometree.out_class_sig_item -> + Ast_407.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)) - + | Ast_408.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_407.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_408.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_407.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_408.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_407.Outcometree.Ocsg_value (x0, x1, 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 + Ast_408.Outcometree.out_type -> Ast_407.Outcometree.out_type = + function + | Ast_408.Outcometree.Otyp_abstract -> Ast_407.Outcometree.Otyp_abstract + | Ast_408.Outcometree.Otyp_open -> Ast_407.Outcometree.Otyp_open + | Ast_408.Outcometree.Otyp_alias (x0, x1) -> + Ast_407.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_408.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_407.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_408.Outcometree.Otyp_class (x0, x1, x2) -> + Ast_407.Outcometree.Otyp_class + (x0, (copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_408.Outcometree.Otyp_constr (x0, x1) -> + Ast_407.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_408.Outcometree.Otyp_manifest (x0, x1) -> + Ast_407.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_408.Outcometree.Otyp_object (x0, x1) -> + Ast_407.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_407.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 + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_408.Outcometree.Otyp_stuff x0 -> Ast_407.Outcometree.Otyp_stuff x0 + | Ast_408.Outcometree.Otyp_sum x0 -> + Ast_407.Outcometree.Otyp_sum (List.map - (fun x -> - let (x0,x1,x2) = x in + (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)) + (Option.map copy_out_type x2))) x0) + | Ast_408.Outcometree.Otyp_tuple x0 -> + Ast_407.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_408.Outcometree.Otyp_var (x0, x1) -> + Ast_407.Outcometree.Otyp_var (x0, x1) + | Ast_408.Outcometree.Otyp_variant (x0, x1, x2, x3) -> + Ast_407.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_407.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 @@ -1711,109 +249,68 @@ and copy_out_type : 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 - + | Ast_408.Outcometree.Otyp_attribute (x0, x1) -> + Ast_407.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 } - + Ast_408.Outcometree.out_attribute -> Ast_407.Outcometree.out_attribute = + fun { Ast_408.Outcometree.oattr_name = oattr_name } -> + { Ast_407.Outcometree.oattr_name = oattr_name } and copy_out_variant : - From.Outcometree.out_variant -> To.Outcometree.out_variant = + Ast_408.Outcometree.out_variant -> Ast_407.Outcometree.out_variant = function - | From.Outcometree.Ovar_fields x0 -> - To.Outcometree.Ovar_fields + | Ast_408.Outcometree.Ovar_fields x0 -> + Ast_407.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) - + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_408.Outcometree.Ovar_typ x0 -> + Ast_407.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 + Ast_408.Outcometree.out_value -> Ast_407.Outcometree.out_value = + function + | Ast_408.Outcometree.Oval_array x0 -> + Ast_407.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_char x0 -> Ast_407.Outcometree.Oval_char x0 + | Ast_408.Outcometree.Oval_constr (x0, x1) -> + Ast_407.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_408.Outcometree.Oval_ellipsis -> Ast_407.Outcometree.Oval_ellipsis + | Ast_408.Outcometree.Oval_float x0 -> Ast_407.Outcometree.Oval_float x0 + | Ast_408.Outcometree.Oval_int x0 -> Ast_407.Outcometree.Oval_int x0 + | Ast_408.Outcometree.Oval_int32 x0 -> Ast_407.Outcometree.Oval_int32 x0 + | Ast_408.Outcometree.Oval_int64 x0 -> Ast_407.Outcometree.Oval_int64 x0 + | Ast_408.Outcometree.Oval_nativeint x0 -> + Ast_407.Outcometree.Oval_nativeint x0 + | Ast_408.Outcometree.Oval_list x0 -> + Ast_407.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_printer x0 -> + Ast_407.Outcometree.Oval_printer x0 + | Ast_408.Outcometree.Oval_record x0 -> + Ast_407.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 - + (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_407.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_408.Outcometree.Oval_stuff x0 -> Ast_407.Outcometree.Oval_stuff x0 + | Ast_408.Outcometree.Oval_tuple x0 -> + Ast_407.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_408.Outcometree.Oval_variant (x0, x1) -> + Ast_407.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_408.Outcometree.out_string -> Ast_407.Outcometree.out_string = + function + | Ast_408.Outcometree.Ostr_string -> Ast_407.Outcometree.Ostr_string + | Ast_408.Outcometree.Ostr_bytes -> Ast_407.Outcometree.Ostr_bytes and copy_out_ident : - From.Outcometree.out_ident -> To.Outcometree.out_ident = + Ast_408.Outcometree.out_ident -> Ast_407.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) + | Ast_408.Outcometree.Oide_apply (x0, x1) -> + Ast_407.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_408.Outcometree.Oide_dot (x0, x1) -> + Ast_407.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-omp/src/migrate_parsetree_408_409.ml b/src/vendored-omp/src/migrate_parsetree_408_409.ml index 48bfd1e48..9e2ee6155 100644 --- a/src/vendored-omp/src/migrate_parsetree_408_409.ml +++ b/src/vendored-omp/src/migrate_parsetree_408_409.ml @@ -15,126 +15,3 @@ 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-omp/src/migrate_parsetree_408_409_migrate.ml b/src/vendored-omp/src/migrate_parsetree_408_409_migrate.ml index 297b53bc2..c0e74e414 100644 --- a/src/vendored-omp/src/migrate_parsetree_408_409_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_408_409_migrate.ml @@ -153,6 +153,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) } +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_out_rec_status : Ast_408.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = function @@ -304,1198 +309,3 @@ 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-omp/src/migrate_parsetree_409_408.ml b/src/vendored-omp/src/migrate_parsetree_409_408.ml index b0754d676..6ca433ce4 100644 --- a/src/vendored-omp/src/migrate_parsetree_409_408.ml +++ b/src/vendored-omp/src/migrate_parsetree_409_408.ml @@ -15,126 +15,3 @@ 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-omp/src/migrate_parsetree_409_408_migrate.ml b/src/vendored-omp/src/migrate_parsetree_409_408_migrate.ml index 3cddd11fd..5abf394e7 100644 --- a/src/vendored-omp/src/migrate_parsetree_409_408_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_409_408_migrate.ml @@ -153,6 +153,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_408.Outcometree.oext_private = (copy_private_flag oext_private) } +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_out_rec_status : Ast_409.Outcometree.out_rec_status -> Ast_408.Outcometree.out_rec_status = function @@ -304,1198 +309,3 @@ 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-omp/src/migrate_parsetree_409_410.ml b/src/vendored-omp/src/migrate_parsetree_409_410.ml index 81006e9c5..846397543 100644 --- a/src/vendored-omp/src/migrate_parsetree_409_410.ml +++ b/src/vendored-omp/src/migrate_parsetree_409_410.ml @@ -14,127 +14,3 @@ (**************************************************************************) 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-omp/src/migrate_parsetree_409_410_migrate.ml b/src/vendored-omp/src/migrate_parsetree_409_410_migrate.ml index b4d507d91..69f60450c 100644 --- a/src/vendored-omp/src/migrate_parsetree_409_410_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_409_410_migrate.ml @@ -1,12 +1,9 @@ +open Stdlib0 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 + Ast_410.Outcometree.out_type_extension = fun { Ast_409.Outcometree.otyext_name = otyext_name; @@ -14,18 +11,18 @@ let rec copy_out_type_extension : 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) - } + { + 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_409.Outcometree.out_phrase -> Ast_410.Outcometree.out_phrase = function @@ -36,7 +33,7 @@ and copy_out_phrase : (List.map (fun x -> let (x0, x1) = x in - ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) + ((copy_out_sig_item x0), (Option.map 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))) @@ -46,17 +43,17 @@ and copy_out_sig_item : | 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)) + (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)) + (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)) @@ -79,13 +76,13 @@ and copy_out_val_decl : 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) - } + { + 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 @@ -141,7 +138,7 @@ and copy_out_ext_status : | 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 + Ast_410.Outcometree.out_extension_constructor = fun { Ast_409.Outcometree.oext_name = oext_name; @@ -151,16 +148,21 @@ and copy_out_extension_constructor : 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) - } + { + 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_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_out_rec_status : Ast_409.Outcometree.out_rec_status -> Ast_410.Outcometree.out_rec_status = function @@ -178,11 +180,11 @@ and copy_out_class_type : (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)) + ((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_410.Outcometree.out_class_sig_item + Ast_410.Outcometree.out_class_sig_item = function | Ast_409.Outcometree.Ocsg_constraint (x0, x1) -> @@ -214,7 +216,7 @@ and copy_out_type : | 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)) + (Option.map (fun x -> x) x1)) | Ast_409.Outcometree.Otyp_record x0 -> Ast_410.Outcometree.Otyp_record (List.map @@ -226,7 +228,7 @@ and copy_out_type : (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), - (map_option copy_out_type x2))) x0) + (Option.map 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) -> @@ -234,21 +236,21 @@ and copy_out_type : | 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)) + (Option.map (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)) + (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 } + { Ast_410.Outcometree.oattr_name = oattr_name } and copy_out_variant : Ast_409.Outcometree.out_variant -> Ast_410.Outcometree.out_variant = function @@ -292,7 +294,7 @@ and copy_out_value : | 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)) + Ast_410.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) and copy_out_string : Ast_409.Outcometree.out_string -> Ast_410.Outcometree.out_string = function @@ -311,1204 +313,4 @@ and copy_out_ident : 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 + { Ast_410.Outcometree.printed_name = printed_name } diff --git a/src/vendored-omp/src/migrate_parsetree_410_409.ml b/src/vendored-omp/src/migrate_parsetree_410_409.ml index ec7aae543..42576f02b 100644 --- a/src/vendored-omp/src/migrate_parsetree_410_409.ml +++ b/src/vendored-omp/src/migrate_parsetree_410_409.ml @@ -15,126 +15,3 @@ 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-omp/src/migrate_parsetree_410_409_migrate.ml b/src/vendored-omp/src/migrate_parsetree_410_409_migrate.ml index b57a859d2..28e123f63 100644 --- a/src/vendored-omp/src/migrate_parsetree_410_409_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_410_409_migrate.ml @@ -1,16 +1,13 @@ +open Stdlib0 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 @@ -30,7 +27,7 @@ let rec copy_out_type_extension : (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), - (map_option copy_out_type x2))) otyext_constructors); + (Option.map copy_out_type x2))) otyext_constructors); Ast_409.Outcometree.otyext_private = (copy_private_flag otyext_private) } and copy_out_phrase : @@ -43,7 +40,7 @@ and copy_out_phrase : (List.map (fun x -> let (x0, x1) = x in - ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) + ((copy_out_sig_item x0), (Option.map 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))) @@ -173,9 +170,14 @@ and copy_out_extension_constructor : (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); + (Option.map copy_out_type oext_ret_type); Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) } +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_out_rec_status : Ast_410.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = function @@ -193,7 +195,7 @@ and copy_out_class_type : (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), + ((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 -> @@ -229,7 +231,7 @@ and copy_out_type : | 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)) + (Option.map (fun x -> x) x1)) | Ast_410.Outcometree.Otyp_record x0 -> Ast_409.Outcometree.Otyp_record (List.map @@ -241,7 +243,7 @@ and copy_out_type : (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), - (map_option copy_out_type x2))) x0) + (Option.map 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) -> @@ -249,7 +251,7 @@ and copy_out_type : | 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)) + (Option.map (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)) @@ -307,7 +309,7 @@ and copy_out_value : | 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)) + Ast_409.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) and copy_out_string : Ast_410.Outcometree.out_string -> Ast_409.Outcometree.out_string = function @@ -327,1217 +329,3 @@ 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-omp/src/migrate_parsetree_410_411.ml b/src/vendored-omp/src/migrate_parsetree_410_411.ml index 2c8775243..54611d7ac 100644 --- a/src/vendored-omp/src/migrate_parsetree_410_411.ml +++ b/src/vendored-omp/src/migrate_parsetree_410_411.ml @@ -14,128 +14,3 @@ (**************************************************************************) 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-omp/src/migrate_parsetree_410_411_migrate.ml b/src/vendored-omp/src/migrate_parsetree_410_411_migrate.ml index c807845bf..4743e2323 100644 --- a/src/vendored-omp/src/migrate_parsetree_410_411_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_410_411_migrate.ml @@ -165,6 +165,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_411.Outcometree.oext_private = (copy_private_flag oext_private) } +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_out_rec_status : Ast_410.Outcometree.out_rec_status -> Ast_411.Outcometree.out_rec_status = function @@ -316,1207 +321,3 @@ 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-omp/src/migrate_parsetree_411_410.ml b/src/vendored-omp/src/migrate_parsetree_411_410.ml index 6fefc35f8..0c0e10c8c 100644 --- a/src/vendored-omp/src/migrate_parsetree_411_410.ml +++ b/src/vendored-omp/src/migrate_parsetree_411_410.ml @@ -15,128 +15,3 @@ 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-omp/src/migrate_parsetree_411_410_migrate.ml b/src/vendored-omp/src/migrate_parsetree_411_410_migrate.ml index b0687a92f..b0de66680 100644 --- a/src/vendored-omp/src/migrate_parsetree_411_410_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_411_410_migrate.ml @@ -165,6 +165,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_410.Outcometree.oext_private = (copy_private_flag oext_private) } +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_out_rec_status : Ast_411.Outcometree.out_rec_status -> Ast_410.Outcometree.out_rec_status = function @@ -316,1208 +321,3 @@ 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-omp/src/migrate_parsetree_411_412.ml b/src/vendored-omp/src/migrate_parsetree_411_412.ml index ac90feb51..6472d7081 100644 --- a/src/vendored-omp/src/migrate_parsetree_411_412.ml +++ b/src/vendored-omp/src/migrate_parsetree_411_412.ml @@ -15,129 +15,3 @@ include Migrate_parsetree_411_412_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_412_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))); - constant = (fun _ x -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } diff --git a/src/vendored-omp/src/migrate_parsetree_411_412_migrate.ml b/src/vendored-omp/src/migrate_parsetree_411_412_migrate.ml index fe88a13c8..3bccf76cd 100644 --- a/src/vendored-omp/src/migrate_parsetree_411_412_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_411_412_migrate.ml @@ -37,14 +37,14 @@ and copy_out_phrase : | Ast_411.Outcometree.Ophr_exception x0 -> Ast_412.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) + and copy_out_type_param : string * (bool * bool) -> Ast_412.Outcometree.out_type_param = function (str, v) -> let v = match v with | (true, false) -> Ast_412.Asttypes.Covariant | (false, true) -> Ast_412.Asttypes.Contravariant - | (false, false) -> Ast_412.Asttypes.NoVariance - | _ -> assert false + | (false, false) | (true, true) -> Ast_412.Asttypes.NoVariance in str, (v, Ast_412.Asttypes.NoInjectivity) @@ -169,6 +169,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_412.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_411.Asttypes.private_flag -> Ast_412.Asttypes.private_flag = + function + | Ast_411.Asttypes.Private -> Ast_412.Asttypes.Private + | Ast_411.Asttypes.Public -> Ast_412.Asttypes.Public and copy_out_rec_status : Ast_411.Outcometree.out_rec_status -> Ast_412.Outcometree.out_rec_status = function @@ -320,1209 +325,3 @@ and copy_out_name : Ast_411.Outcometree.out_name -> Ast_412.Outcometree.out_name = fun { Ast_411.Outcometree.printed_name = printed_name } -> { Ast_412.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_411.Parsetree.toplevel_phrase -> Ast_412.Parsetree.toplevel_phrase = - function - | Ast_411.Parsetree.Ptop_def x0 -> - Ast_412.Parsetree.Ptop_def (copy_structure x0) - | Ast_411.Parsetree.Ptop_dir x0 -> - Ast_412.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_411.Parsetree.toplevel_directive -> - Ast_412.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_412.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_412.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_412.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_411.Parsetree.directive_argument -> - Ast_412.Parsetree.directive_argument - = - fun - { Ast_411.Parsetree.pdira_desc = pdira_desc; - Ast_411.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_412.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_412.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_411.Parsetree.directive_argument_desc -> - Ast_412.Parsetree.directive_argument_desc - = - function - | Ast_411.Parsetree.Pdir_string x0 -> Ast_412.Parsetree.Pdir_string x0 - | Ast_411.Parsetree.Pdir_int (x0, x1) -> - Ast_412.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_411.Parsetree.Pdir_ident x0 -> - Ast_412.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_411.Parsetree.Pdir_bool x0 -> Ast_412.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_411.Parsetree.expression -> Ast_412.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_412.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_412.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_412.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_412.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expr x = copy_expression x -and copy_expression_desc : - Ast_411.Parsetree.expression_desc -> Ast_412.Parsetree.expression_desc = - function - | Ast_411.Parsetree.Pexp_ident x0 -> - Ast_412.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_411.Parsetree.Pexp_constant x0 -> - Ast_412.Parsetree.Pexp_constant (copy_constant x0) - | Ast_411.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_411.Parsetree.Pexp_function x0 -> - Ast_412.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_411.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_412.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_412.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_412.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_411.Parsetree.Pexp_try (x0, x1) -> - Ast_412.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_411.Parsetree.Pexp_tuple x0 -> - Ast_412.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_411.Parsetree.Pexp_construct (x0, x1) -> - Ast_412.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_411.Parsetree.Pexp_variant (x0, x1) -> - Ast_412.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_411.Parsetree.Pexp_record (x0, x1) -> - Ast_412.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_412.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_411.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_411.Parsetree.Pexp_array x0 -> - Ast_412.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_411.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_411.Parsetree.Pexp_sequence (x0, x1) -> - Ast_412.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_while (x0, x1) -> - Ast_412.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_412.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_412.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_411.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_411.Parsetree.Pexp_send (x0, x1) -> - Ast_412.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_411.Parsetree.Pexp_new x0 -> - Ast_412.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_411.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_412.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_override x0 -> - Ast_412.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_412.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_412.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_assert x0 -> - Ast_412.Parsetree.Pexp_assert (copy_expression x0) - | Ast_411.Parsetree.Pexp_lazy x0 -> - Ast_412.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_411.Parsetree.Pexp_poly (x0, x1) -> - Ast_412.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_411.Parsetree.Pexp_object x0 -> - Ast_412.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_411.Parsetree.Pexp_newtype (x0, x1) -> - Ast_412.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_pack x0 -> - Ast_412.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_411.Parsetree.Pexp_open (x0, x1) -> - Ast_412.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_411.Parsetree.Pexp_letop x0 -> - Ast_412.Parsetree.Pexp_letop (copy_letop x0) - | Ast_411.Parsetree.Pexp_extension x0 -> - Ast_412.Parsetree.Pexp_extension (copy_extension x0) - | Ast_411.Parsetree.Pexp_unreachable -> Ast_412.Parsetree.Pexp_unreachable -and copy_letop : Ast_411.Parsetree.letop -> Ast_412.Parsetree.letop = - fun - { Ast_411.Parsetree.let_ = let_; Ast_411.Parsetree.ands = ands; - Ast_411.Parsetree.body = body } - -> - { - Ast_412.Parsetree.let_ = (copy_binding_op let_); - Ast_412.Parsetree.ands = (List.map copy_binding_op ands); - Ast_412.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_411.Parsetree.binding_op -> Ast_412.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_412.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_412.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_412.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_412.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_411.Asttypes.direction_flag -> Ast_412.Asttypes.direction_flag = - function - | Ast_411.Asttypes.Upto -> Ast_412.Asttypes.Upto - | Ast_411.Asttypes.Downto -> Ast_412.Asttypes.Downto -and copy_cases : Ast_411.Parsetree.case list -> Ast_412.Parsetree.case list = - fun x -> List.map copy_case x -and copy_case : Ast_411.Parsetree.case -> Ast_412.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_412.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_412.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_412.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_411.Parsetree.value_binding -> Ast_412.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_412.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_412.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_412.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_412.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_411.Parsetree.pattern -> Ast_412.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_412.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_412.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_412.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_412.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pat x = copy_pattern x -and copy_pattern_desc : - Ast_411.Parsetree.pattern_desc -> Ast_412.Parsetree.pattern_desc = - function - | Ast_411.Parsetree.Ppat_any -> Ast_412.Parsetree.Ppat_any - | Ast_411.Parsetree.Ppat_var x0 -> - Ast_412.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_411.Parsetree.Ppat_alias (x0, x1) -> - Ast_412.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_411.Parsetree.Ppat_constant x0 -> - Ast_412.Parsetree.Ppat_constant (copy_constant x0) - | Ast_411.Parsetree.Ppat_interval (x0, x1) -> - Ast_412.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_411.Parsetree.Ppat_tuple x0 -> - Ast_412.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_411.Parsetree.Ppat_construct (x0, x1) -> - Ast_412.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) - | Ast_411.Parsetree.Ppat_variant (x0, x1) -> - Ast_412.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_411.Parsetree.Ppat_record (x0, x1) -> - Ast_412.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_412.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_411.Parsetree.Ppat_or (x0, x1) -> - Ast_412.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_411.Parsetree.Ppat_constraint (x0, x1) -> - Ast_412.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_411.Parsetree.Ppat_type x0 -> - Ast_412.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_411.Parsetree.Ppat_lazy x0 -> - Ast_412.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_411.Parsetree.Ppat_unpack x0 -> - Ast_412.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_411.Parsetree.Ppat_exception x0 -> - Ast_412.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_411.Parsetree.Ppat_extension x0 -> - Ast_412.Parsetree.Ppat_extension (copy_extension x0) - | Ast_411.Parsetree.Ppat_open (x0, x1) -> - Ast_412.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_411.Parsetree.core_type -> Ast_412.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_412.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_412.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_412.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_412.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_412.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_411.Parsetree.core_type_desc -> Ast_412.Parsetree.core_type_desc = - function - | Ast_411.Parsetree.Ptyp_any -> Ast_412.Parsetree.Ptyp_any - | Ast_411.Parsetree.Ptyp_var x0 -> Ast_412.Parsetree.Ptyp_var x0 - | Ast_411.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_412.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_411.Parsetree.Ptyp_tuple x0 -> - Ast_412.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_411.Parsetree.Ptyp_constr (x0, x1) -> - Ast_412.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_411.Parsetree.Ptyp_object (x0, x1) -> - Ast_412.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_411.Parsetree.Ptyp_class (x0, x1) -> - Ast_412.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_411.Parsetree.Ptyp_alias (x0, x1) -> - Ast_412.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_411.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_412.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_412.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_412.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_411.Parsetree.Ptyp_extension x0 -> - Ast_412.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_411.Parsetree.package_type -> Ast_412.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_412.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_412.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_412.Parsetree.prf_loc = (copy_location prf_loc); - Ast_412.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_411.Parsetree.row_field_desc -> Ast_412.Parsetree.row_field_desc = - function - | Ast_411.Parsetree.Rtag (x0, x1, x2) -> - Ast_412.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_411.Parsetree.Rinherit x0 -> - Ast_412.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_411.Parsetree.object_field -> Ast_412.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_412.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_412.Parsetree.pof_loc = (copy_location pof_loc); - Ast_412.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_411.Parsetree.attributes -> Ast_412.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_411.Parsetree.attribute -> Ast_412.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_412.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_412.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_412.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_411.Parsetree.payload -> Ast_412.Parsetree.payload = - function - | Ast_411.Parsetree.PStr x0 -> Ast_412.Parsetree.PStr (copy_structure x0) - | Ast_411.Parsetree.PSig x0 -> Ast_412.Parsetree.PSig (copy_signature x0) - | Ast_411.Parsetree.PTyp x0 -> Ast_412.Parsetree.PTyp (copy_core_type x0) - | Ast_411.Parsetree.PPat (x0, x1) -> - Ast_412.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_411.Parsetree.structure -> Ast_412.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_411.Parsetree.structure_item -> Ast_412.Parsetree.structure_item = - fun - { Ast_411.Parsetree.pstr_desc = pstr_desc; - Ast_411.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_412.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_412.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_411.Parsetree.structure_item_desc -> - Ast_412.Parsetree.structure_item_desc - = - function - | Ast_411.Parsetree.Pstr_eval (x0, x1) -> - Ast_412.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_411.Parsetree.Pstr_value (x0, x1) -> - Ast_412.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_411.Parsetree.Pstr_primitive x0 -> - Ast_412.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_411.Parsetree.Pstr_type (x0, x1) -> - Ast_412.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_411.Parsetree.Pstr_typext x0 -> - Ast_412.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_411.Parsetree.Pstr_exception x0 -> - Ast_412.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_411.Parsetree.Pstr_module x0 -> - Ast_412.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_411.Parsetree.Pstr_recmodule x0 -> - Ast_412.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_411.Parsetree.Pstr_modtype x0 -> - Ast_412.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_411.Parsetree.Pstr_open x0 -> - Ast_412.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_411.Parsetree.Pstr_class x0 -> - Ast_412.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_411.Parsetree.Pstr_class_type x0 -> - Ast_412.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_411.Parsetree.Pstr_include x0 -> - Ast_412.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_411.Parsetree.Pstr_attribute x0 -> - Ast_412.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_411.Parsetree.Pstr_extension (x0, x1) -> - Ast_412.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_411.Parsetree.include_declaration -> - Ast_412.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_411.Parsetree.class_declaration -> Ast_412.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_411.Parsetree.class_expr -> Ast_412.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_412.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_412.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_412.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_411.Parsetree.class_expr_desc -> Ast_412.Parsetree.class_expr_desc = - function - | Ast_411.Parsetree.Pcl_constr (x0, x1) -> - Ast_412.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_411.Parsetree.Pcl_structure x0 -> - Ast_412.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_411.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_412.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_412.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_412.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_412.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_411.Parsetree.Pcl_extension x0 -> - Ast_412.Parsetree.Pcl_extension (copy_extension x0) - | Ast_411.Parsetree.Pcl_open (x0, x1) -> - Ast_412.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_411.Parsetree.class_structure -> Ast_412.Parsetree.class_structure = - fun - { Ast_411.Parsetree.pcstr_self = pcstr_self; - Ast_411.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_412.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_412.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_411.Parsetree.class_field -> Ast_412.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_412.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_412.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_412.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_411.Parsetree.class_field_desc -> Ast_412.Parsetree.class_field_desc = - function - | Ast_411.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_412.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_412.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_412.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_412.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_411.Parsetree.Pcf_initializer x0 -> - Ast_412.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_411.Parsetree.Pcf_attribute x0 -> - Ast_412.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_411.Parsetree.Pcf_extension x0 -> - Ast_412.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_411.Parsetree.class_field_kind -> Ast_412.Parsetree.class_field_kind = - function - | Ast_411.Parsetree.Cfk_virtual x0 -> - Ast_412.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_411.Parsetree.Cfk_concrete (x0, x1) -> - Ast_412.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_411.Parsetree.open_declaration -> Ast_412.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_411.Parsetree.module_binding -> Ast_412.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_412.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_412.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_412.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_412.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_411.Parsetree.module_expr -> Ast_412.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_412.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_412.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_412.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_411.Parsetree.module_expr_desc -> Ast_412.Parsetree.module_expr_desc = - function - | Ast_411.Parsetree.Pmod_ident x0 -> - Ast_412.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_411.Parsetree.Pmod_structure x0 -> - Ast_412.Parsetree.Pmod_structure (copy_structure x0) - | Ast_411.Parsetree.Pmod_functor (x0, x1) -> - Ast_412.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_411.Parsetree.Pmod_apply (x0, x1) -> - Ast_412.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_411.Parsetree.Pmod_constraint (x0, x1) -> - Ast_412.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_411.Parsetree.Pmod_unpack x0 -> - Ast_412.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_411.Parsetree.Pmod_extension x0 -> - Ast_412.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_411.Parsetree.functor_parameter -> Ast_412.Parsetree.functor_parameter - = - function - | Ast_411.Parsetree.Unit -> Ast_412.Parsetree.Unit - | Ast_411.Parsetree.Named (x0, x1) -> - Ast_412.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_412.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_412.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_412.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_412.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_411.Parsetree.module_type_desc -> Ast_412.Parsetree.module_type_desc = - function - | Ast_411.Parsetree.Pmty_ident x0 -> - Ast_412.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_411.Parsetree.Pmty_signature x0 -> - Ast_412.Parsetree.Pmty_signature (copy_signature x0) - | Ast_411.Parsetree.Pmty_functor (x0, x1) -> - Ast_412.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_411.Parsetree.Pmty_with (x0, x1) -> - Ast_412.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_411.Parsetree.Pmty_typeof x0 -> - Ast_412.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_411.Parsetree.Pmty_extension x0 -> - Ast_412.Parsetree.Pmty_extension (copy_extension x0) - | Ast_411.Parsetree.Pmty_alias x0 -> - Ast_412.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_411.Parsetree.with_constraint -> Ast_412.Parsetree.with_constraint = - function - | Ast_411.Parsetree.Pwith_type (x0, x1) -> - Ast_412.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_411.Parsetree.Pwith_module (x0, x1) -> - Ast_412.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_411.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_412.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_411.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_412.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_411.Parsetree.signature -> Ast_412.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_411.Parsetree.signature_item -> Ast_412.Parsetree.signature_item = - fun - { Ast_411.Parsetree.psig_desc = psig_desc; - Ast_411.Parsetree.psig_loc = psig_loc } - -> - { - Ast_412.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_412.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_411.Parsetree.signature_item_desc -> - Ast_412.Parsetree.signature_item_desc - = - function - | Ast_411.Parsetree.Psig_value x0 -> - Ast_412.Parsetree.Psig_value (copy_value_description x0) - | Ast_411.Parsetree.Psig_type (x0, x1) -> - Ast_412.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_411.Parsetree.Psig_typesubst x0 -> - Ast_412.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_411.Parsetree.Psig_typext x0 -> - Ast_412.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_411.Parsetree.Psig_exception x0 -> - Ast_412.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_411.Parsetree.Psig_module x0 -> - Ast_412.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_411.Parsetree.Psig_modsubst x0 -> - Ast_412.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_411.Parsetree.Psig_recmodule x0 -> - Ast_412.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_411.Parsetree.Psig_modtype x0 -> - Ast_412.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_411.Parsetree.Psig_open x0 -> - Ast_412.Parsetree.Psig_open (copy_open_description x0) - | Ast_411.Parsetree.Psig_include x0 -> - Ast_412.Parsetree.Psig_include (copy_include_description x0) - | Ast_411.Parsetree.Psig_class x0 -> - Ast_412.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_411.Parsetree.Psig_class_type x0 -> - Ast_412.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_411.Parsetree.Psig_attribute x0 -> - Ast_412.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_411.Parsetree.Psig_extension (x0, x1) -> - Ast_412.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_411.Parsetree.class_type_declaration -> - Ast_412.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_411.Parsetree.class_description -> Ast_412.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_411.Parsetree.class_type -> Ast_412.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_412.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_412.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_412.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_411.Parsetree.class_type_desc -> Ast_412.Parsetree.class_type_desc = - function - | Ast_411.Parsetree.Pcty_constr (x0, x1) -> - Ast_412.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_411.Parsetree.Pcty_signature x0 -> - Ast_412.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_411.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_412.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_411.Parsetree.Pcty_extension x0 -> - Ast_412.Parsetree.Pcty_extension (copy_extension x0) - | Ast_411.Parsetree.Pcty_open (x0, x1) -> - Ast_412.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_411.Parsetree.class_signature -> Ast_412.Parsetree.class_signature = - fun - { Ast_411.Parsetree.pcsig_self = pcsig_self; - Ast_411.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_412.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_412.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_411.Parsetree.class_type_field -> Ast_412.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_412.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_412.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_412.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_411.Parsetree.class_type_field_desc -> - Ast_412.Parsetree.class_type_field_desc - = - function - | Ast_411.Parsetree.Pctf_inherit x0 -> - Ast_412.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_411.Parsetree.Pctf_val x0 -> - Ast_412.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_412.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_412.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_411.Parsetree.Pctf_attribute x0 -> - Ast_412.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_411.Parsetree.Pctf_extension x0 -> - Ast_412.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_411.Parsetree.extension -> Ast_412.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_412.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_412.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_412.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), (copy_variance x1, Ast_412.Asttypes.NoInjectivity))) - pci_params); - Ast_412.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_412.Parsetree.pci_expr = (f0 pci_expr); - Ast_412.Parsetree.pci_loc = (copy_location pci_loc); - Ast_412.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_411.Asttypes.virtual_flag -> Ast_412.Asttypes.virtual_flag = - function - | Ast_411.Asttypes.Virtual -> Ast_412.Asttypes.Virtual - | Ast_411.Asttypes.Concrete -> Ast_412.Asttypes.Concrete -and copy_include_description : - Ast_411.Parsetree.include_description -> - Ast_412.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_412.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_412.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_412.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_412.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_411.Parsetree.open_description -> Ast_412.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_412.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_412.Parsetree.popen_expr = (f0 popen_expr); - Ast_412.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_412.Parsetree.popen_loc = (copy_location popen_loc); - Ast_412.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_411.Asttypes.override_flag -> Ast_412.Asttypes.override_flag = - function - | Ast_411.Asttypes.Override -> Ast_412.Asttypes.Override - | Ast_411.Asttypes.Fresh -> Ast_412.Asttypes.Fresh -and copy_module_type_declaration : - Ast_411.Parsetree.module_type_declaration -> - Ast_412.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_412.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_412.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_412.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_412.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_411.Parsetree.module_substitution -> - Ast_412.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_412.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_412.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_412.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_412.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_411.Parsetree.module_declaration -> - Ast_412.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_412.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_412.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_412.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_412.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_411.Parsetree.type_exception -> Ast_412.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_412.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_412.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_412.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_411.Parsetree.type_extension -> Ast_412.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_412.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_412.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), (copy_variance x1, Ast_412.Asttypes.NoInjectivity))) - ptyext_params); - Ast_412.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_412.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_412.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_412.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_411.Parsetree.extension_constructor -> - Ast_412.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_412.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_412.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_412.Parsetree.pext_loc = (copy_location pext_loc); - Ast_412.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_411.Parsetree.extension_constructor_kind -> - Ast_412.Parsetree.extension_constructor_kind - = - function - | Ast_411.Parsetree.Pext_decl (x0, x1) -> - Ast_412.Parsetree.Pext_decl - ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) - | Ast_411.Parsetree.Pext_rebind x0 -> - Ast_412.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_411.Parsetree.type_declaration -> Ast_412.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_412.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_412.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), (copy_variance x1, Ast_412.Asttypes.NoInjectivity))) - ptype_params); - Ast_412.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_412.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_412.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_412.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_412.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_412.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_411.Asttypes.private_flag -> Ast_412.Asttypes.private_flag = - function - | Ast_411.Asttypes.Private -> Ast_412.Asttypes.Private - | Ast_411.Asttypes.Public -> Ast_412.Asttypes.Public -and copy_type_kind : - Ast_411.Parsetree.type_kind -> Ast_412.Parsetree.type_kind = - function - | Ast_411.Parsetree.Ptype_abstract -> Ast_412.Parsetree.Ptype_abstract - | Ast_411.Parsetree.Ptype_variant x0 -> - Ast_412.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_411.Parsetree.Ptype_record x0 -> - Ast_412.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_411.Parsetree.Ptype_open -> Ast_412.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_411.Parsetree.constructor_declaration -> - Ast_412.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_412.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_412.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_412.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_412.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_412.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_411.Parsetree.constructor_arguments -> - Ast_412.Parsetree.constructor_arguments - = - function - | Ast_411.Parsetree.Pcstr_tuple x0 -> - Ast_412.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_411.Parsetree.Pcstr_record x0 -> - Ast_412.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_411.Parsetree.label_declaration -> Ast_412.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_412.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_412.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_412.Parsetree.pld_type = (copy_core_type pld_type); - Ast_412.Parsetree.pld_loc = (copy_location pld_loc); - Ast_412.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_411.Asttypes.mutable_flag -> Ast_412.Asttypes.mutable_flag = - function - | Ast_411.Asttypes.Immutable -> Ast_412.Asttypes.Immutable - | Ast_411.Asttypes.Mutable -> Ast_412.Asttypes.Mutable -and copy_variance : Ast_411.Asttypes.variance -> Ast_412.Asttypes.variance = - function - | Ast_411.Asttypes.Covariant -> Ast_412.Asttypes.Covariant - | Ast_411.Asttypes.Contravariant -> Ast_412.Asttypes.Contravariant - | Ast_411.Asttypes.Invariant -> Ast_412.Asttypes.NoVariance -and copy_value_description : - Ast_411.Parsetree.value_description -> Ast_412.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_412.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_412.Parsetree.pval_type = (copy_core_type pval_type); - Ast_412.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_412.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_412.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_411.Parsetree.object_field_desc -> Ast_412.Parsetree.object_field_desc - = - function - | Ast_411.Parsetree.Otag (x0, x1) -> - Ast_412.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_411.Parsetree.Oinherit x0 -> - Ast_412.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_411.Asttypes.arg_label -> Ast_412.Asttypes.arg_label - = - function - | Ast_411.Asttypes.Nolabel -> Ast_412.Asttypes.Nolabel - | Ast_411.Asttypes.Labelled x0 -> Ast_412.Asttypes.Labelled x0 - | Ast_411.Asttypes.Optional x0 -> Ast_412.Asttypes.Optional x0 -and copy_closed_flag : - Ast_411.Asttypes.closed_flag -> Ast_412.Asttypes.closed_flag = - function - | Ast_411.Asttypes.Closed -> Ast_412.Asttypes.Closed - | Ast_411.Asttypes.Open -> Ast_412.Asttypes.Open -and copy_label : Ast_411.Asttypes.label -> Ast_412.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_411.Asttypes.rec_flag -> Ast_412.Asttypes.rec_flag = - function - | Ast_411.Asttypes.Nonrecursive -> Ast_412.Asttypes.Nonrecursive - | Ast_411.Asttypes.Recursive -> Ast_412.Asttypes.Recursive -and copy_constant : Ast_411.Parsetree.constant -> Ast_412.Parsetree.constant - = - function - | Ast_411.Parsetree.Pconst_integer (x0, x1) -> - Ast_412.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_411.Parsetree.Pconst_char x0 -> Ast_412.Parsetree.Pconst_char x0 - | Ast_411.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_412.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_411.Parsetree.Pconst_float (x0, x1) -> - Ast_412.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_411.Asttypes.loc -> 'g0 Ast_412.Asttypes.loc - = - fun f0 -> - fun { Ast_411.Asttypes.txt = txt; Ast_411.Asttypes.loc = loc } -> - { - Ast_412.Asttypes.txt = (f0 txt); - Ast_412.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_412_411.ml b/src/vendored-omp/src/migrate_parsetree_412_411.ml index 644edca0b..067b2d9e3 100644 --- a/src/vendored-omp/src/migrate_parsetree_412_411.ml +++ b/src/vendored-omp/src/migrate_parsetree_412_411.ml @@ -15,130 +15,3 @@ include Migrate_parsetree_412_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_411_412_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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } diff --git a/src/vendored-omp/src/migrate_parsetree_412_411_migrate.ml b/src/vendored-omp/src/migrate_parsetree_412_411_migrate.ml index f897fd91f..03dc65522 100644 --- a/src/vendored-omp/src/migrate_parsetree_412_411_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_412_411_migrate.ml @@ -1,7 +1,6 @@ open Stdlib0 module From = Ast_412 module To = Ast_411 - let rec copy_out_type_extension : Ast_412.Outcometree.out_type_extension -> Ast_411.Outcometree.out_type_extension @@ -38,35 +37,17 @@ and copy_out_phrase : | Ast_412.Outcometree.Ophr_exception x0 -> Ast_411.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) - -and copy_out_type_param : Ast_412.Outcometree.out_type_param -> string * (bool * bool) = - function (str, (v,inj)) -> - (match inj with - | Ast_412.Asttypes.NoInjectivity -> () - | Ast_412.Asttypes.Injective -> - (* ignoring [Injective] is not quite correct *) - () - ); - let co, cn = - match v with - | Ast_412.Asttypes.Covariant -> (true, false) - | Ast_412.Asttypes.Contravariant -> (false, true) - | Ast_412.Asttypes.NoVariance -> (false, false) - in - str, (co, cn) and copy_out_sig_item : Ast_412.Outcometree.out_sig_item -> Ast_411.Outcometree.out_sig_item = function | Ast_412.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> Ast_411.Outcometree.Osig_class - (x0, x1, - (List.map copy_out_type_param x2), - (copy_out_class_type x3), (copy_out_rec_status x4)) + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) | Ast_412.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> Ast_411.Outcometree.Osig_class_type - (x0, x1, - (List.map copy_out_type_param x2), - (copy_out_class_type x3), (copy_out_rec_status x4)) + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) | Ast_412.Outcometree.Osig_typext (x0, x1) -> Ast_411.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) @@ -175,6 +156,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_411.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_412.Asttypes.private_flag -> Ast_411.Asttypes.private_flag = + function + | Ast_412.Asttypes.Private -> Ast_411.Asttypes.Private + | Ast_412.Asttypes.Public -> Ast_411.Asttypes.Public and copy_out_rec_status : Ast_412.Outcometree.out_rec_status -> Ast_411.Outcometree.out_rec_status = function @@ -206,6 +192,26 @@ and copy_out_class_sig_item : Ast_411.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) | Ast_412.Outcometree.Ocsg_value (x0, x1, x2, x3) -> Ast_411.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type_param : Ast_412.Outcometree.out_type_param -> string * (bool * bool) = + function (str, (v,inj)) -> + (match inj with + | Ast_412.Asttypes.NoInjectivity -> () + | Ast_412.Asttypes.Injective -> + (* ignoring [Injective] is not quite correct *) + () + ); + let co, cn = + match v with + | Ast_412.Asttypes.Covariant -> (true, false) + | Ast_412.Asttypes.Contravariant -> (false, true) + | Ast_412.Asttypes.NoVariance -> (false, false) + in + str, (co, cn) +and copy_variance : Ast_412.Asttypes.variance -> Ast_411.Asttypes.variance = + function + | Ast_412.Asttypes.Covariant -> Ast_411.Asttypes.Covariant + | Ast_412.Asttypes.Contravariant -> Ast_411.Asttypes.Contravariant + | Ast_412.Asttypes.NoVariance -> Ast_411.Asttypes.Invariant and copy_out_type : Ast_412.Outcometree.out_type -> Ast_411.Outcometree.out_type = function @@ -326,1215 +332,3 @@ and copy_out_name : Ast_412.Outcometree.out_name -> Ast_411.Outcometree.out_name = fun { Ast_412.Outcometree.printed_name = printed_name } -> { Ast_411.Outcometree.printed_name = printed_name } - -and copy_toplevel_phrase : - Ast_412.Parsetree.toplevel_phrase -> Ast_411.Parsetree.toplevel_phrase = - function - | Ast_412.Parsetree.Ptop_def x0 -> - Ast_411.Parsetree.Ptop_def (copy_structure x0) - | Ast_412.Parsetree.Ptop_dir x0 -> - Ast_411.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_412.Parsetree.toplevel_directive -> - Ast_411.Parsetree.toplevel_directive - = - fun - { Ast_412.Parsetree.pdir_name = pdir_name; - Ast_412.Parsetree.pdir_arg = pdir_arg; - Ast_412.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_412.Parsetree.directive_argument -> - Ast_411.Parsetree.directive_argument - = - fun - { Ast_412.Parsetree.pdira_desc = pdira_desc; - Ast_412.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_412.Parsetree.directive_argument_desc -> - Ast_411.Parsetree.directive_argument_desc - = - function - | Ast_412.Parsetree.Pdir_string x0 -> Ast_411.Parsetree.Pdir_string x0 - | Ast_412.Parsetree.Pdir_int (x0, x1) -> - Ast_411.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_412.Parsetree.Pdir_ident x0 -> - Ast_411.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_412.Parsetree.Pdir_bool x0 -> Ast_411.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_412.Parsetree.expression -> Ast_411.Parsetree.expression = - fun - { Ast_412.Parsetree.pexp_desc = pexp_desc; - Ast_412.Parsetree.pexp_loc = pexp_loc; - Ast_412.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_412.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_412.Parsetree.expression_desc -> Ast_411.Parsetree.expression_desc = - function - | Ast_412.Parsetree.Pexp_ident x0 -> - Ast_411.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pexp_constant x0 -> - Ast_411.Parsetree.Pexp_constant (copy_constant x0) - | Ast_412.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_412.Parsetree.Pexp_function x0 -> - Ast_411.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_412.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_412.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_412.Parsetree.Pexp_match (x0, x1) -> - Ast_411.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_412.Parsetree.Pexp_try (x0, x1) -> - Ast_411.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_412.Parsetree.Pexp_tuple x0 -> - Ast_411.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_412.Parsetree.Pexp_construct (x0, x1) -> - Ast_411.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_412.Parsetree.Pexp_variant (x0, x1) -> - Ast_411.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_412.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_412.Parsetree.Pexp_field (x0, x1) -> - Ast_411.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_412.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_411.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_412.Parsetree.Pexp_array x0 -> - Ast_411.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_412.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_411.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_412.Parsetree.Pexp_sequence (x0, x1) -> - Ast_411.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_while (x0, x1) -> - Ast_411.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_412.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_412.Parsetree.Pexp_constraint (x0, x1) -> - Ast_411.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_412.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_412.Parsetree.Pexp_send (x0, x1) -> - Ast_411.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_412.Parsetree.Pexp_new x0 -> - Ast_411.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_411.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_412.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_412.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_412.Parsetree.Pexp_letexception (x0, x1) -> - Ast_411.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_assert x0 -> - Ast_411.Parsetree.Pexp_assert (copy_expression x0) - | Ast_412.Parsetree.Pexp_lazy x0 -> - Ast_411.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_412.Parsetree.Pexp_poly (x0, x1) -> - Ast_411.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_412.Parsetree.Pexp_object x0 -> - Ast_411.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_412.Parsetree.Pexp_newtype (x0, x1) -> - Ast_411.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_pack x0 -> - Ast_411.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_412.Parsetree.Pexp_open (x0, x1) -> - Ast_411.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_letop x0 -> - Ast_411.Parsetree.Pexp_letop (copy_letop x0) - | Ast_412.Parsetree.Pexp_extension x0 -> - Ast_411.Parsetree.Pexp_extension (copy_extension x0) - | Ast_412.Parsetree.Pexp_unreachable -> Ast_411.Parsetree.Pexp_unreachable -and copy_letop : Ast_412.Parsetree.letop -> Ast_411.Parsetree.letop = - fun - { Ast_412.Parsetree.let_ = let_; Ast_412.Parsetree.ands = ands; - Ast_412.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_412.Parsetree.binding_op -> Ast_411.Parsetree.binding_op = - fun - { Ast_412.Parsetree.pbop_op = pbop_op; - Ast_412.Parsetree.pbop_pat = pbop_pat; - Ast_412.Parsetree.pbop_exp = pbop_exp; - Ast_412.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_412.Asttypes.direction_flag -> Ast_411.Asttypes.direction_flag = - function - | Ast_412.Asttypes.Upto -> Ast_411.Asttypes.Upto - | Ast_412.Asttypes.Downto -> Ast_411.Asttypes.Downto - -and copy_cases : Ast_412.Parsetree.case list -> Ast_411.Parsetree.case list = - fun x -> List.map copy_case x -and copy_case : Ast_412.Parsetree.case -> Ast_411.Parsetree.case = - fun - { Ast_412.Parsetree.pc_lhs = pc_lhs; - Ast_412.Parsetree.pc_guard = pc_guard; - Ast_412.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_value_binding : - Ast_412.Parsetree.value_binding -> Ast_411.Parsetree.value_binding = - fun - { Ast_412.Parsetree.pvb_pat = pvb_pat; - Ast_412.Parsetree.pvb_expr = pvb_expr; - Ast_412.Parsetree.pvb_attributes = pvb_attributes; - Ast_412.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_412.Parsetree.pattern -> Ast_411.Parsetree.pattern = - fun - { Ast_412.Parsetree.ppat_desc = ppat_desc; - Ast_412.Parsetree.ppat_loc = ppat_loc; - Ast_412.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_412.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_412.Parsetree.pattern_desc -> Ast_411.Parsetree.pattern_desc = - function - | Ast_412.Parsetree.Ppat_any -> Ast_411.Parsetree.Ppat_any - | Ast_412.Parsetree.Ppat_var x0 -> - Ast_411.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_412.Parsetree.Ppat_alias (x0, x1) -> - Ast_411.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_412.Parsetree.Ppat_constant x0 -> - Ast_411.Parsetree.Ppat_constant (copy_constant x0) - | Ast_412.Parsetree.Ppat_interval (x0, x1) -> - Ast_411.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_412.Parsetree.Ppat_tuple x0 -> - Ast_411.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_412.Parsetree.Ppat_construct (x0, x1) -> - Ast_411.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) - | Ast_412.Parsetree.Ppat_variant (x0, x1) -> - Ast_411.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_412.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_412.Parsetree.Ppat_array x0 -> - Ast_411.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_412.Parsetree.Ppat_or (x0, x1) -> - Ast_411.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_412.Parsetree.Ppat_constraint (x0, x1) -> - Ast_411.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_412.Parsetree.Ppat_type x0 -> - Ast_411.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Ppat_lazy x0 -> - Ast_411.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_412.Parsetree.Ppat_unpack x0 -> - Ast_411.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_412.Parsetree.Ppat_exception x0 -> - Ast_411.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_412.Parsetree.Ppat_extension x0 -> - Ast_411.Parsetree.Ppat_extension (copy_extension x0) - | Ast_412.Parsetree.Ppat_open (x0, x1) -> - Ast_411.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_412.Parsetree.core_type -> Ast_411.Parsetree.core_type = - fun - { Ast_412.Parsetree.ptyp_desc = ptyp_desc; - Ast_412.Parsetree.ptyp_loc = ptyp_loc; - Ast_412.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_412.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_412.Parsetree.location_stack -> Ast_411.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_412.Parsetree.core_type_desc -> Ast_411.Parsetree.core_type_desc = - function - | Ast_412.Parsetree.Ptyp_any -> Ast_411.Parsetree.Ptyp_any - | Ast_412.Parsetree.Ptyp_var x0 -> Ast_411.Parsetree.Ptyp_var x0 - | Ast_412.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_411.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_412.Parsetree.Ptyp_tuple x0 -> - Ast_411.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_412.Parsetree.Ptyp_constr (x0, x1) -> - Ast_411.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Ptyp_object (x0, x1) -> - Ast_411.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_412.Parsetree.Ptyp_class (x0, x1) -> - Ast_411.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Ptyp_alias (x0, x1) -> - Ast_411.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_412.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_412.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_412.Parsetree.Ptyp_package x0 -> - Ast_411.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_412.Parsetree.Ptyp_extension x0 -> - Ast_411.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_412.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_412.Parsetree.row_field -> Ast_411.Parsetree.row_field = - fun - { Ast_412.Parsetree.prf_desc = prf_desc; - Ast_412.Parsetree.prf_loc = prf_loc; - Ast_412.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_412.Parsetree.row_field_desc -> Ast_411.Parsetree.row_field_desc = - function - | Ast_412.Parsetree.Rtag (x0, x1, x2) -> - Ast_411.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_412.Parsetree.Rinherit x0 -> - Ast_411.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_412.Parsetree.object_field -> Ast_411.Parsetree.object_field = - fun - { Ast_412.Parsetree.pof_desc = pof_desc; - Ast_412.Parsetree.pof_loc = pof_loc; - Ast_412.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_412.Parsetree.attributes -> Ast_411.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_412.Parsetree.attribute -> Ast_411.Parsetree.attribute = - fun - { Ast_412.Parsetree.attr_name = attr_name; - Ast_412.Parsetree.attr_payload = attr_payload; - Ast_412.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_412.Parsetree.payload -> Ast_411.Parsetree.payload = - function - | Ast_412.Parsetree.PStr x0 -> Ast_411.Parsetree.PStr (copy_structure x0) - | Ast_412.Parsetree.PSig x0 -> Ast_411.Parsetree.PSig (copy_signature x0) - | Ast_412.Parsetree.PTyp x0 -> Ast_411.Parsetree.PTyp (copy_core_type x0) - | Ast_412.Parsetree.PPat (x0, x1) -> - Ast_411.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_412.Parsetree.structure -> Ast_411.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_412.Parsetree.structure_item -> Ast_411.Parsetree.structure_item = - fun - { Ast_412.Parsetree.pstr_desc = pstr_desc; - Ast_412.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_412.Parsetree.structure_item_desc -> - Ast_411.Parsetree.structure_item_desc - = - function - | Ast_412.Parsetree.Pstr_eval (x0, x1) -> - Ast_411.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_412.Parsetree.Pstr_value (x0, x1) -> - Ast_411.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_412.Parsetree.Pstr_primitive x0 -> - Ast_411.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_412.Parsetree.Pstr_type (x0, x1) -> - Ast_411.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_412.Parsetree.Pstr_typext x0 -> - Ast_411.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_412.Parsetree.Pstr_exception x0 -> - Ast_411.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_412.Parsetree.Pstr_module x0 -> - Ast_411.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_412.Parsetree.Pstr_recmodule x0 -> - Ast_411.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_412.Parsetree.Pstr_modtype x0 -> - Ast_411.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_412.Parsetree.Pstr_open x0 -> - Ast_411.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_412.Parsetree.Pstr_class x0 -> - Ast_411.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_412.Parsetree.Pstr_class_type x0 -> - Ast_411.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_412.Parsetree.Pstr_include x0 -> - Ast_411.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_412.Parsetree.Pstr_attribute x0 -> - Ast_411.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pstr_extension (x0, x1) -> - Ast_411.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_412.Parsetree.include_declaration -> - Ast_411.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_412.Parsetree.class_declaration -> Ast_411.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_412.Parsetree.class_expr -> Ast_411.Parsetree.class_expr = - fun - { Ast_412.Parsetree.pcl_desc = pcl_desc; - Ast_412.Parsetree.pcl_loc = pcl_loc; - Ast_412.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_412.Parsetree.class_expr_desc -> Ast_411.Parsetree.class_expr_desc = - function - | Ast_412.Parsetree.Pcl_constr (x0, x1) -> - Ast_411.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Pcl_structure x0 -> - Ast_411.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_412.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_412.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_412.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_412.Parsetree.Pcl_constraint (x0, x1) -> - Ast_411.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_412.Parsetree.Pcl_extension x0 -> - Ast_411.Parsetree.Pcl_extension (copy_extension x0) - | Ast_412.Parsetree.Pcl_open (x0, x1) -> - Ast_411.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_412.Parsetree.class_structure -> Ast_411.Parsetree.class_structure = - fun - { Ast_412.Parsetree.pcstr_self = pcstr_self; - Ast_412.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_412.Parsetree.class_field -> Ast_411.Parsetree.class_field = - fun - { Ast_412.Parsetree.pcf_desc = pcf_desc; - Ast_412.Parsetree.pcf_loc = pcf_loc; - Ast_412.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_412.Parsetree.class_field_desc -> Ast_411.Parsetree.class_field_desc = - function - | Ast_412.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_412.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_412.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_412.Parsetree.Pcf_constraint x0 -> - Ast_411.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_412.Parsetree.Pcf_initializer x0 -> - Ast_411.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_412.Parsetree.Pcf_attribute x0 -> - Ast_411.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pcf_extension x0 -> - Ast_411.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_412.Parsetree.class_field_kind -> Ast_411.Parsetree.class_field_kind = - function - | Ast_412.Parsetree.Cfk_virtual x0 -> - Ast_411.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_412.Parsetree.Cfk_concrete (x0, x1) -> - Ast_411.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_412.Parsetree.open_declaration -> Ast_411.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_412.Parsetree.module_binding -> Ast_411.Parsetree.module_binding = - fun - { Ast_412.Parsetree.pmb_name = pmb_name; - Ast_412.Parsetree.pmb_expr = pmb_expr; - Ast_412.Parsetree.pmb_attributes = pmb_attributes; - Ast_412.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_412.Parsetree.module_expr -> Ast_411.Parsetree.module_expr = - fun - { Ast_412.Parsetree.pmod_desc = pmod_desc; - Ast_412.Parsetree.pmod_loc = pmod_loc; - Ast_412.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_412.Parsetree.module_expr_desc -> Ast_411.Parsetree.module_expr_desc = - function - | Ast_412.Parsetree.Pmod_ident x0 -> - Ast_411.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pmod_structure x0 -> - Ast_411.Parsetree.Pmod_structure (copy_structure x0) - | Ast_412.Parsetree.Pmod_functor (x0, x1) -> - Ast_411.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_412.Parsetree.Pmod_apply (x0, x1) -> - Ast_411.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_412.Parsetree.Pmod_constraint (x0, x1) -> - Ast_411.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_412.Parsetree.Pmod_unpack x0 -> - Ast_411.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_412.Parsetree.Pmod_extension x0 -> - Ast_411.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_412.Parsetree.functor_parameter -> Ast_411.Parsetree.functor_parameter - = - function - | Ast_412.Parsetree.Unit -> Ast_411.Parsetree.Unit - | Ast_412.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_412.Parsetree.module_type -> Ast_411.Parsetree.module_type = - fun - { Ast_412.Parsetree.pmty_desc = pmty_desc; - Ast_412.Parsetree.pmty_loc = pmty_loc; - Ast_412.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_412.Parsetree.module_type_desc -> Ast_411.Parsetree.module_type_desc = - function - | Ast_412.Parsetree.Pmty_ident x0 -> - Ast_411.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pmty_signature x0 -> - Ast_411.Parsetree.Pmty_signature (copy_signature x0) - | Ast_412.Parsetree.Pmty_functor (x0, x1) -> - Ast_411.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_412.Parsetree.Pmty_with (x0, x1) -> - Ast_411.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_412.Parsetree.Pmty_typeof x0 -> - Ast_411.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_412.Parsetree.Pmty_extension x0 -> - Ast_411.Parsetree.Pmty_extension (copy_extension x0) - | Ast_412.Parsetree.Pmty_alias x0 -> - Ast_411.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_412.Parsetree.with_constraint -> Ast_411.Parsetree.with_constraint = - function - | Ast_412.Parsetree.Pwith_type (x0, x1) -> - Ast_411.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_412.Parsetree.Pwith_module (x0, x1) -> - Ast_411.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_412.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_411.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_412.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_412.Parsetree.signature -> Ast_411.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_412.Parsetree.signature_item -> Ast_411.Parsetree.signature_item = - fun - { Ast_412.Parsetree.psig_desc = psig_desc; - Ast_412.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_412.Parsetree.signature_item_desc -> - Ast_411.Parsetree.signature_item_desc - = - function - | Ast_412.Parsetree.Psig_value x0 -> - Ast_411.Parsetree.Psig_value (copy_value_description x0) - | Ast_412.Parsetree.Psig_type (x0, x1) -> - Ast_411.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_412.Parsetree.Psig_typesubst x0 -> - Ast_411.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_412.Parsetree.Psig_typext x0 -> - Ast_411.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_412.Parsetree.Psig_exception x0 -> - Ast_411.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_412.Parsetree.Psig_module x0 -> - Ast_411.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_412.Parsetree.Psig_modsubst x0 -> - Ast_411.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_412.Parsetree.Psig_recmodule x0 -> - Ast_411.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_412.Parsetree.Psig_modtype x0 -> - Ast_411.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_412.Parsetree.Psig_open x0 -> - Ast_411.Parsetree.Psig_open (copy_open_description x0) - | Ast_412.Parsetree.Psig_include x0 -> - Ast_411.Parsetree.Psig_include (copy_include_description x0) - | Ast_412.Parsetree.Psig_class x0 -> - Ast_411.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_412.Parsetree.Psig_class_type x0 -> - Ast_411.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_412.Parsetree.Psig_attribute x0 -> - Ast_411.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_412.Parsetree.Psig_extension (x0, x1) -> - Ast_411.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_412.Parsetree.class_type_declaration -> - Ast_411.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_412.Parsetree.class_description -> Ast_411.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_412.Parsetree.class_type -> Ast_411.Parsetree.class_type = - fun - { Ast_412.Parsetree.pcty_desc = pcty_desc; - Ast_412.Parsetree.pcty_loc = pcty_loc; - Ast_412.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_412.Parsetree.class_type_desc -> Ast_411.Parsetree.class_type_desc = - function - | Ast_412.Parsetree.Pcty_constr (x0, x1) -> - Ast_411.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Pcty_signature x0 -> - Ast_411.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_412.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_411.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_412.Parsetree.Pcty_extension x0 -> - Ast_411.Parsetree.Pcty_extension (copy_extension x0) - | Ast_412.Parsetree.Pcty_open (x0, x1) -> - Ast_411.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_412.Parsetree.class_signature -> Ast_411.Parsetree.class_signature = - fun - { Ast_412.Parsetree.pcsig_self = pcsig_self; - Ast_412.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_412.Parsetree.class_type_field -> Ast_411.Parsetree.class_type_field = - fun - { Ast_412.Parsetree.pctf_desc = pctf_desc; - Ast_412.Parsetree.pctf_loc = pctf_loc; - Ast_412.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_412.Parsetree.class_type_field_desc -> - Ast_411.Parsetree.class_type_field_desc - = - function - | Ast_412.Parsetree.Pctf_inherit x0 -> - Ast_411.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_412.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_412.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_412.Parsetree.Pctf_constraint x0 -> - Ast_411.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_412.Parsetree.Pctf_attribute x0 -> - Ast_411.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pctf_extension x0 -> - Ast_411.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_412.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_412.Parsetree.class_infos -> 'g0 Ast_411.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.pci_virt = pci_virt; - Ast_412.Parsetree.pci_params = pci_params; - Ast_412.Parsetree.pci_name = pci_name; - Ast_412.Parsetree.pci_expr = pci_expr; - Ast_412.Parsetree.pci_loc = pci_loc; - Ast_412.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), - (let (x0, _) = x1 in - (copy_variance x0)))) 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_412.Asttypes.virtual_flag -> Ast_411.Asttypes.virtual_flag = - function - | Ast_412.Asttypes.Virtual -> Ast_411.Asttypes.Virtual - | Ast_412.Asttypes.Concrete -> Ast_411.Asttypes.Concrete -and copy_include_description : - Ast_412.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_412.Parsetree.include_infos -> - 'g0 Ast_411.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.pincl_mod = pincl_mod; - Ast_412.Parsetree.pincl_loc = pincl_loc; - Ast_412.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_412.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_412.Parsetree.open_infos -> 'g0 Ast_411.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.popen_expr = popen_expr; - Ast_412.Parsetree.popen_override = popen_override; - Ast_412.Parsetree.popen_loc = popen_loc; - Ast_412.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_412.Asttypes.override_flag -> Ast_411.Asttypes.override_flag = - function - | Ast_412.Asttypes.Override -> Ast_411.Asttypes.Override - | Ast_412.Asttypes.Fresh -> Ast_411.Asttypes.Fresh -and copy_module_type_declaration : - Ast_412.Parsetree.module_type_declaration -> - Ast_411.Parsetree.module_type_declaration - = - fun - { Ast_412.Parsetree.pmtd_name = pmtd_name; - Ast_412.Parsetree.pmtd_type = pmtd_type; - Ast_412.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_412.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_412.Parsetree.module_substitution -> - Ast_411.Parsetree.module_substitution - = - fun - { Ast_412.Parsetree.pms_name = pms_name; - Ast_412.Parsetree.pms_manifest = pms_manifest; - Ast_412.Parsetree.pms_attributes = pms_attributes; - Ast_412.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_412.Parsetree.module_declaration -> - Ast_411.Parsetree.module_declaration - = - fun - { Ast_412.Parsetree.pmd_name = pmd_name; - Ast_412.Parsetree.pmd_type = pmd_type; - Ast_412.Parsetree.pmd_attributes = pmd_attributes; - Ast_412.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_412.Parsetree.type_exception -> Ast_411.Parsetree.type_exception = - fun - { Ast_412.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_412.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_412.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_412.Parsetree.type_extension -> Ast_411.Parsetree.type_extension = - fun - { Ast_412.Parsetree.ptyext_path = ptyext_path; - Ast_412.Parsetree.ptyext_params = ptyext_params; - Ast_412.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_412.Parsetree.ptyext_private = ptyext_private; - Ast_412.Parsetree.ptyext_loc = ptyext_loc; - Ast_412.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), - (let (x0, _) = x1 in - (copy_variance x0)))) 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_412.Parsetree.extension_constructor -> - Ast_411.Parsetree.extension_constructor - = - fun - { Ast_412.Parsetree.pext_name = pext_name; - Ast_412.Parsetree.pext_kind = pext_kind; - Ast_412.Parsetree.pext_loc = pext_loc; - Ast_412.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_412.Parsetree.extension_constructor_kind -> - Ast_411.Parsetree.extension_constructor_kind - = - function - | Ast_412.Parsetree.Pext_decl (x0, x1) -> - Ast_411.Parsetree.Pext_decl - ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) - | Ast_412.Parsetree.Pext_rebind x0 -> - Ast_411.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_412.Parsetree.type_declaration -> Ast_411.Parsetree.type_declaration = - fun - { Ast_412.Parsetree.ptype_name = ptype_name; - Ast_412.Parsetree.ptype_params = ptype_params; - Ast_412.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_412.Parsetree.ptype_kind = ptype_kind; - Ast_412.Parsetree.ptype_private = ptype_private; - Ast_412.Parsetree.ptype_manifest = ptype_manifest; - Ast_412.Parsetree.ptype_attributes = ptype_attributes; - Ast_412.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), - (let (x0, _) = x1 in - (copy_variance x0)))) 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_412.Asttypes.private_flag -> Ast_411.Asttypes.private_flag = - function - | Ast_412.Asttypes.Private -> Ast_411.Asttypes.Private - | Ast_412.Asttypes.Public -> Ast_411.Asttypes.Public -and copy_type_kind : - Ast_412.Parsetree.type_kind -> Ast_411.Parsetree.type_kind = - function - | Ast_412.Parsetree.Ptype_abstract -> Ast_411.Parsetree.Ptype_abstract - | Ast_412.Parsetree.Ptype_variant x0 -> - Ast_411.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_412.Parsetree.Ptype_record x0 -> - Ast_411.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_412.Parsetree.Ptype_open -> Ast_411.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_412.Parsetree.constructor_declaration -> - Ast_411.Parsetree.constructor_declaration - = - fun - { Ast_412.Parsetree.pcd_name = pcd_name; - Ast_412.Parsetree.pcd_args = pcd_args; - Ast_412.Parsetree.pcd_res = pcd_res; - Ast_412.Parsetree.pcd_loc = pcd_loc; - Ast_412.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_412.Parsetree.constructor_arguments -> - Ast_411.Parsetree.constructor_arguments - = - function - | Ast_412.Parsetree.Pcstr_tuple x0 -> - Ast_411.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_412.Parsetree.Pcstr_record x0 -> - Ast_411.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_412.Parsetree.label_declaration -> Ast_411.Parsetree.label_declaration - = - fun - { Ast_412.Parsetree.pld_name = pld_name; - Ast_412.Parsetree.pld_mutable = pld_mutable; - Ast_412.Parsetree.pld_type = pld_type; - Ast_412.Parsetree.pld_loc = pld_loc; - Ast_412.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_412.Asttypes.mutable_flag -> Ast_411.Asttypes.mutable_flag = - function - | Ast_412.Asttypes.Immutable -> Ast_411.Asttypes.Immutable - | Ast_412.Asttypes.Mutable -> Ast_411.Asttypes.Mutable -and copy_variance : Ast_412.Asttypes.variance -> Ast_411.Asttypes.variance = - function - | Ast_412.Asttypes.Covariant -> Ast_411.Asttypes.Covariant - | Ast_412.Asttypes.Contravariant -> Ast_411.Asttypes.Contravariant - | Ast_412.Asttypes.NoVariance -> Ast_411.Asttypes.Invariant -and copy_value_description : - Ast_412.Parsetree.value_description -> Ast_411.Parsetree.value_description - = - fun - { Ast_412.Parsetree.pval_name = pval_name; - Ast_412.Parsetree.pval_type = pval_type; - Ast_412.Parsetree.pval_prim = pval_prim; - Ast_412.Parsetree.pval_attributes = pval_attributes; - Ast_412.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_412.Parsetree.object_field_desc -> Ast_411.Parsetree.object_field_desc - = - function - | Ast_412.Parsetree.Otag (x0, x1) -> - Ast_411.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_412.Parsetree.Oinherit x0 -> - Ast_411.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_412.Asttypes.arg_label -> Ast_411.Asttypes.arg_label - = - function - | Ast_412.Asttypes.Nolabel -> Ast_411.Asttypes.Nolabel - | Ast_412.Asttypes.Labelled x0 -> Ast_411.Asttypes.Labelled x0 - | Ast_412.Asttypes.Optional x0 -> Ast_411.Asttypes.Optional x0 -and copy_closed_flag : - Ast_412.Asttypes.closed_flag -> Ast_411.Asttypes.closed_flag = - function - | Ast_412.Asttypes.Closed -> Ast_411.Asttypes.Closed - | Ast_412.Asttypes.Open -> Ast_411.Asttypes.Open -and copy_label : Ast_412.Asttypes.label -> Ast_411.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_412.Asttypes.rec_flag -> Ast_411.Asttypes.rec_flag = - function - | Ast_412.Asttypes.Nonrecursive -> Ast_411.Asttypes.Nonrecursive - | Ast_412.Asttypes.Recursive -> Ast_411.Asttypes.Recursive -and copy_constant : Ast_412.Parsetree.constant -> Ast_411.Parsetree.constant - = - function - | Ast_412.Parsetree.Pconst_integer (x0, x1) -> - Ast_411.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_412.Parsetree.Pconst_char x0 -> Ast_411.Parsetree.Pconst_char x0 - | Ast_412.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_411.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_412.Parsetree.Pconst_float (x0, x1) -> - Ast_411.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_412.Asttypes.loc -> 'g0 Ast_411.Asttypes.loc - = - fun f0 -> - fun { Ast_412.Asttypes.txt = txt; Ast_412.Asttypes.loc = loc } -> - { - Ast_411.Asttypes.txt = (f0 txt); - Ast_411.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_412_413.ml b/src/vendored-omp/src/migrate_parsetree_412_413.ml index e99fd3e1a..34a1d4ece 100644 --- a/src/vendored-omp/src/migrate_parsetree_412_413.ml +++ b/src/vendored-omp/src/migrate_parsetree_412_413.ml @@ -15,130 +15,3 @@ include Migrate_parsetree_412_413_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_413_412_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } - diff --git a/src/vendored-omp/src/migrate_parsetree_412_413_migrate.ml b/src/vendored-omp/src/migrate_parsetree_412_413_migrate.ml index 22dc56b4f..7be021df7 100644 --- a/src/vendored-omp/src/migrate_parsetree_412_413_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_412_413_migrate.ml @@ -156,6 +156,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_413.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_412.Asttypes.private_flag -> Ast_413.Asttypes.private_flag = + function + | Ast_412.Asttypes.Private -> Ast_413.Asttypes.Private + | Ast_412.Asttypes.Public -> Ast_413.Asttypes.Public and copy_out_rec_status : Ast_412.Outcometree.out_rec_status -> Ast_413.Outcometree.out_rec_status = function @@ -192,6 +197,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_412.Asttypes.injectivity -> Ast_413.Asttypes.injectivity = + function + | Ast_412.Asttypes.Injective -> Ast_413.Asttypes.Injective + | Ast_412.Asttypes.NoInjectivity -> Ast_413.Asttypes.NoInjectivity +and copy_variance : Ast_412.Asttypes.variance -> Ast_413.Asttypes.variance = + function + | Ast_412.Asttypes.Covariant -> Ast_413.Asttypes.Covariant + | Ast_412.Asttypes.Contravariant -> Ast_413.Asttypes.Contravariant + | Ast_412.Asttypes.NoVariance -> Ast_413.Asttypes.NoVariance and copy_out_type : Ast_412.Outcometree.out_type -> Ast_413.Outcometree.out_type = function @@ -311,1212 +326,3 @@ and copy_out_name : Ast_412.Outcometree.out_name -> Ast_413.Outcometree.out_name = fun { Ast_412.Outcometree.printed_name = printed_name } -> { Ast_413.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_412.Parsetree.toplevel_phrase -> Ast_413.Parsetree.toplevel_phrase = - function - | Ast_412.Parsetree.Ptop_def x0 -> - Ast_413.Parsetree.Ptop_def (copy_structure x0) - | Ast_412.Parsetree.Ptop_dir x0 -> - Ast_413.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_412.Parsetree.toplevel_directive -> - Ast_413.Parsetree.toplevel_directive - = - fun - { Ast_412.Parsetree.pdir_name = pdir_name; - Ast_412.Parsetree.pdir_arg = pdir_arg; - Ast_412.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_413.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_413.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_413.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_412.Parsetree.directive_argument -> - Ast_413.Parsetree.directive_argument - = - fun - { Ast_412.Parsetree.pdira_desc = pdira_desc; - Ast_412.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_413.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_413.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_412.Parsetree.directive_argument_desc -> - Ast_413.Parsetree.directive_argument_desc - = - function - | Ast_412.Parsetree.Pdir_string x0 -> Ast_413.Parsetree.Pdir_string x0 - | Ast_412.Parsetree.Pdir_int (x0, x1) -> - Ast_413.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_412.Parsetree.Pdir_ident x0 -> - Ast_413.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_412.Parsetree.Pdir_bool x0 -> Ast_413.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_412.Parsetree.expression -> Ast_413.Parsetree.expression = - fun - { Ast_412.Parsetree.pexp_desc = pexp_desc; - Ast_412.Parsetree.pexp_loc = pexp_loc; - Ast_412.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_412.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_413.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_413.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_413.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_413.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_412.Parsetree.expression_desc -> Ast_413.Parsetree.expression_desc = - function - | Ast_412.Parsetree.Pexp_ident x0 -> - Ast_413.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pexp_constant x0 -> - Ast_413.Parsetree.Pexp_constant (copy_constant x0) - | Ast_412.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_412.Parsetree.Pexp_function x0 -> - Ast_413.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_412.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_413.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_412.Parsetree.Pexp_apply (x0, x1) -> - Ast_413.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_412.Parsetree.Pexp_match (x0, x1) -> - Ast_413.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_412.Parsetree.Pexp_try (x0, x1) -> - Ast_413.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_412.Parsetree.Pexp_tuple x0 -> - Ast_413.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_412.Parsetree.Pexp_construct (x0, x1) -> - Ast_413.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_412.Parsetree.Pexp_variant (x0, x1) -> - Ast_413.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_412.Parsetree.Pexp_record (x0, x1) -> - Ast_413.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_412.Parsetree.Pexp_field (x0, x1) -> - Ast_413.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_412.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_412.Parsetree.Pexp_array x0 -> - Ast_413.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_412.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_412.Parsetree.Pexp_sequence (x0, x1) -> - Ast_413.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_while (x0, x1) -> - Ast_413.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_413.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_412.Parsetree.Pexp_constraint (x0, x1) -> - Ast_413.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_412.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_412.Parsetree.Pexp_send (x0, x1) -> - Ast_413.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_412.Parsetree.Pexp_new x0 -> - Ast_413.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_413.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_override x0 -> - Ast_413.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_412.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_412.Parsetree.Pexp_letexception (x0, x1) -> - Ast_413.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_assert x0 -> - Ast_413.Parsetree.Pexp_assert (copy_expression x0) - | Ast_412.Parsetree.Pexp_lazy x0 -> - Ast_413.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_412.Parsetree.Pexp_poly (x0, x1) -> - Ast_413.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_412.Parsetree.Pexp_object x0 -> - Ast_413.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_412.Parsetree.Pexp_newtype (x0, x1) -> - Ast_413.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_pack x0 -> - Ast_413.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_412.Parsetree.Pexp_open (x0, x1) -> - Ast_413.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_412.Parsetree.Pexp_letop x0 -> - Ast_413.Parsetree.Pexp_letop (copy_letop x0) - | Ast_412.Parsetree.Pexp_extension x0 -> - Ast_413.Parsetree.Pexp_extension (copy_extension x0) - | Ast_412.Parsetree.Pexp_unreachable -> Ast_413.Parsetree.Pexp_unreachable -and copy_letop : Ast_412.Parsetree.letop -> Ast_413.Parsetree.letop = - fun - { Ast_412.Parsetree.let_ = let_; Ast_412.Parsetree.ands = ands; - Ast_412.Parsetree.body = body } - -> - { - Ast_413.Parsetree.let_ = (copy_binding_op let_); - Ast_413.Parsetree.ands = (List.map copy_binding_op ands); - Ast_413.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_412.Parsetree.binding_op -> Ast_413.Parsetree.binding_op = - fun - { Ast_412.Parsetree.pbop_op = pbop_op; - Ast_412.Parsetree.pbop_pat = pbop_pat; - Ast_412.Parsetree.pbop_exp = pbop_exp; - Ast_412.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_413.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_413.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_413.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_413.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_412.Asttypes.direction_flag -> Ast_413.Asttypes.direction_flag = - function - | Ast_412.Asttypes.Upto -> Ast_413.Asttypes.Upto - | Ast_412.Asttypes.Downto -> Ast_413.Asttypes.Downto -and copy_case : Ast_412.Parsetree.case -> Ast_413.Parsetree.case = - fun - { Ast_412.Parsetree.pc_lhs = pc_lhs; - Ast_412.Parsetree.pc_guard = pc_guard; - Ast_412.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_413.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_413.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_413.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_412.Parsetree.value_binding -> Ast_413.Parsetree.value_binding = - fun - { Ast_412.Parsetree.pvb_pat = pvb_pat; - Ast_412.Parsetree.pvb_expr = pvb_expr; - Ast_412.Parsetree.pvb_attributes = pvb_attributes; - Ast_412.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_413.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_413.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_413.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_413.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_412.Parsetree.pattern -> Ast_413.Parsetree.pattern = - fun - { Ast_412.Parsetree.ppat_desc = ppat_desc; - Ast_412.Parsetree.ppat_loc = ppat_loc; - Ast_412.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_412.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_413.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_413.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_413.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_413.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_412.Parsetree.pattern_desc -> Ast_413.Parsetree.pattern_desc = - function - | Ast_412.Parsetree.Ppat_any -> Ast_413.Parsetree.Ppat_any - | Ast_412.Parsetree.Ppat_var x0 -> - Ast_413.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_412.Parsetree.Ppat_alias (x0, x1) -> - Ast_413.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_412.Parsetree.Ppat_constant x0 -> - Ast_413.Parsetree.Ppat_constant (copy_constant x0) - | Ast_412.Parsetree.Ppat_interval (x0, x1) -> - Ast_413.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_412.Parsetree.Ppat_tuple x0 -> - Ast_413.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_412.Parsetree.Ppat_construct (x0, x1) -> - Ast_413.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), (Option.map (fun x -> [], copy_pattern x) x1)) - | Ast_412.Parsetree.Ppat_variant (x0, x1) -> - Ast_413.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_412.Parsetree.Ppat_record (x0, x1) -> - Ast_413.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_412.Parsetree.Ppat_array x0 -> - Ast_413.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_412.Parsetree.Ppat_or (x0, x1) -> - Ast_413.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_412.Parsetree.Ppat_constraint (x0, x1) -> - Ast_413.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_412.Parsetree.Ppat_type x0 -> - Ast_413.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Ppat_lazy x0 -> - Ast_413.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_412.Parsetree.Ppat_unpack x0 -> - Ast_413.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_412.Parsetree.Ppat_exception x0 -> - Ast_413.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_412.Parsetree.Ppat_extension x0 -> - Ast_413.Parsetree.Ppat_extension (copy_extension x0) - | Ast_412.Parsetree.Ppat_open (x0, x1) -> - Ast_413.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_412.Parsetree.core_type -> Ast_413.Parsetree.core_type = - fun - { Ast_412.Parsetree.ptyp_desc = ptyp_desc; - Ast_412.Parsetree.ptyp_loc = ptyp_loc; - Ast_412.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_412.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_413.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_413.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_413.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_413.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_412.Parsetree.location_stack -> Ast_413.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_412.Parsetree.core_type_desc -> Ast_413.Parsetree.core_type_desc = - function - | Ast_412.Parsetree.Ptyp_any -> Ast_413.Parsetree.Ptyp_any - | Ast_412.Parsetree.Ptyp_var x0 -> Ast_413.Parsetree.Ptyp_var x0 - | Ast_412.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_413.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_412.Parsetree.Ptyp_tuple x0 -> - Ast_413.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_412.Parsetree.Ptyp_constr (x0, x1) -> - Ast_413.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Ptyp_object (x0, x1) -> - Ast_413.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_412.Parsetree.Ptyp_class (x0, x1) -> - Ast_413.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Ptyp_alias (x0, x1) -> - Ast_413.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_412.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_413.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_412.Parsetree.Ptyp_poly (x0, x1) -> - Ast_413.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_412.Parsetree.Ptyp_package x0 -> - Ast_413.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_412.Parsetree.Ptyp_extension x0 -> - Ast_413.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_412.Parsetree.package_type -> Ast_413.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_412.Parsetree.row_field -> Ast_413.Parsetree.row_field = - fun - { Ast_412.Parsetree.prf_desc = prf_desc; - Ast_412.Parsetree.prf_loc = prf_loc; - Ast_412.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_413.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_413.Parsetree.prf_loc = (copy_location prf_loc); - Ast_413.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_412.Parsetree.row_field_desc -> Ast_413.Parsetree.row_field_desc = - function - | Ast_412.Parsetree.Rtag (x0, x1, x2) -> - Ast_413.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_412.Parsetree.Rinherit x0 -> - Ast_413.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_412.Parsetree.object_field -> Ast_413.Parsetree.object_field = - fun - { Ast_412.Parsetree.pof_desc = pof_desc; - Ast_412.Parsetree.pof_loc = pof_loc; - Ast_412.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_413.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_413.Parsetree.pof_loc = (copy_location pof_loc); - Ast_413.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_412.Parsetree.attributes -> Ast_413.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_412.Parsetree.attribute -> Ast_413.Parsetree.attribute = - fun - { Ast_412.Parsetree.attr_name = attr_name; - Ast_412.Parsetree.attr_payload = attr_payload; - Ast_412.Parsetree.attr_loc = attr_loc } - -> - { - Ast_413.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_413.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_413.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_412.Parsetree.payload -> Ast_413.Parsetree.payload = - function - | Ast_412.Parsetree.PStr x0 -> Ast_413.Parsetree.PStr (copy_structure x0) - | Ast_412.Parsetree.PSig x0 -> Ast_413.Parsetree.PSig (copy_signature x0) - | Ast_412.Parsetree.PTyp x0 -> Ast_413.Parsetree.PTyp (copy_core_type x0) - | Ast_412.Parsetree.PPat (x0, x1) -> - Ast_413.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_412.Parsetree.structure -> Ast_413.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_412.Parsetree.structure_item -> Ast_413.Parsetree.structure_item = - fun - { Ast_412.Parsetree.pstr_desc = pstr_desc; - Ast_412.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_413.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_413.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_412.Parsetree.structure_item_desc -> - Ast_413.Parsetree.structure_item_desc - = - function - | Ast_412.Parsetree.Pstr_eval (x0, x1) -> - Ast_413.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_412.Parsetree.Pstr_value (x0, x1) -> - Ast_413.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_412.Parsetree.Pstr_primitive x0 -> - Ast_413.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_412.Parsetree.Pstr_type (x0, x1) -> - Ast_413.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_412.Parsetree.Pstr_typext x0 -> - Ast_413.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_412.Parsetree.Pstr_exception x0 -> - Ast_413.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_412.Parsetree.Pstr_module x0 -> - Ast_413.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_412.Parsetree.Pstr_recmodule x0 -> - Ast_413.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_412.Parsetree.Pstr_modtype x0 -> - Ast_413.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_412.Parsetree.Pstr_open x0 -> - Ast_413.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_412.Parsetree.Pstr_class x0 -> - Ast_413.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_412.Parsetree.Pstr_class_type x0 -> - Ast_413.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_412.Parsetree.Pstr_include x0 -> - Ast_413.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_412.Parsetree.Pstr_attribute x0 -> - Ast_413.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pstr_extension (x0, x1) -> - Ast_413.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_412.Parsetree.include_declaration -> - Ast_413.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_412.Parsetree.class_declaration -> Ast_413.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_412.Parsetree.class_expr -> Ast_413.Parsetree.class_expr = - fun - { Ast_412.Parsetree.pcl_desc = pcl_desc; - Ast_412.Parsetree.pcl_loc = pcl_loc; - Ast_412.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_413.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_413.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_413.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_412.Parsetree.class_expr_desc -> Ast_413.Parsetree.class_expr_desc = - function - | Ast_412.Parsetree.Pcl_constr (x0, x1) -> - Ast_413.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Pcl_structure x0 -> - Ast_413.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_412.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_413.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_412.Parsetree.Pcl_apply (x0, x1) -> - Ast_413.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_412.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_413.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_412.Parsetree.Pcl_constraint (x0, x1) -> - Ast_413.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_412.Parsetree.Pcl_extension x0 -> - Ast_413.Parsetree.Pcl_extension (copy_extension x0) - | Ast_412.Parsetree.Pcl_open (x0, x1) -> - Ast_413.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_412.Parsetree.class_structure -> Ast_413.Parsetree.class_structure = - fun - { Ast_412.Parsetree.pcstr_self = pcstr_self; - Ast_412.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_413.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_413.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_412.Parsetree.class_field -> Ast_413.Parsetree.class_field = - fun - { Ast_412.Parsetree.pcf_desc = pcf_desc; - Ast_412.Parsetree.pcf_loc = pcf_loc; - Ast_412.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_413.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_413.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_413.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_412.Parsetree.class_field_desc -> Ast_413.Parsetree.class_field_desc = - function - | Ast_412.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_413.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_412.Parsetree.Pcf_val x0 -> - Ast_413.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_412.Parsetree.Pcf_method x0 -> - Ast_413.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_412.Parsetree.Pcf_constraint x0 -> - Ast_413.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_412.Parsetree.Pcf_initializer x0 -> - Ast_413.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_412.Parsetree.Pcf_attribute x0 -> - Ast_413.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pcf_extension x0 -> - Ast_413.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_412.Parsetree.class_field_kind -> Ast_413.Parsetree.class_field_kind = - function - | Ast_412.Parsetree.Cfk_virtual x0 -> - Ast_413.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_412.Parsetree.Cfk_concrete (x0, x1) -> - Ast_413.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_412.Parsetree.open_declaration -> Ast_413.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_412.Parsetree.module_binding -> Ast_413.Parsetree.module_binding = - fun - { Ast_412.Parsetree.pmb_name = pmb_name; - Ast_412.Parsetree.pmb_expr = pmb_expr; - Ast_412.Parsetree.pmb_attributes = pmb_attributes; - Ast_412.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_413.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_413.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_413.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_413.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_412.Parsetree.module_expr -> Ast_413.Parsetree.module_expr = - fun - { Ast_412.Parsetree.pmod_desc = pmod_desc; - Ast_412.Parsetree.pmod_loc = pmod_loc; - Ast_412.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_413.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_413.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_413.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_412.Parsetree.module_expr_desc -> Ast_413.Parsetree.module_expr_desc = - function - | Ast_412.Parsetree.Pmod_ident x0 -> - Ast_413.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pmod_structure x0 -> - Ast_413.Parsetree.Pmod_structure (copy_structure x0) - | Ast_412.Parsetree.Pmod_functor (x0, x1) -> - Ast_413.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_412.Parsetree.Pmod_apply (x0, x1) -> - Ast_413.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_412.Parsetree.Pmod_constraint (x0, x1) -> - Ast_413.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_412.Parsetree.Pmod_unpack x0 -> - Ast_413.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_412.Parsetree.Pmod_extension x0 -> - Ast_413.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_412.Parsetree.functor_parameter -> Ast_413.Parsetree.functor_parameter - = - function - | Ast_412.Parsetree.Unit -> Ast_413.Parsetree.Unit - | Ast_412.Parsetree.Named (x0, x1) -> - Ast_413.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_412.Parsetree.module_type -> Ast_413.Parsetree.module_type = - fun - { Ast_412.Parsetree.pmty_desc = pmty_desc; - Ast_412.Parsetree.pmty_loc = pmty_loc; - Ast_412.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_413.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_413.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_413.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_412.Parsetree.module_type_desc -> Ast_413.Parsetree.module_type_desc = - function - | Ast_412.Parsetree.Pmty_ident x0 -> - Ast_413.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_412.Parsetree.Pmty_signature x0 -> - Ast_413.Parsetree.Pmty_signature (copy_signature x0) - | Ast_412.Parsetree.Pmty_functor (x0, x1) -> - Ast_413.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_412.Parsetree.Pmty_with (x0, x1) -> - Ast_413.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_412.Parsetree.Pmty_typeof x0 -> - Ast_413.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_412.Parsetree.Pmty_extension x0 -> - Ast_413.Parsetree.Pmty_extension (copy_extension x0) - | Ast_412.Parsetree.Pmty_alias x0 -> - Ast_413.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_412.Parsetree.with_constraint -> Ast_413.Parsetree.with_constraint = - function - | Ast_412.Parsetree.Pwith_type (x0, x1) -> - Ast_413.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_412.Parsetree.Pwith_module (x0, x1) -> - Ast_413.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_412.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_413.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_412.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_413.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_412.Parsetree.signature -> Ast_413.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_412.Parsetree.signature_item -> Ast_413.Parsetree.signature_item = - fun - { Ast_412.Parsetree.psig_desc = psig_desc; - Ast_412.Parsetree.psig_loc = psig_loc } - -> - { - Ast_413.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_413.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_412.Parsetree.signature_item_desc -> - Ast_413.Parsetree.signature_item_desc - = - function - | Ast_412.Parsetree.Psig_value x0 -> - Ast_413.Parsetree.Psig_value (copy_value_description x0) - | Ast_412.Parsetree.Psig_type (x0, x1) -> - Ast_413.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_412.Parsetree.Psig_typesubst x0 -> - Ast_413.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_412.Parsetree.Psig_typext x0 -> - Ast_413.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_412.Parsetree.Psig_exception x0 -> - Ast_413.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_412.Parsetree.Psig_module x0 -> - Ast_413.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_412.Parsetree.Psig_modsubst x0 -> - Ast_413.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_412.Parsetree.Psig_recmodule x0 -> - Ast_413.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_412.Parsetree.Psig_modtype x0 -> - Ast_413.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_412.Parsetree.Psig_open x0 -> - Ast_413.Parsetree.Psig_open (copy_open_description x0) - | Ast_412.Parsetree.Psig_include x0 -> - Ast_413.Parsetree.Psig_include (copy_include_description x0) - | Ast_412.Parsetree.Psig_class x0 -> - Ast_413.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_412.Parsetree.Psig_class_type x0 -> - Ast_413.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_412.Parsetree.Psig_attribute x0 -> - Ast_413.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_412.Parsetree.Psig_extension (x0, x1) -> - Ast_413.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_412.Parsetree.class_type_declaration -> - Ast_413.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_412.Parsetree.class_description -> Ast_413.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_412.Parsetree.class_type -> Ast_413.Parsetree.class_type = - fun - { Ast_412.Parsetree.pcty_desc = pcty_desc; - Ast_412.Parsetree.pcty_loc = pcty_loc; - Ast_412.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_413.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_413.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_413.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_412.Parsetree.class_type_desc -> Ast_413.Parsetree.class_type_desc = - function - | Ast_412.Parsetree.Pcty_constr (x0, x1) -> - Ast_413.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_412.Parsetree.Pcty_signature x0 -> - Ast_413.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_412.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_413.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_412.Parsetree.Pcty_extension x0 -> - Ast_413.Parsetree.Pcty_extension (copy_extension x0) - | Ast_412.Parsetree.Pcty_open (x0, x1) -> - Ast_413.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_412.Parsetree.class_signature -> Ast_413.Parsetree.class_signature = - fun - { Ast_412.Parsetree.pcsig_self = pcsig_self; - Ast_412.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_413.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_413.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_412.Parsetree.class_type_field -> Ast_413.Parsetree.class_type_field = - fun - { Ast_412.Parsetree.pctf_desc = pctf_desc; - Ast_412.Parsetree.pctf_loc = pctf_loc; - Ast_412.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_413.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_413.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_413.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_412.Parsetree.class_type_field_desc -> - Ast_413.Parsetree.class_type_field_desc - = - function - | Ast_412.Parsetree.Pctf_inherit x0 -> - Ast_413.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_412.Parsetree.Pctf_val x0 -> - Ast_413.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_412.Parsetree.Pctf_method x0 -> - Ast_413.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_412.Parsetree.Pctf_constraint x0 -> - Ast_413.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_412.Parsetree.Pctf_attribute x0 -> - Ast_413.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_412.Parsetree.Pctf_extension x0 -> - Ast_413.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_412.Parsetree.extension -> Ast_413.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_412.Parsetree.class_infos -> 'g0 Ast_413.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.pci_virt = pci_virt; - Ast_412.Parsetree.pci_params = pci_params; - Ast_412.Parsetree.pci_name = pci_name; - Ast_412.Parsetree.pci_expr = pci_expr; - Ast_412.Parsetree.pci_loc = pci_loc; - Ast_412.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_413.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_413.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_413.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_413.Parsetree.pci_expr = (f0 pci_expr); - Ast_413.Parsetree.pci_loc = (copy_location pci_loc); - Ast_413.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_412.Asttypes.virtual_flag -> Ast_413.Asttypes.virtual_flag = - function - | Ast_412.Asttypes.Virtual -> Ast_413.Asttypes.Virtual - | Ast_412.Asttypes.Concrete -> Ast_413.Asttypes.Concrete -and copy_include_description : - Ast_412.Parsetree.include_description -> - Ast_413.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_412.Parsetree.include_infos -> - 'g0 Ast_413.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.pincl_mod = pincl_mod; - Ast_412.Parsetree.pincl_loc = pincl_loc; - Ast_412.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_413.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_413.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_413.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_412.Parsetree.open_description -> Ast_413.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_412.Parsetree.open_infos -> 'g0 Ast_413.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_412.Parsetree.popen_expr = popen_expr; - Ast_412.Parsetree.popen_override = popen_override; - Ast_412.Parsetree.popen_loc = popen_loc; - Ast_412.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_413.Parsetree.popen_expr = (f0 popen_expr); - Ast_413.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_413.Parsetree.popen_loc = (copy_location popen_loc); - Ast_413.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_412.Asttypes.override_flag -> Ast_413.Asttypes.override_flag = - function - | Ast_412.Asttypes.Override -> Ast_413.Asttypes.Override - | Ast_412.Asttypes.Fresh -> Ast_413.Asttypes.Fresh -and copy_module_type_declaration : - Ast_412.Parsetree.module_type_declaration -> - Ast_413.Parsetree.module_type_declaration - = - fun - { Ast_412.Parsetree.pmtd_name = pmtd_name; - Ast_412.Parsetree.pmtd_type = pmtd_type; - Ast_412.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_412.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_413.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_413.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_413.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_413.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_412.Parsetree.module_substitution -> - Ast_413.Parsetree.module_substitution - = - fun - { Ast_412.Parsetree.pms_name = pms_name; - Ast_412.Parsetree.pms_manifest = pms_manifest; - Ast_412.Parsetree.pms_attributes = pms_attributes; - Ast_412.Parsetree.pms_loc = pms_loc } - -> - { - Ast_413.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_413.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_413.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_413.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_412.Parsetree.module_declaration -> - Ast_413.Parsetree.module_declaration - = - fun - { Ast_412.Parsetree.pmd_name = pmd_name; - Ast_412.Parsetree.pmd_type = pmd_type; - Ast_412.Parsetree.pmd_attributes = pmd_attributes; - Ast_412.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_413.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_413.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_413.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_413.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_412.Parsetree.type_exception -> Ast_413.Parsetree.type_exception = - fun - { Ast_412.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_412.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_412.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_413.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_413.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_413.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_412.Parsetree.type_extension -> Ast_413.Parsetree.type_extension = - fun - { Ast_412.Parsetree.ptyext_path = ptyext_path; - Ast_412.Parsetree.ptyext_params = ptyext_params; - Ast_412.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_412.Parsetree.ptyext_private = ptyext_private; - Ast_412.Parsetree.ptyext_loc = ptyext_loc; - Ast_412.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_413.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_413.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_413.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_413.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_413.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_413.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_412.Parsetree.extension_constructor -> - Ast_413.Parsetree.extension_constructor - = - fun - { Ast_412.Parsetree.pext_name = pext_name; - Ast_412.Parsetree.pext_kind = pext_kind; - Ast_412.Parsetree.pext_loc = pext_loc; - Ast_412.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_413.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_413.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_413.Parsetree.pext_loc = (copy_location pext_loc); - Ast_413.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_412.Parsetree.extension_constructor_kind -> - Ast_413.Parsetree.extension_constructor_kind - = - function - | Ast_412.Parsetree.Pext_decl (x0, x1) -> - Ast_413.Parsetree.Pext_decl - ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) - | Ast_412.Parsetree.Pext_rebind x0 -> - Ast_413.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_412.Parsetree.type_declaration -> Ast_413.Parsetree.type_declaration = - fun - { Ast_412.Parsetree.ptype_name = ptype_name; - Ast_412.Parsetree.ptype_params = ptype_params; - Ast_412.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_412.Parsetree.ptype_kind = ptype_kind; - Ast_412.Parsetree.ptype_private = ptype_private; - Ast_412.Parsetree.ptype_manifest = ptype_manifest; - Ast_412.Parsetree.ptype_attributes = ptype_attributes; - Ast_412.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_413.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_413.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_413.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_413.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_413.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_413.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_413.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_413.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_412.Asttypes.private_flag -> Ast_413.Asttypes.private_flag = - function - | Ast_412.Asttypes.Private -> Ast_413.Asttypes.Private - | Ast_412.Asttypes.Public -> Ast_413.Asttypes.Public -and copy_type_kind : - Ast_412.Parsetree.type_kind -> Ast_413.Parsetree.type_kind = - function - | Ast_412.Parsetree.Ptype_abstract -> Ast_413.Parsetree.Ptype_abstract - | Ast_412.Parsetree.Ptype_variant x0 -> - Ast_413.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_412.Parsetree.Ptype_record x0 -> - Ast_413.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_412.Parsetree.Ptype_open -> Ast_413.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_412.Parsetree.constructor_declaration -> - Ast_413.Parsetree.constructor_declaration - = - fun - { Ast_412.Parsetree.pcd_name = pcd_name; - Ast_412.Parsetree.pcd_args = pcd_args; - Ast_412.Parsetree.pcd_res = pcd_res; - Ast_412.Parsetree.pcd_loc = pcd_loc; - Ast_412.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_413.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_413.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_413.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_413.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_413.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_412.Parsetree.constructor_arguments -> - Ast_413.Parsetree.constructor_arguments - = - function - | Ast_412.Parsetree.Pcstr_tuple x0 -> - Ast_413.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_412.Parsetree.Pcstr_record x0 -> - Ast_413.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_412.Parsetree.label_declaration -> Ast_413.Parsetree.label_declaration - = - fun - { Ast_412.Parsetree.pld_name = pld_name; - Ast_412.Parsetree.pld_mutable = pld_mutable; - Ast_412.Parsetree.pld_type = pld_type; - Ast_412.Parsetree.pld_loc = pld_loc; - Ast_412.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_413.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_413.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_413.Parsetree.pld_type = (copy_core_type pld_type); - Ast_413.Parsetree.pld_loc = (copy_location pld_loc); - Ast_413.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_412.Asttypes.mutable_flag -> Ast_413.Asttypes.mutable_flag = - function - | Ast_412.Asttypes.Immutable -> Ast_413.Asttypes.Immutable - | Ast_412.Asttypes.Mutable -> Ast_413.Asttypes.Mutable -and copy_injectivity : - Ast_412.Asttypes.injectivity -> Ast_413.Asttypes.injectivity = - function - | Ast_412.Asttypes.Injective -> Ast_413.Asttypes.Injective - | Ast_412.Asttypes.NoInjectivity -> Ast_413.Asttypes.NoInjectivity -and copy_variance : Ast_412.Asttypes.variance -> Ast_413.Asttypes.variance = - function - | Ast_412.Asttypes.Covariant -> Ast_413.Asttypes.Covariant - | Ast_412.Asttypes.Contravariant -> Ast_413.Asttypes.Contravariant - | Ast_412.Asttypes.NoVariance -> Ast_413.Asttypes.NoVariance -and copy_value_description : - Ast_412.Parsetree.value_description -> Ast_413.Parsetree.value_description - = - fun - { Ast_412.Parsetree.pval_name = pval_name; - Ast_412.Parsetree.pval_type = pval_type; - Ast_412.Parsetree.pval_prim = pval_prim; - Ast_412.Parsetree.pval_attributes = pval_attributes; - Ast_412.Parsetree.pval_loc = pval_loc } - -> - { - Ast_413.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_413.Parsetree.pval_type = (copy_core_type pval_type); - Ast_413.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_413.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_413.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_412.Parsetree.object_field_desc -> Ast_413.Parsetree.object_field_desc - = - function - | Ast_412.Parsetree.Otag (x0, x1) -> - Ast_413.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_412.Parsetree.Oinherit x0 -> - Ast_413.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_412.Asttypes.arg_label -> Ast_413.Asttypes.arg_label - = - function - | Ast_412.Asttypes.Nolabel -> Ast_413.Asttypes.Nolabel - | Ast_412.Asttypes.Labelled x0 -> Ast_413.Asttypes.Labelled x0 - | Ast_412.Asttypes.Optional x0 -> Ast_413.Asttypes.Optional x0 -and copy_closed_flag : - Ast_412.Asttypes.closed_flag -> Ast_413.Asttypes.closed_flag = - function - | Ast_412.Asttypes.Closed -> Ast_413.Asttypes.Closed - | Ast_412.Asttypes.Open -> Ast_413.Asttypes.Open -and copy_label : Ast_412.Asttypes.label -> Ast_413.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_412.Asttypes.rec_flag -> Ast_413.Asttypes.rec_flag = - function - | Ast_412.Asttypes.Nonrecursive -> Ast_413.Asttypes.Nonrecursive - | Ast_412.Asttypes.Recursive -> Ast_413.Asttypes.Recursive -and copy_constant : Ast_412.Parsetree.constant -> Ast_413.Parsetree.constant - = - function - | Ast_412.Parsetree.Pconst_integer (x0, x1) -> - Ast_413.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_412.Parsetree.Pconst_char x0 -> Ast_413.Parsetree.Pconst_char x0 - | Ast_412.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_413.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_412.Parsetree.Pconst_float (x0, x1) -> - Ast_413.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_412.Asttypes.loc -> 'g0 Ast_413.Asttypes.loc - = - fun f0 -> - fun { Ast_412.Asttypes.txt = txt; Ast_412.Asttypes.loc = loc } -> - { - Ast_413.Asttypes.txt = (f0 txt); - Ast_413.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_413_412.ml b/src/vendored-omp/src/migrate_parsetree_413_412.ml index e97acb89c..118c1f8a3 100644 --- a/src/vendored-omp/src/migrate_parsetree_413_412.ml +++ b/src/vendored-omp/src/migrate_parsetree_413_412.ml @@ -15,131 +15,3 @@ include Migrate_parsetree_413_412_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_412_413_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } - diff --git a/src/vendored-omp/src/migrate_parsetree_413_412_migrate.ml b/src/vendored-omp/src/migrate_parsetree_413_412_migrate.ml index 50b86ddda..f274f59fa 100644 --- a/src/vendored-omp/src/migrate_parsetree_413_412_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_413_412_migrate.ml @@ -1,14 +1,6 @@ open Stdlib0 - module From = Ast_413 module To = Ast_412 - - -module Def = Migrate_parsetree_def - -let migration_error location feature = - raise (Def.Migration_error (feature, location)) - let rec copy_out_type_extension : Ast_413.Outcometree.out_type_extension -> Ast_412.Outcometree.out_type_extension @@ -164,6 +156,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_412.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_413.Asttypes.private_flag -> Ast_412.Asttypes.private_flag = + function + | Ast_413.Asttypes.Private -> Ast_412.Asttypes.Private + | Ast_413.Asttypes.Public -> Ast_412.Asttypes.Public and copy_out_rec_status : Ast_413.Outcometree.out_rec_status -> Ast_412.Outcometree.out_rec_status = function @@ -200,6 +197,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_413.Asttypes.injectivity -> Ast_412.Asttypes.injectivity = + function + | Ast_413.Asttypes.Injective -> Ast_412.Asttypes.Injective + | Ast_413.Asttypes.NoInjectivity -> Ast_412.Asttypes.NoInjectivity +and copy_variance : Ast_413.Asttypes.variance -> Ast_412.Asttypes.variance = + function + | Ast_413.Asttypes.Covariant -> Ast_412.Asttypes.Covariant + | Ast_413.Asttypes.Contravariant -> Ast_412.Asttypes.Contravariant + | Ast_413.Asttypes.NoVariance -> Ast_412.Asttypes.NoVariance and copy_out_type : Ast_413.Outcometree.out_type -> Ast_412.Outcometree.out_type = function @@ -321,1222 +328,3 @@ and copy_out_name : Ast_413.Outcometree.out_name -> Ast_412.Outcometree.out_name = fun { Ast_413.Outcometree.printed_name = printed_name } -> { Ast_412.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_413.Parsetree.toplevel_phrase -> Ast_412.Parsetree.toplevel_phrase = - function - | Ast_413.Parsetree.Ptop_def x0 -> - Ast_412.Parsetree.Ptop_def (copy_structure x0) - | Ast_413.Parsetree.Ptop_dir x0 -> - Ast_412.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_413.Parsetree.toplevel_directive -> - Ast_412.Parsetree.toplevel_directive - = - fun - { Ast_413.Parsetree.pdir_name = pdir_name; - Ast_413.Parsetree.pdir_arg = pdir_arg; - Ast_413.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_412.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_412.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_412.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_413.Parsetree.directive_argument -> - Ast_412.Parsetree.directive_argument - = - fun - { Ast_413.Parsetree.pdira_desc = pdira_desc; - Ast_413.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_412.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_412.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_413.Parsetree.directive_argument_desc -> - Ast_412.Parsetree.directive_argument_desc - = - function - | Ast_413.Parsetree.Pdir_string x0 -> Ast_412.Parsetree.Pdir_string x0 - | Ast_413.Parsetree.Pdir_int (x0, x1) -> - Ast_412.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_413.Parsetree.Pdir_ident x0 -> - Ast_412.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_413.Parsetree.Pdir_bool x0 -> Ast_412.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_413.Parsetree.expression -> Ast_412.Parsetree.expression = - fun - { Ast_413.Parsetree.pexp_desc = pexp_desc; - Ast_413.Parsetree.pexp_loc = pexp_loc; - Ast_413.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_413.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_412.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_412.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_412.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_412.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_413.Parsetree.expression_desc -> Ast_412.Parsetree.expression_desc = - function - | Ast_413.Parsetree.Pexp_ident x0 -> - Ast_412.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pexp_constant x0 -> - Ast_412.Parsetree.Pexp_constant (copy_constant x0) - | Ast_413.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_413.Parsetree.Pexp_function x0 -> - Ast_412.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_413.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_412.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_413.Parsetree.Pexp_apply (x0, x1) -> - Ast_412.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_413.Parsetree.Pexp_match (x0, x1) -> - Ast_412.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_413.Parsetree.Pexp_try (x0, x1) -> - Ast_412.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_413.Parsetree.Pexp_tuple x0 -> - Ast_412.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_413.Parsetree.Pexp_construct (x0, x1) -> - Ast_412.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_413.Parsetree.Pexp_variant (x0, x1) -> - Ast_412.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_413.Parsetree.Pexp_record (x0, x1) -> - Ast_412.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_413.Parsetree.Pexp_field (x0, x1) -> - Ast_412.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_413.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_413.Parsetree.Pexp_array x0 -> - Ast_412.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_413.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_413.Parsetree.Pexp_sequence (x0, x1) -> - Ast_412.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_while (x0, x1) -> - Ast_412.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_412.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_413.Parsetree.Pexp_constraint (x0, x1) -> - Ast_412.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_413.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_413.Parsetree.Pexp_send (x0, x1) -> - Ast_412.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_413.Parsetree.Pexp_new x0 -> - Ast_412.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_412.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_override x0 -> - Ast_412.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_413.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_412.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_413.Parsetree.Pexp_letexception (x0, x1) -> - Ast_412.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_assert x0 -> - Ast_412.Parsetree.Pexp_assert (copy_expression x0) - | Ast_413.Parsetree.Pexp_lazy x0 -> - Ast_412.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_413.Parsetree.Pexp_poly (x0, x1) -> - Ast_412.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_413.Parsetree.Pexp_object x0 -> - Ast_412.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_413.Parsetree.Pexp_newtype (x0, x1) -> - Ast_412.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_pack x0 -> - Ast_412.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_413.Parsetree.Pexp_open (x0, x1) -> - Ast_412.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_letop x0 -> - Ast_412.Parsetree.Pexp_letop (copy_letop x0) - | Ast_413.Parsetree.Pexp_extension x0 -> - Ast_412.Parsetree.Pexp_extension (copy_extension x0) - | Ast_413.Parsetree.Pexp_unreachable -> Ast_412.Parsetree.Pexp_unreachable -and copy_letop : Ast_413.Parsetree.letop -> Ast_412.Parsetree.letop = - fun - { Ast_413.Parsetree.let_ = let_; Ast_413.Parsetree.ands = ands; - Ast_413.Parsetree.body = body } - -> - { - Ast_412.Parsetree.let_ = (copy_binding_op let_); - Ast_412.Parsetree.ands = (List.map copy_binding_op ands); - Ast_412.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_413.Parsetree.binding_op -> Ast_412.Parsetree.binding_op = - fun - { Ast_413.Parsetree.pbop_op = pbop_op; - Ast_413.Parsetree.pbop_pat = pbop_pat; - Ast_413.Parsetree.pbop_exp = pbop_exp; - Ast_413.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_412.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_412.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_412.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_412.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_413.Asttypes.direction_flag -> Ast_412.Asttypes.direction_flag = - function - | Ast_413.Asttypes.Upto -> Ast_412.Asttypes.Upto - | Ast_413.Asttypes.Downto -> Ast_412.Asttypes.Downto -and copy_case : Ast_413.Parsetree.case -> Ast_412.Parsetree.case = - fun - { Ast_413.Parsetree.pc_lhs = pc_lhs; - Ast_413.Parsetree.pc_guard = pc_guard; - Ast_413.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_412.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_412.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_412.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_413.Parsetree.value_binding -> Ast_412.Parsetree.value_binding = - fun - { Ast_413.Parsetree.pvb_pat = pvb_pat; - Ast_413.Parsetree.pvb_expr = pvb_expr; - Ast_413.Parsetree.pvb_attributes = pvb_attributes; - Ast_413.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_412.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_412.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_412.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_412.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_413.Parsetree.pattern -> Ast_412.Parsetree.pattern = - fun - { Ast_413.Parsetree.ppat_desc = ppat_desc; - Ast_413.Parsetree.ppat_loc = ppat_loc; - Ast_413.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_413.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_412.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_412.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_412.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_412.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_413.Parsetree.pattern_desc -> Ast_412.Parsetree.pattern_desc = - function - | Ast_413.Parsetree.Ppat_any -> Ast_412.Parsetree.Ppat_any - | Ast_413.Parsetree.Ppat_var x0 -> - Ast_412.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_413.Parsetree.Ppat_alias (x0, x1) -> - Ast_412.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_413.Parsetree.Ppat_constant x0 -> - Ast_412.Parsetree.Ppat_constant (copy_constant x0) - | Ast_413.Parsetree.Ppat_interval (x0, x1) -> - Ast_412.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_413.Parsetree.Ppat_tuple x0 -> - Ast_412.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_413.Parsetree.Ppat_construct (x0, x1) -> - Ast_412.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), - (Option.map - (fun x -> - let (_, x1) = x in - copy_pattern x1) x1)) - | Ast_413.Parsetree.Ppat_variant (x0, x1) -> - Ast_412.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_413.Parsetree.Ppat_record (x0, x1) -> - Ast_412.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_413.Parsetree.Ppat_array x0 -> - Ast_412.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_413.Parsetree.Ppat_or (x0, x1) -> - Ast_412.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_413.Parsetree.Ppat_constraint (x0, x1) -> - Ast_412.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_413.Parsetree.Ppat_type x0 -> - Ast_412.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Ppat_lazy x0 -> - Ast_412.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_413.Parsetree.Ppat_unpack x0 -> - Ast_412.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_413.Parsetree.Ppat_exception x0 -> - Ast_412.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_413.Parsetree.Ppat_extension x0 -> - Ast_412.Parsetree.Ppat_extension (copy_extension x0) - | Ast_413.Parsetree.Ppat_open (x0, x1) -> - Ast_412.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_413.Parsetree.core_type -> Ast_412.Parsetree.core_type = - fun - { Ast_413.Parsetree.ptyp_desc = ptyp_desc; - Ast_413.Parsetree.ptyp_loc = ptyp_loc; - Ast_413.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_413.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_412.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_412.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_412.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_412.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_413.Parsetree.location_stack -> Ast_412.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_413.Parsetree.core_type_desc -> Ast_412.Parsetree.core_type_desc = - function - | Ast_413.Parsetree.Ptyp_any -> Ast_412.Parsetree.Ptyp_any - | Ast_413.Parsetree.Ptyp_var x0 -> Ast_412.Parsetree.Ptyp_var x0 - | Ast_413.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_412.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_413.Parsetree.Ptyp_tuple x0 -> - Ast_412.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_413.Parsetree.Ptyp_constr (x0, x1) -> - Ast_412.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_object (x0, x1) -> - Ast_412.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_413.Parsetree.Ptyp_class (x0, x1) -> - Ast_412.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_alias (x0, x1) -> - Ast_412.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_413.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_412.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_413.Parsetree.Ptyp_poly (x0, x1) -> - Ast_412.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_package x0 -> - Ast_412.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_413.Parsetree.Ptyp_extension x0 -> - Ast_412.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_413.Parsetree.package_type -> Ast_412.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_413.Parsetree.row_field -> Ast_412.Parsetree.row_field = - fun - { Ast_413.Parsetree.prf_desc = prf_desc; - Ast_413.Parsetree.prf_loc = prf_loc; - Ast_413.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_412.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_412.Parsetree.prf_loc = (copy_location prf_loc); - Ast_412.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_413.Parsetree.row_field_desc -> Ast_412.Parsetree.row_field_desc = - function - | Ast_413.Parsetree.Rtag (x0, x1, x2) -> - Ast_412.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_413.Parsetree.Rinherit x0 -> - Ast_412.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_413.Parsetree.object_field -> Ast_412.Parsetree.object_field = - fun - { Ast_413.Parsetree.pof_desc = pof_desc; - Ast_413.Parsetree.pof_loc = pof_loc; - Ast_413.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_412.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_412.Parsetree.pof_loc = (copy_location pof_loc); - Ast_412.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_413.Parsetree.attributes -> Ast_412.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_413.Parsetree.attribute -> Ast_412.Parsetree.attribute = - fun - { Ast_413.Parsetree.attr_name = attr_name; - Ast_413.Parsetree.attr_payload = attr_payload; - Ast_413.Parsetree.attr_loc = attr_loc } - -> - { - Ast_412.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_412.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_412.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_413.Parsetree.payload -> Ast_412.Parsetree.payload = - function - | Ast_413.Parsetree.PStr x0 -> Ast_412.Parsetree.PStr (copy_structure x0) - | Ast_413.Parsetree.PSig x0 -> Ast_412.Parsetree.PSig (copy_signature x0) - | Ast_413.Parsetree.PTyp x0 -> Ast_412.Parsetree.PTyp (copy_core_type x0) - | Ast_413.Parsetree.PPat (x0, x1) -> - Ast_412.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_413.Parsetree.structure -> Ast_412.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_413.Parsetree.structure_item -> Ast_412.Parsetree.structure_item = - fun - { Ast_413.Parsetree.pstr_desc = pstr_desc; - Ast_413.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_412.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_412.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_413.Parsetree.structure_item_desc -> - Ast_412.Parsetree.structure_item_desc - = - function - | Ast_413.Parsetree.Pstr_eval (x0, x1) -> - Ast_412.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_413.Parsetree.Pstr_value (x0, x1) -> - Ast_412.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_413.Parsetree.Pstr_primitive x0 -> - Ast_412.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_413.Parsetree.Pstr_type (x0, x1) -> - Ast_412.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_413.Parsetree.Pstr_typext x0 -> - Ast_412.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_413.Parsetree.Pstr_exception x0 -> - Ast_412.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_413.Parsetree.Pstr_module x0 -> - Ast_412.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_413.Parsetree.Pstr_recmodule x0 -> - Ast_412.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_413.Parsetree.Pstr_modtype x0 -> - Ast_412.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_413.Parsetree.Pstr_open x0 -> - Ast_412.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_413.Parsetree.Pstr_class x0 -> - Ast_412.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_413.Parsetree.Pstr_class_type x0 -> - Ast_412.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_413.Parsetree.Pstr_include x0 -> - Ast_412.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_413.Parsetree.Pstr_attribute x0 -> - Ast_412.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pstr_extension (x0, x1) -> - Ast_412.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_413.Parsetree.include_declaration -> - Ast_412.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_413.Parsetree.class_declaration -> Ast_412.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_413.Parsetree.class_expr -> Ast_412.Parsetree.class_expr = - fun - { Ast_413.Parsetree.pcl_desc = pcl_desc; - Ast_413.Parsetree.pcl_loc = pcl_loc; - Ast_413.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_412.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_412.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_412.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_413.Parsetree.class_expr_desc -> Ast_412.Parsetree.class_expr_desc = - function - | Ast_413.Parsetree.Pcl_constr (x0, x1) -> - Ast_412.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Pcl_structure x0 -> - Ast_412.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_413.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_412.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_413.Parsetree.Pcl_apply (x0, x1) -> - Ast_412.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_413.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_412.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_413.Parsetree.Pcl_constraint (x0, x1) -> - Ast_412.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_413.Parsetree.Pcl_extension x0 -> - Ast_412.Parsetree.Pcl_extension (copy_extension x0) - | Ast_413.Parsetree.Pcl_open (x0, x1) -> - Ast_412.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_413.Parsetree.class_structure -> Ast_412.Parsetree.class_structure = - fun - { Ast_413.Parsetree.pcstr_self = pcstr_self; - Ast_413.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_412.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_412.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_413.Parsetree.class_field -> Ast_412.Parsetree.class_field = - fun - { Ast_413.Parsetree.pcf_desc = pcf_desc; - Ast_413.Parsetree.pcf_loc = pcf_loc; - Ast_413.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_412.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_412.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_412.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_413.Parsetree.class_field_desc -> Ast_412.Parsetree.class_field_desc = - function - | Ast_413.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_412.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_413.Parsetree.Pcf_val x0 -> - Ast_412.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_413.Parsetree.Pcf_method x0 -> - Ast_412.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_413.Parsetree.Pcf_constraint x0 -> - Ast_412.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_413.Parsetree.Pcf_initializer x0 -> - Ast_412.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_413.Parsetree.Pcf_attribute x0 -> - Ast_412.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pcf_extension x0 -> - Ast_412.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_413.Parsetree.class_field_kind -> Ast_412.Parsetree.class_field_kind = - function - | Ast_413.Parsetree.Cfk_virtual x0 -> - Ast_412.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_413.Parsetree.Cfk_concrete (x0, x1) -> - Ast_412.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_413.Parsetree.open_declaration -> Ast_412.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_413.Parsetree.module_binding -> Ast_412.Parsetree.module_binding = - fun - { Ast_413.Parsetree.pmb_name = pmb_name; - Ast_413.Parsetree.pmb_expr = pmb_expr; - Ast_413.Parsetree.pmb_attributes = pmb_attributes; - Ast_413.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_412.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_412.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_412.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_412.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_413.Parsetree.module_expr -> Ast_412.Parsetree.module_expr = - fun - { Ast_413.Parsetree.pmod_desc = pmod_desc; - Ast_413.Parsetree.pmod_loc = pmod_loc; - Ast_413.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_412.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_412.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_412.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_413.Parsetree.module_expr_desc -> Ast_412.Parsetree.module_expr_desc = - function - | Ast_413.Parsetree.Pmod_ident x0 -> - Ast_412.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pmod_structure x0 -> - Ast_412.Parsetree.Pmod_structure (copy_structure x0) - | Ast_413.Parsetree.Pmod_functor (x0, x1) -> - Ast_412.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_413.Parsetree.Pmod_apply (x0, x1) -> - Ast_412.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_413.Parsetree.Pmod_constraint (x0, x1) -> - Ast_412.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pmod_unpack x0 -> - Ast_412.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_413.Parsetree.Pmod_extension x0 -> - Ast_412.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_413.Parsetree.functor_parameter -> Ast_412.Parsetree.functor_parameter - = - function - | Ast_413.Parsetree.Unit -> Ast_412.Parsetree.Unit - | Ast_413.Parsetree.Named (x0, x1) -> - Ast_412.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_413.Parsetree.module_type -> Ast_412.Parsetree.module_type = - fun - { Ast_413.Parsetree.pmty_desc = pmty_desc; - Ast_413.Parsetree.pmty_loc = pmty_loc; - Ast_413.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_412.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_412.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_412.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_413.Parsetree.module_type_desc -> Ast_412.Parsetree.module_type_desc = - function - | Ast_413.Parsetree.Pmty_ident x0 -> - Ast_412.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pmty_signature x0 -> - Ast_412.Parsetree.Pmty_signature (copy_signature x0) - | Ast_413.Parsetree.Pmty_functor (x0, x1) -> - Ast_412.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pmty_with (x0, x1) -> - Ast_412.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_413.Parsetree.Pmty_typeof x0 -> - Ast_412.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_413.Parsetree.Pmty_extension x0 -> - Ast_412.Parsetree.Pmty_extension (copy_extension x0) - | Ast_413.Parsetree.Pmty_alias x0 -> - Ast_412.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_413.Parsetree.with_constraint -> Ast_412.Parsetree.with_constraint = - function - | Ast_413.Parsetree.Pwith_type (x0, x1) -> - Ast_412.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_413.Parsetree.Pwith_module (x0, x1) -> - Ast_412.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_413.Parsetree.Pwith_modtype (_, x1) -> - migration_error x1.Ast_413.Parsetree.pmty_loc With_modtype - | Ast_413.Parsetree.Pwith_modtypesubst (_, x1) -> - migration_error x1.Ast_413.Parsetree.pmty_loc With_modtypesubst - | Ast_413.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_412.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_413.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_412.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_413.Parsetree.signature -> Ast_412.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_413.Parsetree.signature_item -> Ast_412.Parsetree.signature_item = - fun - { Ast_413.Parsetree.psig_desc = psig_desc; - Ast_413.Parsetree.psig_loc = psig_loc } - -> - { - Ast_412.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_412.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_413.Parsetree.signature_item_desc -> - Ast_412.Parsetree.signature_item_desc - = - function - | Ast_413.Parsetree.Psig_value x0 -> - Ast_412.Parsetree.Psig_value (copy_value_description x0) - | Ast_413.Parsetree.Psig_type (x0, x1) -> - Ast_412.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_413.Parsetree.Psig_typesubst x0 -> - Ast_412.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_413.Parsetree.Psig_typext x0 -> - Ast_412.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_413.Parsetree.Psig_exception x0 -> - Ast_412.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_413.Parsetree.Psig_module x0 -> - Ast_412.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_413.Parsetree.Psig_modsubst x0 -> - Ast_412.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_413.Parsetree.Psig_recmodule x0 -> - Ast_412.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_413.Parsetree.Psig_modtype x0 -> - Ast_412.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_413.Parsetree.Psig_modtypesubst x0 -> - migration_error x0.Ast_413.Parsetree.pmtd_loc Psig_modtypesubst - | Ast_413.Parsetree.Psig_open x0 -> - Ast_412.Parsetree.Psig_open (copy_open_description x0) - | Ast_413.Parsetree.Psig_include x0 -> - Ast_412.Parsetree.Psig_include (copy_include_description x0) - | Ast_413.Parsetree.Psig_class x0 -> - Ast_412.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_413.Parsetree.Psig_class_type x0 -> - Ast_412.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_413.Parsetree.Psig_attribute x0 -> - Ast_412.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_413.Parsetree.Psig_extension (x0, x1) -> - Ast_412.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_413.Parsetree.class_type_declaration -> - Ast_412.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_413.Parsetree.class_description -> Ast_412.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_413.Parsetree.class_type -> Ast_412.Parsetree.class_type = - fun - { Ast_413.Parsetree.pcty_desc = pcty_desc; - Ast_413.Parsetree.pcty_loc = pcty_loc; - Ast_413.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_412.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_412.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_412.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_413.Parsetree.class_type_desc -> Ast_412.Parsetree.class_type_desc = - function - | Ast_413.Parsetree.Pcty_constr (x0, x1) -> - Ast_412.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Pcty_signature x0 -> - Ast_412.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_413.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_412.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_413.Parsetree.Pcty_extension x0 -> - Ast_412.Parsetree.Pcty_extension (copy_extension x0) - | Ast_413.Parsetree.Pcty_open (x0, x1) -> - Ast_412.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_413.Parsetree.class_signature -> Ast_412.Parsetree.class_signature = - fun - { Ast_413.Parsetree.pcsig_self = pcsig_self; - Ast_413.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_412.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_412.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_413.Parsetree.class_type_field -> Ast_412.Parsetree.class_type_field = - fun - { Ast_413.Parsetree.pctf_desc = pctf_desc; - Ast_413.Parsetree.pctf_loc = pctf_loc; - Ast_413.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_412.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_412.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_412.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_413.Parsetree.class_type_field_desc -> - Ast_412.Parsetree.class_type_field_desc - = - function - | Ast_413.Parsetree.Pctf_inherit x0 -> - Ast_412.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_413.Parsetree.Pctf_val x0 -> - Ast_412.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_413.Parsetree.Pctf_method x0 -> - Ast_412.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_413.Parsetree.Pctf_constraint x0 -> - Ast_412.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_413.Parsetree.Pctf_attribute x0 -> - Ast_412.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pctf_extension x0 -> - Ast_412.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_413.Parsetree.extension -> Ast_412.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_413.Parsetree.class_infos -> 'g0 Ast_412.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.pci_virt = pci_virt; - Ast_413.Parsetree.pci_params = pci_params; - Ast_413.Parsetree.pci_name = pci_name; - Ast_413.Parsetree.pci_expr = pci_expr; - Ast_413.Parsetree.pci_loc = pci_loc; - Ast_413.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_412.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_412.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_412.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_412.Parsetree.pci_expr = (f0 pci_expr); - Ast_412.Parsetree.pci_loc = (copy_location pci_loc); - Ast_412.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_413.Asttypes.virtual_flag -> Ast_412.Asttypes.virtual_flag = - function - | Ast_413.Asttypes.Virtual -> Ast_412.Asttypes.Virtual - | Ast_413.Asttypes.Concrete -> Ast_412.Asttypes.Concrete -and copy_include_description : - Ast_413.Parsetree.include_description -> - Ast_412.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_413.Parsetree.include_infos -> - 'g0 Ast_412.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.pincl_mod = pincl_mod; - Ast_413.Parsetree.pincl_loc = pincl_loc; - Ast_413.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_412.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_412.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_412.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_413.Parsetree.open_description -> Ast_412.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_413.Parsetree.open_infos -> 'g0 Ast_412.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.popen_expr = popen_expr; - Ast_413.Parsetree.popen_override = popen_override; - Ast_413.Parsetree.popen_loc = popen_loc; - Ast_413.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_412.Parsetree.popen_expr = (f0 popen_expr); - Ast_412.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_412.Parsetree.popen_loc = (copy_location popen_loc); - Ast_412.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_413.Asttypes.override_flag -> Ast_412.Asttypes.override_flag = - function - | Ast_413.Asttypes.Override -> Ast_412.Asttypes.Override - | Ast_413.Asttypes.Fresh -> Ast_412.Asttypes.Fresh -and copy_module_type_declaration : - Ast_413.Parsetree.module_type_declaration -> - Ast_412.Parsetree.module_type_declaration - = - fun - { Ast_413.Parsetree.pmtd_name = pmtd_name; - Ast_413.Parsetree.pmtd_type = pmtd_type; - Ast_413.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_413.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_412.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_412.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_412.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_412.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_413.Parsetree.module_substitution -> - Ast_412.Parsetree.module_substitution - = - fun - { Ast_413.Parsetree.pms_name = pms_name; - Ast_413.Parsetree.pms_manifest = pms_manifest; - Ast_413.Parsetree.pms_attributes = pms_attributes; - Ast_413.Parsetree.pms_loc = pms_loc } - -> - { - Ast_412.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_412.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_412.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_412.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_413.Parsetree.module_declaration -> - Ast_412.Parsetree.module_declaration - = - fun - { Ast_413.Parsetree.pmd_name = pmd_name; - Ast_413.Parsetree.pmd_type = pmd_type; - Ast_413.Parsetree.pmd_attributes = pmd_attributes; - Ast_413.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_412.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_412.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_412.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_412.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_413.Parsetree.type_exception -> Ast_412.Parsetree.type_exception = - fun - { Ast_413.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_413.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_413.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_412.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_412.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_412.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_413.Parsetree.type_extension -> Ast_412.Parsetree.type_extension = - fun - { Ast_413.Parsetree.ptyext_path = ptyext_path; - Ast_413.Parsetree.ptyext_params = ptyext_params; - Ast_413.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_413.Parsetree.ptyext_private = ptyext_private; - Ast_413.Parsetree.ptyext_loc = ptyext_loc; - Ast_413.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_412.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_412.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_412.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_412.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_412.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_412.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_413.Parsetree.extension_constructor -> - Ast_412.Parsetree.extension_constructor - = - fun - { Ast_413.Parsetree.pext_name = pext_name; - Ast_413.Parsetree.pext_kind = pext_kind; - Ast_413.Parsetree.pext_loc = pext_loc; - Ast_413.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_412.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_412.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_412.Parsetree.pext_loc = (copy_location pext_loc); - Ast_412.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_413.Parsetree.extension_constructor_kind -> - Ast_412.Parsetree.extension_constructor_kind - = - function - | Ast_413.Parsetree.Pext_decl (x0, x1) -> - Ast_412.Parsetree.Pext_decl - ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) - | Ast_413.Parsetree.Pext_rebind x0 -> - Ast_412.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_413.Parsetree.type_declaration -> Ast_412.Parsetree.type_declaration = - fun - { Ast_413.Parsetree.ptype_name = ptype_name; - Ast_413.Parsetree.ptype_params = ptype_params; - Ast_413.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_413.Parsetree.ptype_kind = ptype_kind; - Ast_413.Parsetree.ptype_private = ptype_private; - Ast_413.Parsetree.ptype_manifest = ptype_manifest; - Ast_413.Parsetree.ptype_attributes = ptype_attributes; - Ast_413.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_412.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_412.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_412.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_412.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_412.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_412.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_412.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_412.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_413.Asttypes.private_flag -> Ast_412.Asttypes.private_flag = - function - | Ast_413.Asttypes.Private -> Ast_412.Asttypes.Private - | Ast_413.Asttypes.Public -> Ast_412.Asttypes.Public -and copy_type_kind : - Ast_413.Parsetree.type_kind -> Ast_412.Parsetree.type_kind = - function - | Ast_413.Parsetree.Ptype_abstract -> Ast_412.Parsetree.Ptype_abstract - | Ast_413.Parsetree.Ptype_variant x0 -> - Ast_412.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_413.Parsetree.Ptype_record x0 -> - Ast_412.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_413.Parsetree.Ptype_open -> Ast_412.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_413.Parsetree.constructor_declaration -> - Ast_412.Parsetree.constructor_declaration - = - fun - { Ast_413.Parsetree.pcd_name = pcd_name; - Ast_413.Parsetree.pcd_args = pcd_args; - Ast_413.Parsetree.pcd_res = pcd_res; - Ast_413.Parsetree.pcd_loc = pcd_loc; - Ast_413.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_412.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_412.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_412.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_412.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_412.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_413.Parsetree.constructor_arguments -> - Ast_412.Parsetree.constructor_arguments - = - function - | Ast_413.Parsetree.Pcstr_tuple x0 -> - Ast_412.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_413.Parsetree.Pcstr_record x0 -> - Ast_412.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_413.Parsetree.label_declaration -> Ast_412.Parsetree.label_declaration - = - fun - { Ast_413.Parsetree.pld_name = pld_name; - Ast_413.Parsetree.pld_mutable = pld_mutable; - Ast_413.Parsetree.pld_type = pld_type; - Ast_413.Parsetree.pld_loc = pld_loc; - Ast_413.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_412.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_412.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_412.Parsetree.pld_type = (copy_core_type pld_type); - Ast_412.Parsetree.pld_loc = (copy_location pld_loc); - Ast_412.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_413.Asttypes.mutable_flag -> Ast_412.Asttypes.mutable_flag = - function - | Ast_413.Asttypes.Immutable -> Ast_412.Asttypes.Immutable - | Ast_413.Asttypes.Mutable -> Ast_412.Asttypes.Mutable -and copy_injectivity : - Ast_413.Asttypes.injectivity -> Ast_412.Asttypes.injectivity = - function - | Ast_413.Asttypes.Injective -> Ast_412.Asttypes.Injective - | Ast_413.Asttypes.NoInjectivity -> Ast_412.Asttypes.NoInjectivity -and copy_variance : Ast_413.Asttypes.variance -> Ast_412.Asttypes.variance = - function - | Ast_413.Asttypes.Covariant -> Ast_412.Asttypes.Covariant - | Ast_413.Asttypes.Contravariant -> Ast_412.Asttypes.Contravariant - | Ast_413.Asttypes.NoVariance -> Ast_412.Asttypes.NoVariance -and copy_value_description : - Ast_413.Parsetree.value_description -> Ast_412.Parsetree.value_description - = - fun - { Ast_413.Parsetree.pval_name = pval_name; - Ast_413.Parsetree.pval_type = pval_type; - Ast_413.Parsetree.pval_prim = pval_prim; - Ast_413.Parsetree.pval_attributes = pval_attributes; - Ast_413.Parsetree.pval_loc = pval_loc } - -> - { - Ast_412.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_412.Parsetree.pval_type = (copy_core_type pval_type); - Ast_412.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_412.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_412.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_413.Parsetree.object_field_desc -> Ast_412.Parsetree.object_field_desc - = - function - | Ast_413.Parsetree.Otag (x0, x1) -> - Ast_412.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_413.Parsetree.Oinherit x0 -> - Ast_412.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_413.Asttypes.arg_label -> Ast_412.Asttypes.arg_label - = - function - | Ast_413.Asttypes.Nolabel -> Ast_412.Asttypes.Nolabel - | Ast_413.Asttypes.Labelled x0 -> Ast_412.Asttypes.Labelled x0 - | Ast_413.Asttypes.Optional x0 -> Ast_412.Asttypes.Optional x0 -and copy_closed_flag : - Ast_413.Asttypes.closed_flag -> Ast_412.Asttypes.closed_flag = - function - | Ast_413.Asttypes.Closed -> Ast_412.Asttypes.Closed - | Ast_413.Asttypes.Open -> Ast_412.Asttypes.Open -and copy_label : Ast_413.Asttypes.label -> Ast_412.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_413.Asttypes.rec_flag -> Ast_412.Asttypes.rec_flag = - function - | Ast_413.Asttypes.Nonrecursive -> Ast_412.Asttypes.Nonrecursive - | Ast_413.Asttypes.Recursive -> Ast_412.Asttypes.Recursive -and copy_constant : Ast_413.Parsetree.constant -> Ast_412.Parsetree.constant - = - function - | Ast_413.Parsetree.Pconst_integer (x0, x1) -> - Ast_412.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_413.Parsetree.Pconst_char x0 -> Ast_412.Parsetree.Pconst_char x0 - | Ast_413.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_412.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_413.Parsetree.Pconst_float (x0, x1) -> - Ast_412.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_413.Asttypes.loc -> 'g0 Ast_412.Asttypes.loc - = - fun f0 -> - fun { Ast_413.Asttypes.txt = txt; Ast_413.Asttypes.loc = loc } -> - { - Ast_412.Asttypes.txt = (f0 txt); - Ast_412.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_413_414.ml b/src/vendored-omp/src/migrate_parsetree_413_414.ml index b52be0951..82eed13e2 100644 --- a/src/vendored-omp/src/migrate_parsetree_413_414.ml +++ b/src/vendored-omp/src/migrate_parsetree_413_414.ml @@ -15,130 +15,3 @@ include Migrate_parsetree_413_414_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_414_413_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } - diff --git a/src/vendored-omp/src/migrate_parsetree_413_414_migrate.ml b/src/vendored-omp/src/migrate_parsetree_413_414_migrate.ml index 6ebac11f9..cd52b9422 100644 --- a/src/vendored-omp/src/migrate_parsetree_413_414_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_413_414_migrate.ml @@ -158,6 +158,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_414.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_413.Asttypes.private_flag -> Ast_414.Asttypes.private_flag = + function + | Ast_413.Asttypes.Private -> Ast_414.Asttypes.Private + | Ast_413.Asttypes.Public -> Ast_414.Asttypes.Public and copy_out_rec_status : Ast_413.Outcometree.out_rec_status -> Ast_414.Outcometree.out_rec_status = function @@ -194,6 +199,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_413.Asttypes.injectivity -> Ast_414.Asttypes.injectivity = + function + | Ast_413.Asttypes.Injective -> Ast_414.Asttypes.Injective + | Ast_413.Asttypes.NoInjectivity -> Ast_414.Asttypes.NoInjectivity +and copy_variance : Ast_413.Asttypes.variance -> Ast_414.Asttypes.variance = + function + | Ast_413.Asttypes.Covariant -> Ast_414.Asttypes.Covariant + | Ast_413.Asttypes.Contravariant -> Ast_414.Asttypes.Contravariant + | Ast_413.Asttypes.NoVariance -> Ast_414.Asttypes.NoVariance and copy_out_type : Ast_413.Outcometree.out_type -> Ast_414.Outcometree.out_type = function @@ -244,7 +259,9 @@ and copy_out_type : ((List.map (fun x -> x) x0), (copy_out_type x1)) | Ast_413.Outcometree.Otyp_module (x0, x1) -> Ast_414.Outcometree.Otyp_module - ((copy_out_ident x0), (List.map (fun (x, y) -> x, copy_out_type y) x1)) + ((copy_out_ident x0), + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) | Ast_413.Outcometree.Otyp_attribute (x0, x1) -> Ast_414.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) @@ -315,1221 +332,3 @@ and copy_out_name : Ast_413.Outcometree.out_name -> Ast_414.Outcometree.out_name = fun { Ast_413.Outcometree.printed_name = printed_name } -> { Ast_414.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_413.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase = - function - | Ast_413.Parsetree.Ptop_def x0 -> - Ast_414.Parsetree.Ptop_def (copy_structure x0) - | Ast_413.Parsetree.Ptop_dir x0 -> - Ast_414.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_413.Parsetree.toplevel_directive -> - Ast_414.Parsetree.toplevel_directive - = - fun - { Ast_413.Parsetree.pdir_name = pdir_name; - Ast_413.Parsetree.pdir_arg = pdir_arg; - Ast_413.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_414.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_414.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_414.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_413.Parsetree.directive_argument -> - Ast_414.Parsetree.directive_argument - = - fun - { Ast_413.Parsetree.pdira_desc = pdira_desc; - Ast_413.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_414.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_414.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_413.Parsetree.directive_argument_desc -> - Ast_414.Parsetree.directive_argument_desc - = - function - | Ast_413.Parsetree.Pdir_string x0 -> Ast_414.Parsetree.Pdir_string x0 - | Ast_413.Parsetree.Pdir_int (x0, x1) -> - Ast_414.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_413.Parsetree.Pdir_ident x0 -> - Ast_414.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_413.Parsetree.Pdir_bool x0 -> Ast_414.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_413.Parsetree.expression -> Ast_414.Parsetree.expression = - fun - { Ast_413.Parsetree.pexp_desc = pexp_desc; - Ast_413.Parsetree.pexp_loc = pexp_loc; - Ast_413.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_413.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_414.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_414.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_414.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_414.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_413.Parsetree.expression_desc -> Ast_414.Parsetree.expression_desc = - function - | Ast_413.Parsetree.Pexp_ident x0 -> - Ast_414.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pexp_constant x0 -> - Ast_414.Parsetree.Pexp_constant (copy_constant x0) - | Ast_413.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_413.Parsetree.Pexp_function x0 -> - Ast_414.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_413.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_414.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_413.Parsetree.Pexp_apply (x0, x1) -> - Ast_414.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_413.Parsetree.Pexp_match (x0, x1) -> - Ast_414.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_413.Parsetree.Pexp_try (x0, x1) -> - Ast_414.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_413.Parsetree.Pexp_tuple x0 -> - Ast_414.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_413.Parsetree.Pexp_construct (x0, x1) -> - Ast_414.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_413.Parsetree.Pexp_variant (x0, x1) -> - Ast_414.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_413.Parsetree.Pexp_record (x0, x1) -> - Ast_414.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_413.Parsetree.Pexp_field (x0, x1) -> - Ast_414.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_413.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_413.Parsetree.Pexp_array x0 -> - Ast_414.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_413.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_413.Parsetree.Pexp_sequence (x0, x1) -> - Ast_414.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_while (x0, x1) -> - Ast_414.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_414.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_413.Parsetree.Pexp_constraint (x0, x1) -> - Ast_414.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_413.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_413.Parsetree.Pexp_send (x0, x1) -> - Ast_414.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_413.Parsetree.Pexp_new x0 -> - Ast_414.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_414.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_override x0 -> - Ast_414.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_413.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_413.Parsetree.Pexp_letexception (x0, x1) -> - Ast_414.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_assert x0 -> - Ast_414.Parsetree.Pexp_assert (copy_expression x0) - | Ast_413.Parsetree.Pexp_lazy x0 -> - Ast_414.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_413.Parsetree.Pexp_poly (x0, x1) -> - Ast_414.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_413.Parsetree.Pexp_object x0 -> - Ast_414.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_413.Parsetree.Pexp_newtype (x0, x1) -> - Ast_414.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_pack x0 -> - Ast_414.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_413.Parsetree.Pexp_open (x0, x1) -> - Ast_414.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_413.Parsetree.Pexp_letop x0 -> - Ast_414.Parsetree.Pexp_letop (copy_letop x0) - | Ast_413.Parsetree.Pexp_extension x0 -> - Ast_414.Parsetree.Pexp_extension (copy_extension x0) - | Ast_413.Parsetree.Pexp_unreachable -> Ast_414.Parsetree.Pexp_unreachable -and copy_letop : Ast_413.Parsetree.letop -> Ast_414.Parsetree.letop = - fun - { Ast_413.Parsetree.let_ = let_; Ast_413.Parsetree.ands = ands; - Ast_413.Parsetree.body = body } - -> - { - Ast_414.Parsetree.let_ = (copy_binding_op let_); - Ast_414.Parsetree.ands = (List.map copy_binding_op ands); - Ast_414.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_413.Parsetree.binding_op -> Ast_414.Parsetree.binding_op = - fun - { Ast_413.Parsetree.pbop_op = pbop_op; - Ast_413.Parsetree.pbop_pat = pbop_pat; - Ast_413.Parsetree.pbop_exp = pbop_exp; - Ast_413.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_414.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_414.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_414.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_414.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_413.Asttypes.direction_flag -> Ast_414.Asttypes.direction_flag = - function - | Ast_413.Asttypes.Upto -> Ast_414.Asttypes.Upto - | Ast_413.Asttypes.Downto -> Ast_414.Asttypes.Downto -and copy_case : Ast_413.Parsetree.case -> Ast_414.Parsetree.case = - fun - { Ast_413.Parsetree.pc_lhs = pc_lhs; - Ast_413.Parsetree.pc_guard = pc_guard; - Ast_413.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_414.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_414.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_414.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_413.Parsetree.value_binding -> Ast_414.Parsetree.value_binding = - fun - { Ast_413.Parsetree.pvb_pat = pvb_pat; - Ast_413.Parsetree.pvb_expr = pvb_expr; - Ast_413.Parsetree.pvb_attributes = pvb_attributes; - Ast_413.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_414.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_414.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_414.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_414.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_413.Parsetree.pattern -> Ast_414.Parsetree.pattern = - fun - { Ast_413.Parsetree.ppat_desc = ppat_desc; - Ast_413.Parsetree.ppat_loc = ppat_loc; - Ast_413.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_413.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_414.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_414.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_414.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_414.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_413.Parsetree.pattern_desc -> Ast_414.Parsetree.pattern_desc = - function - | Ast_413.Parsetree.Ppat_any -> Ast_414.Parsetree.Ppat_any - | Ast_413.Parsetree.Ppat_var x0 -> - Ast_414.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_413.Parsetree.Ppat_alias (x0, x1) -> - Ast_414.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_413.Parsetree.Ppat_constant x0 -> - Ast_414.Parsetree.Ppat_constant (copy_constant x0) - | Ast_413.Parsetree.Ppat_interval (x0, x1) -> - Ast_414.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_413.Parsetree.Ppat_tuple x0 -> - Ast_414.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_413.Parsetree.Ppat_construct (x0, x1) -> - Ast_414.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), (Option.map (fun (x0, x1) -> x0, copy_pattern x1) x1)) - | Ast_413.Parsetree.Ppat_variant (x0, x1) -> - Ast_414.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_413.Parsetree.Ppat_record (x0, x1) -> - Ast_414.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_413.Parsetree.Ppat_array x0 -> - Ast_414.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_413.Parsetree.Ppat_or (x0, x1) -> - Ast_414.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_413.Parsetree.Ppat_constraint (x0, x1) -> - Ast_414.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_413.Parsetree.Ppat_type x0 -> - Ast_414.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Ppat_lazy x0 -> - Ast_414.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_413.Parsetree.Ppat_unpack x0 -> - Ast_414.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_413.Parsetree.Ppat_exception x0 -> - Ast_414.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_413.Parsetree.Ppat_extension x0 -> - Ast_414.Parsetree.Ppat_extension (copy_extension x0) - | Ast_413.Parsetree.Ppat_open (x0, x1) -> - Ast_414.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_413.Parsetree.core_type -> Ast_414.Parsetree.core_type = - fun - { Ast_413.Parsetree.ptyp_desc = ptyp_desc; - Ast_413.Parsetree.ptyp_loc = ptyp_loc; - Ast_413.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_413.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_414.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_414.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_414.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_414.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_413.Parsetree.location_stack -> Ast_414.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_413.Parsetree.core_type_desc -> Ast_414.Parsetree.core_type_desc = - function - | Ast_413.Parsetree.Ptyp_any -> Ast_414.Parsetree.Ptyp_any - | Ast_413.Parsetree.Ptyp_var x0 -> Ast_414.Parsetree.Ptyp_var x0 - | Ast_413.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_414.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_413.Parsetree.Ptyp_tuple x0 -> - Ast_414.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_413.Parsetree.Ptyp_constr (x0, x1) -> - Ast_414.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_object (x0, x1) -> - Ast_414.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_413.Parsetree.Ptyp_class (x0, x1) -> - Ast_414.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_alias (x0, x1) -> - Ast_414.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_413.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_414.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_413.Parsetree.Ptyp_poly (x0, x1) -> - Ast_414.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_413.Parsetree.Ptyp_package x0 -> - Ast_414.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_413.Parsetree.Ptyp_extension x0 -> - Ast_414.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_413.Parsetree.package_type -> Ast_414.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_413.Parsetree.row_field -> Ast_414.Parsetree.row_field = - fun - { Ast_413.Parsetree.prf_desc = prf_desc; - Ast_413.Parsetree.prf_loc = prf_loc; - Ast_413.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_414.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_414.Parsetree.prf_loc = (copy_location prf_loc); - Ast_414.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_413.Parsetree.row_field_desc -> Ast_414.Parsetree.row_field_desc = - function - | Ast_413.Parsetree.Rtag (x0, x1, x2) -> - Ast_414.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_413.Parsetree.Rinherit x0 -> - Ast_414.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_413.Parsetree.object_field -> Ast_414.Parsetree.object_field = - fun - { Ast_413.Parsetree.pof_desc = pof_desc; - Ast_413.Parsetree.pof_loc = pof_loc; - Ast_413.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_414.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_414.Parsetree.pof_loc = (copy_location pof_loc); - Ast_414.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_413.Parsetree.attributes -> Ast_414.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_413.Parsetree.attribute -> Ast_414.Parsetree.attribute = - fun - { Ast_413.Parsetree.attr_name = attr_name; - Ast_413.Parsetree.attr_payload = attr_payload; - Ast_413.Parsetree.attr_loc = attr_loc } - -> - { - Ast_414.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_414.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_414.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_413.Parsetree.payload -> Ast_414.Parsetree.payload = - function - | Ast_413.Parsetree.PStr x0 -> Ast_414.Parsetree.PStr (copy_structure x0) - | Ast_413.Parsetree.PSig x0 -> Ast_414.Parsetree.PSig (copy_signature x0) - | Ast_413.Parsetree.PTyp x0 -> Ast_414.Parsetree.PTyp (copy_core_type x0) - | Ast_413.Parsetree.PPat (x0, x1) -> - Ast_414.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_413.Parsetree.structure -> Ast_414.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_413.Parsetree.structure_item -> Ast_414.Parsetree.structure_item = - fun - { Ast_413.Parsetree.pstr_desc = pstr_desc; - Ast_413.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_414.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_414.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_413.Parsetree.structure_item_desc -> - Ast_414.Parsetree.structure_item_desc - = - function - | Ast_413.Parsetree.Pstr_eval (x0, x1) -> - Ast_414.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_413.Parsetree.Pstr_value (x0, x1) -> - Ast_414.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_413.Parsetree.Pstr_primitive x0 -> - Ast_414.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_413.Parsetree.Pstr_type (x0, x1) -> - Ast_414.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_413.Parsetree.Pstr_typext x0 -> - Ast_414.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_413.Parsetree.Pstr_exception x0 -> - Ast_414.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_413.Parsetree.Pstr_module x0 -> - Ast_414.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_413.Parsetree.Pstr_recmodule x0 -> - Ast_414.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_413.Parsetree.Pstr_modtype x0 -> - Ast_414.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_413.Parsetree.Pstr_open x0 -> - Ast_414.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_413.Parsetree.Pstr_class x0 -> - Ast_414.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_413.Parsetree.Pstr_class_type x0 -> - Ast_414.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_413.Parsetree.Pstr_include x0 -> - Ast_414.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_413.Parsetree.Pstr_attribute x0 -> - Ast_414.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pstr_extension (x0, x1) -> - Ast_414.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_413.Parsetree.include_declaration -> - Ast_414.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_413.Parsetree.class_declaration -> Ast_414.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_413.Parsetree.class_expr -> Ast_414.Parsetree.class_expr = - fun - { Ast_413.Parsetree.pcl_desc = pcl_desc; - Ast_413.Parsetree.pcl_loc = pcl_loc; - Ast_413.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_414.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_414.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_414.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_413.Parsetree.class_expr_desc -> Ast_414.Parsetree.class_expr_desc = - function - | Ast_413.Parsetree.Pcl_constr (x0, x1) -> - Ast_414.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Pcl_structure x0 -> - Ast_414.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_413.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_414.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_413.Parsetree.Pcl_apply (x0, x1) -> - Ast_414.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_413.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_414.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_413.Parsetree.Pcl_constraint (x0, x1) -> - Ast_414.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_413.Parsetree.Pcl_extension x0 -> - Ast_414.Parsetree.Pcl_extension (copy_extension x0) - | Ast_413.Parsetree.Pcl_open (x0, x1) -> - Ast_414.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_413.Parsetree.class_structure -> Ast_414.Parsetree.class_structure = - fun - { Ast_413.Parsetree.pcstr_self = pcstr_self; - Ast_413.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_414.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_414.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_413.Parsetree.class_field -> Ast_414.Parsetree.class_field = - fun - { Ast_413.Parsetree.pcf_desc = pcf_desc; - Ast_413.Parsetree.pcf_loc = pcf_loc; - Ast_413.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_414.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_414.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_414.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_413.Parsetree.class_field_desc -> Ast_414.Parsetree.class_field_desc = - function - | Ast_413.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_414.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_413.Parsetree.Pcf_val x0 -> - Ast_414.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_413.Parsetree.Pcf_method x0 -> - Ast_414.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_413.Parsetree.Pcf_constraint x0 -> - Ast_414.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_413.Parsetree.Pcf_initializer x0 -> - Ast_414.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_413.Parsetree.Pcf_attribute x0 -> - Ast_414.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pcf_extension x0 -> - Ast_414.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_413.Parsetree.class_field_kind -> Ast_414.Parsetree.class_field_kind = - function - | Ast_413.Parsetree.Cfk_virtual x0 -> - Ast_414.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_413.Parsetree.Cfk_concrete (x0, x1) -> - Ast_414.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_413.Parsetree.open_declaration -> Ast_414.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_413.Parsetree.module_binding -> Ast_414.Parsetree.module_binding = - fun - { Ast_413.Parsetree.pmb_name = pmb_name; - Ast_413.Parsetree.pmb_expr = pmb_expr; - Ast_413.Parsetree.pmb_attributes = pmb_attributes; - Ast_413.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_414.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_414.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_414.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_414.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_413.Parsetree.module_expr -> Ast_414.Parsetree.module_expr = - fun - { Ast_413.Parsetree.pmod_desc = pmod_desc; - Ast_413.Parsetree.pmod_loc = pmod_loc; - Ast_413.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_414.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_414.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_414.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_413.Parsetree.module_expr_desc -> Ast_414.Parsetree.module_expr_desc = - function - | Ast_413.Parsetree.Pmod_ident x0 -> - Ast_414.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pmod_structure x0 -> - Ast_414.Parsetree.Pmod_structure (copy_structure x0) - | Ast_413.Parsetree.Pmod_functor (x0, x1) -> - Ast_414.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_413.Parsetree.Pmod_apply (x0, x1) -> - Ast_414.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_413.Parsetree.Pmod_constraint (x0, x1) -> - Ast_414.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pmod_unpack x0 -> - Ast_414.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_413.Parsetree.Pmod_extension x0 -> - Ast_414.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_413.Parsetree.functor_parameter -> Ast_414.Parsetree.functor_parameter - = - function - | Ast_413.Parsetree.Unit -> Ast_414.Parsetree.Unit - | Ast_413.Parsetree.Named (x0, x1) -> - Ast_414.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_413.Parsetree.module_type -> Ast_414.Parsetree.module_type = - fun - { Ast_413.Parsetree.pmty_desc = pmty_desc; - Ast_413.Parsetree.pmty_loc = pmty_loc; - Ast_413.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_414.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_414.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_414.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_413.Parsetree.module_type_desc -> Ast_414.Parsetree.module_type_desc = - function - | Ast_413.Parsetree.Pmty_ident x0 -> - Ast_414.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_413.Parsetree.Pmty_signature x0 -> - Ast_414.Parsetree.Pmty_signature (copy_signature x0) - | Ast_413.Parsetree.Pmty_functor (x0, x1) -> - Ast_414.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pmty_with (x0, x1) -> - Ast_414.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_413.Parsetree.Pmty_typeof x0 -> - Ast_414.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_413.Parsetree.Pmty_extension x0 -> - Ast_414.Parsetree.Pmty_extension (copy_extension x0) - | Ast_413.Parsetree.Pmty_alias x0 -> - Ast_414.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_413.Parsetree.with_constraint -> Ast_414.Parsetree.with_constraint = - function - | Ast_413.Parsetree.Pwith_type (x0, x1) -> - Ast_414.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_413.Parsetree.Pwith_module (x0, x1) -> - Ast_414.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_413.Parsetree.Pwith_modtype (x0, x1) -> - Ast_414.Parsetree.Pwith_modtype - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pwith_modtypesubst (x0, x1) -> - Ast_414.Parsetree.Pwith_modtypesubst - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_413.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_414.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_413.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_414.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_413.Parsetree.signature -> Ast_414.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_413.Parsetree.signature_item -> Ast_414.Parsetree.signature_item = - fun - { Ast_413.Parsetree.psig_desc = psig_desc; - Ast_413.Parsetree.psig_loc = psig_loc } - -> - { - Ast_414.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_414.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_413.Parsetree.signature_item_desc -> - Ast_414.Parsetree.signature_item_desc - = - function - | Ast_413.Parsetree.Psig_value x0 -> - Ast_414.Parsetree.Psig_value (copy_value_description x0) - | Ast_413.Parsetree.Psig_type (x0, x1) -> - Ast_414.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_413.Parsetree.Psig_typesubst x0 -> - Ast_414.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_413.Parsetree.Psig_typext x0 -> - Ast_414.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_413.Parsetree.Psig_exception x0 -> - Ast_414.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_413.Parsetree.Psig_module x0 -> - Ast_414.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_413.Parsetree.Psig_modsubst x0 -> - Ast_414.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_413.Parsetree.Psig_recmodule x0 -> - Ast_414.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_413.Parsetree.Psig_modtype x0 -> - Ast_414.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_413.Parsetree.Psig_modtypesubst x0 -> - Ast_414.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) - | Ast_413.Parsetree.Psig_open x0 -> - Ast_414.Parsetree.Psig_open (copy_open_description x0) - | Ast_413.Parsetree.Psig_include x0 -> - Ast_414.Parsetree.Psig_include (copy_include_description x0) - | Ast_413.Parsetree.Psig_class x0 -> - Ast_414.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_413.Parsetree.Psig_class_type x0 -> - Ast_414.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_413.Parsetree.Psig_attribute x0 -> - Ast_414.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_413.Parsetree.Psig_extension (x0, x1) -> - Ast_414.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_413.Parsetree.class_type_declaration -> - Ast_414.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_413.Parsetree.class_description -> Ast_414.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_413.Parsetree.class_type -> Ast_414.Parsetree.class_type = - fun - { Ast_413.Parsetree.pcty_desc = pcty_desc; - Ast_413.Parsetree.pcty_loc = pcty_loc; - Ast_413.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_414.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_414.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_414.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_413.Parsetree.class_type_desc -> Ast_414.Parsetree.class_type_desc = - function - | Ast_413.Parsetree.Pcty_constr (x0, x1) -> - Ast_414.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_413.Parsetree.Pcty_signature x0 -> - Ast_414.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_413.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_414.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_413.Parsetree.Pcty_extension x0 -> - Ast_414.Parsetree.Pcty_extension (copy_extension x0) - | Ast_413.Parsetree.Pcty_open (x0, x1) -> - Ast_414.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_413.Parsetree.class_signature -> Ast_414.Parsetree.class_signature = - fun - { Ast_413.Parsetree.pcsig_self = pcsig_self; - Ast_413.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_414.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_414.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_413.Parsetree.class_type_field -> Ast_414.Parsetree.class_type_field = - fun - { Ast_413.Parsetree.pctf_desc = pctf_desc; - Ast_413.Parsetree.pctf_loc = pctf_loc; - Ast_413.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_414.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_414.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_414.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_413.Parsetree.class_type_field_desc -> - Ast_414.Parsetree.class_type_field_desc - = - function - | Ast_413.Parsetree.Pctf_inherit x0 -> - Ast_414.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_413.Parsetree.Pctf_val x0 -> - Ast_414.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_413.Parsetree.Pctf_method x0 -> - Ast_414.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_413.Parsetree.Pctf_constraint x0 -> - Ast_414.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_413.Parsetree.Pctf_attribute x0 -> - Ast_414.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_413.Parsetree.Pctf_extension x0 -> - Ast_414.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_413.Parsetree.extension -> Ast_414.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_413.Parsetree.class_infos -> 'g0 Ast_414.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.pci_virt = pci_virt; - Ast_413.Parsetree.pci_params = pci_params; - Ast_413.Parsetree.pci_name = pci_name; - Ast_413.Parsetree.pci_expr = pci_expr; - Ast_413.Parsetree.pci_loc = pci_loc; - Ast_413.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_414.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_414.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_414.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_414.Parsetree.pci_expr = (f0 pci_expr); - Ast_414.Parsetree.pci_loc = (copy_location pci_loc); - Ast_414.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_413.Asttypes.virtual_flag -> Ast_414.Asttypes.virtual_flag = - function - | Ast_413.Asttypes.Virtual -> Ast_414.Asttypes.Virtual - | Ast_413.Asttypes.Concrete -> Ast_414.Asttypes.Concrete -and copy_include_description : - Ast_413.Parsetree.include_description -> - Ast_414.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_413.Parsetree.include_infos -> - 'g0 Ast_414.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.pincl_mod = pincl_mod; - Ast_413.Parsetree.pincl_loc = pincl_loc; - Ast_413.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_414.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_414.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_414.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_413.Parsetree.open_description -> Ast_414.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_413.Parsetree.open_infos -> 'g0 Ast_414.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_413.Parsetree.popen_expr = popen_expr; - Ast_413.Parsetree.popen_override = popen_override; - Ast_413.Parsetree.popen_loc = popen_loc; - Ast_413.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_414.Parsetree.popen_expr = (f0 popen_expr); - Ast_414.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_414.Parsetree.popen_loc = (copy_location popen_loc); - Ast_414.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_413.Asttypes.override_flag -> Ast_414.Asttypes.override_flag = - function - | Ast_413.Asttypes.Override -> Ast_414.Asttypes.Override - | Ast_413.Asttypes.Fresh -> Ast_414.Asttypes.Fresh -and copy_module_type_declaration : - Ast_413.Parsetree.module_type_declaration -> - Ast_414.Parsetree.module_type_declaration - = - fun - { Ast_413.Parsetree.pmtd_name = pmtd_name; - Ast_413.Parsetree.pmtd_type = pmtd_type; - Ast_413.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_413.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_414.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_414.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_414.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_414.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_413.Parsetree.module_substitution -> - Ast_414.Parsetree.module_substitution - = - fun - { Ast_413.Parsetree.pms_name = pms_name; - Ast_413.Parsetree.pms_manifest = pms_manifest; - Ast_413.Parsetree.pms_attributes = pms_attributes; - Ast_413.Parsetree.pms_loc = pms_loc } - -> - { - Ast_414.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_414.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_414.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_414.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_413.Parsetree.module_declaration -> - Ast_414.Parsetree.module_declaration - = - fun - { Ast_413.Parsetree.pmd_name = pmd_name; - Ast_413.Parsetree.pmd_type = pmd_type; - Ast_413.Parsetree.pmd_attributes = pmd_attributes; - Ast_413.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_414.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_414.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_414.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_414.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_413.Parsetree.type_exception -> Ast_414.Parsetree.type_exception = - fun - { Ast_413.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_413.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_413.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_414.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_414.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_414.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_413.Parsetree.type_extension -> Ast_414.Parsetree.type_extension = - fun - { Ast_413.Parsetree.ptyext_path = ptyext_path; - Ast_413.Parsetree.ptyext_params = ptyext_params; - Ast_413.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_413.Parsetree.ptyext_private = ptyext_private; - Ast_413.Parsetree.ptyext_loc = ptyext_loc; - Ast_413.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_414.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_414.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_414.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_414.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_414.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_414.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_413.Parsetree.extension_constructor -> - Ast_414.Parsetree.extension_constructor - = - fun - { Ast_413.Parsetree.pext_name = pext_name; - Ast_413.Parsetree.pext_kind = pext_kind; - Ast_413.Parsetree.pext_loc = pext_loc; - Ast_413.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_414.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_414.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_414.Parsetree.pext_loc = (copy_location pext_loc); - Ast_414.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_413.Parsetree.extension_constructor_kind -> - Ast_414.Parsetree.extension_constructor_kind - = - function - | Ast_413.Parsetree.Pext_decl (x0, x1) -> - Ast_414.Parsetree.Pext_decl - ([], (copy_constructor_arguments x0), (Option.map copy_core_type x1)) - | Ast_413.Parsetree.Pext_rebind x0 -> - Ast_414.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_413.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration = - fun - { Ast_413.Parsetree.ptype_name = ptype_name; - Ast_413.Parsetree.ptype_params = ptype_params; - Ast_413.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_413.Parsetree.ptype_kind = ptype_kind; - Ast_413.Parsetree.ptype_private = ptype_private; - Ast_413.Parsetree.ptype_manifest = ptype_manifest; - Ast_413.Parsetree.ptype_attributes = ptype_attributes; - Ast_413.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_414.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_414.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_414.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_414.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_414.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_414.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_414.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_414.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_413.Asttypes.private_flag -> Ast_414.Asttypes.private_flag = - function - | Ast_413.Asttypes.Private -> Ast_414.Asttypes.Private - | Ast_413.Asttypes.Public -> Ast_414.Asttypes.Public -and copy_type_kind : - Ast_413.Parsetree.type_kind -> Ast_414.Parsetree.type_kind = - function - | Ast_413.Parsetree.Ptype_abstract -> Ast_414.Parsetree.Ptype_abstract - | Ast_413.Parsetree.Ptype_variant x0 -> - Ast_414.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_413.Parsetree.Ptype_record x0 -> - Ast_414.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_413.Parsetree.Ptype_open -> Ast_414.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_413.Parsetree.constructor_declaration -> - Ast_414.Parsetree.constructor_declaration - = - fun - { Ast_413.Parsetree.pcd_name = pcd_name; - Ast_413.Parsetree.pcd_args = pcd_args; - Ast_413.Parsetree.pcd_res = pcd_res; - Ast_413.Parsetree.pcd_loc = pcd_loc; - Ast_413.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_414.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_414.Parsetree.pcd_vars = []; - Ast_414.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_414.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_414.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_414.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_413.Parsetree.constructor_arguments -> - Ast_414.Parsetree.constructor_arguments - = - function - | Ast_413.Parsetree.Pcstr_tuple x0 -> - Ast_414.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_413.Parsetree.Pcstr_record x0 -> - Ast_414.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_413.Parsetree.label_declaration -> Ast_414.Parsetree.label_declaration - = - fun - { Ast_413.Parsetree.pld_name = pld_name; - Ast_413.Parsetree.pld_mutable = pld_mutable; - Ast_413.Parsetree.pld_type = pld_type; - Ast_413.Parsetree.pld_loc = pld_loc; - Ast_413.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_414.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_414.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_414.Parsetree.pld_type = (copy_core_type pld_type); - Ast_414.Parsetree.pld_loc = (copy_location pld_loc); - Ast_414.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_413.Asttypes.mutable_flag -> Ast_414.Asttypes.mutable_flag = - function - | Ast_413.Asttypes.Immutable -> Ast_414.Asttypes.Immutable - | Ast_413.Asttypes.Mutable -> Ast_414.Asttypes.Mutable -and copy_injectivity : - Ast_413.Asttypes.injectivity -> Ast_414.Asttypes.injectivity = - function - | Ast_413.Asttypes.Injective -> Ast_414.Asttypes.Injective - | Ast_413.Asttypes.NoInjectivity -> Ast_414.Asttypes.NoInjectivity -and copy_variance : Ast_413.Asttypes.variance -> Ast_414.Asttypes.variance = - function - | Ast_413.Asttypes.Covariant -> Ast_414.Asttypes.Covariant - | Ast_413.Asttypes.Contravariant -> Ast_414.Asttypes.Contravariant - | Ast_413.Asttypes.NoVariance -> Ast_414.Asttypes.NoVariance -and copy_value_description : - Ast_413.Parsetree.value_description -> Ast_414.Parsetree.value_description - = - fun - { Ast_413.Parsetree.pval_name = pval_name; - Ast_413.Parsetree.pval_type = pval_type; - Ast_413.Parsetree.pval_prim = pval_prim; - Ast_413.Parsetree.pval_attributes = pval_attributes; - Ast_413.Parsetree.pval_loc = pval_loc } - -> - { - Ast_414.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_414.Parsetree.pval_type = (copy_core_type pval_type); - Ast_414.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_414.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_414.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_413.Parsetree.object_field_desc -> Ast_414.Parsetree.object_field_desc - = - function - | Ast_413.Parsetree.Otag (x0, x1) -> - Ast_414.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_413.Parsetree.Oinherit x0 -> - Ast_414.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_413.Asttypes.arg_label -> Ast_414.Asttypes.arg_label - = - function - | Ast_413.Asttypes.Nolabel -> Ast_414.Asttypes.Nolabel - | Ast_413.Asttypes.Labelled x0 -> Ast_414.Asttypes.Labelled x0 - | Ast_413.Asttypes.Optional x0 -> Ast_414.Asttypes.Optional x0 -and copy_closed_flag : - Ast_413.Asttypes.closed_flag -> Ast_414.Asttypes.closed_flag = - function - | Ast_413.Asttypes.Closed -> Ast_414.Asttypes.Closed - | Ast_413.Asttypes.Open -> Ast_414.Asttypes.Open -and copy_label : Ast_413.Asttypes.label -> Ast_414.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_413.Asttypes.rec_flag -> Ast_414.Asttypes.rec_flag = - function - | Ast_413.Asttypes.Nonrecursive -> Ast_414.Asttypes.Nonrecursive - | Ast_413.Asttypes.Recursive -> Ast_414.Asttypes.Recursive -and copy_constant : Ast_413.Parsetree.constant -> Ast_414.Parsetree.constant - = - function - | Ast_413.Parsetree.Pconst_integer (x0, x1) -> - Ast_414.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_413.Parsetree.Pconst_char x0 -> Ast_414.Parsetree.Pconst_char x0 - | Ast_413.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_414.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_413.Parsetree.Pconst_float (x0, x1) -> - Ast_414.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_413.Asttypes.loc -> 'g0 Ast_414.Asttypes.loc - = - fun f0 -> - fun { Ast_413.Asttypes.txt = txt; Ast_413.Asttypes.loc = loc } -> - { - Ast_414.Asttypes.txt = (f0 txt); - Ast_414.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_414_413.ml b/src/vendored-omp/src/migrate_parsetree_414_413.ml index 4b5a0561a..16d0b4948 100644 --- a/src/vendored-omp/src/migrate_parsetree_414_413.ml +++ b/src/vendored-omp/src/migrate_parsetree_414_413.ml @@ -15,131 +15,3 @@ include Migrate_parsetree_414_413_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_413_414_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } - diff --git a/src/vendored-omp/src/migrate_parsetree_414_413_migrate.ml b/src/vendored-omp/src/migrate_parsetree_414_413_migrate.ml index 9556e3c56..cfbd9a9d0 100644 --- a/src/vendored-omp/src/migrate_parsetree_414_413_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_414_413_migrate.ml @@ -1,14 +1,6 @@ open Stdlib0 - module From = Ast_414 module To = Ast_413 - - -module Def = Migrate_parsetree_def - -let migration_error location feature = - raise (Def.Migration_error (feature, location)) - let rec copy_out_type_extension : Ast_414.Outcometree.out_type_extension -> Ast_413.Outcometree.out_type_extension @@ -164,6 +156,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_413.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_414.Asttypes.private_flag -> Ast_413.Asttypes.private_flag = + function + | Ast_414.Asttypes.Private -> Ast_413.Asttypes.Private + | Ast_414.Asttypes.Public -> Ast_413.Asttypes.Public and copy_out_rec_status : Ast_414.Outcometree.out_rec_status -> Ast_413.Outcometree.out_rec_status = function @@ -200,6 +197,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_414.Asttypes.injectivity -> Ast_413.Asttypes.injectivity = + function + | Ast_414.Asttypes.Injective -> Ast_413.Asttypes.Injective + | Ast_414.Asttypes.NoInjectivity -> Ast_413.Asttypes.NoInjectivity +and copy_variance : Ast_414.Asttypes.variance -> Ast_413.Asttypes.variance = + function + | Ast_414.Asttypes.Covariant -> Ast_413.Asttypes.Covariant + | Ast_414.Asttypes.Contravariant -> Ast_413.Asttypes.Contravariant + | Ast_414.Asttypes.NoVariance -> Ast_413.Asttypes.NoVariance and copy_out_type : Ast_414.Outcometree.out_type -> Ast_413.Outcometree.out_type = function @@ -249,7 +256,8 @@ and copy_out_type : | Ast_414.Outcometree.Otyp_module (x0, x1) -> Ast_413.Outcometree.Otyp_module ((copy_out_ident x0), - (List.map (fun (x0, x1) -> x0, (copy_out_type x1)) x1)) + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) | Ast_414.Outcometree.Otyp_attribute (x0, x1) -> Ast_413.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) @@ -320,1224 +328,3 @@ and copy_out_name : Ast_414.Outcometree.out_name -> Ast_413.Outcometree.out_name = fun { Ast_414.Outcometree.printed_name = printed_name } -> { Ast_413.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_414.Parsetree.toplevel_phrase -> Ast_413.Parsetree.toplevel_phrase = - function - | Ast_414.Parsetree.Ptop_def x0 -> - Ast_413.Parsetree.Ptop_def (copy_structure x0) - | Ast_414.Parsetree.Ptop_dir x0 -> - Ast_413.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_414.Parsetree.toplevel_directive -> - Ast_413.Parsetree.toplevel_directive - = - fun - { Ast_414.Parsetree.pdir_name = pdir_name; - Ast_414.Parsetree.pdir_arg = pdir_arg; - Ast_414.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_413.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_413.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_413.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_414.Parsetree.directive_argument -> - Ast_413.Parsetree.directive_argument - = - fun - { Ast_414.Parsetree.pdira_desc = pdira_desc; - Ast_414.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_413.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_413.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_414.Parsetree.directive_argument_desc -> - Ast_413.Parsetree.directive_argument_desc - = - function - | Ast_414.Parsetree.Pdir_string x0 -> Ast_413.Parsetree.Pdir_string x0 - | Ast_414.Parsetree.Pdir_int (x0, x1) -> - Ast_413.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_414.Parsetree.Pdir_ident x0 -> - Ast_413.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_414.Parsetree.Pdir_bool x0 -> Ast_413.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_414.Parsetree.expression -> Ast_413.Parsetree.expression = - fun - { Ast_414.Parsetree.pexp_desc = pexp_desc; - Ast_414.Parsetree.pexp_loc = pexp_loc; - Ast_414.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_414.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_413.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_413.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_413.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_413.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_414.Parsetree.expression_desc -> Ast_413.Parsetree.expression_desc = - function - | Ast_414.Parsetree.Pexp_ident x0 -> - Ast_413.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pexp_constant x0 -> - Ast_413.Parsetree.Pexp_constant (copy_constant x0) - | Ast_414.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_414.Parsetree.Pexp_function x0 -> - Ast_413.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_414.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_413.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_414.Parsetree.Pexp_apply (x0, x1) -> - Ast_413.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_414.Parsetree.Pexp_match (x0, x1) -> - Ast_413.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_414.Parsetree.Pexp_try (x0, x1) -> - Ast_413.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_414.Parsetree.Pexp_tuple x0 -> - Ast_413.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_414.Parsetree.Pexp_construct (x0, x1) -> - Ast_413.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_414.Parsetree.Pexp_variant (x0, x1) -> - Ast_413.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_414.Parsetree.Pexp_record (x0, x1) -> - Ast_413.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_414.Parsetree.Pexp_field (x0, x1) -> - Ast_413.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_414.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_414.Parsetree.Pexp_array x0 -> - Ast_413.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_414.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_414.Parsetree.Pexp_sequence (x0, x1) -> - Ast_413.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_while (x0, x1) -> - Ast_413.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_413.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_414.Parsetree.Pexp_constraint (x0, x1) -> - Ast_413.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_414.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_414.Parsetree.Pexp_send (x0, x1) -> - Ast_413.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_414.Parsetree.Pexp_new x0 -> - Ast_413.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_413.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_override x0 -> - Ast_413.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_414.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_413.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_414.Parsetree.Pexp_letexception (x0, x1) -> - Ast_413.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_assert x0 -> - Ast_413.Parsetree.Pexp_assert (copy_expression x0) - | Ast_414.Parsetree.Pexp_lazy x0 -> - Ast_413.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_414.Parsetree.Pexp_poly (x0, x1) -> - Ast_413.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_414.Parsetree.Pexp_object x0 -> - Ast_413.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_414.Parsetree.Pexp_newtype (x0, x1) -> - Ast_413.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_pack x0 -> - Ast_413.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_414.Parsetree.Pexp_open (x0, x1) -> - Ast_413.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_letop x0 -> - Ast_413.Parsetree.Pexp_letop (copy_letop x0) - | Ast_414.Parsetree.Pexp_extension x0 -> - Ast_413.Parsetree.Pexp_extension (copy_extension x0) - | Ast_414.Parsetree.Pexp_unreachable -> Ast_413.Parsetree.Pexp_unreachable -and copy_letop : Ast_414.Parsetree.letop -> Ast_413.Parsetree.letop = - fun - { Ast_414.Parsetree.let_ = let_; Ast_414.Parsetree.ands = ands; - Ast_414.Parsetree.body = body } - -> - { - Ast_413.Parsetree.let_ = (copy_binding_op let_); - Ast_413.Parsetree.ands = (List.map copy_binding_op ands); - Ast_413.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_414.Parsetree.binding_op -> Ast_413.Parsetree.binding_op = - fun - { Ast_414.Parsetree.pbop_op = pbop_op; - Ast_414.Parsetree.pbop_pat = pbop_pat; - Ast_414.Parsetree.pbop_exp = pbop_exp; - Ast_414.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_413.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_413.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_413.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_413.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_414.Asttypes.direction_flag -> Ast_413.Asttypes.direction_flag = - function - | Ast_414.Asttypes.Upto -> Ast_413.Asttypes.Upto - | Ast_414.Asttypes.Downto -> Ast_413.Asttypes.Downto -and copy_case : Ast_414.Parsetree.case -> Ast_413.Parsetree.case = - fun - { Ast_414.Parsetree.pc_lhs = pc_lhs; - Ast_414.Parsetree.pc_guard = pc_guard; - Ast_414.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_413.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_413.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_413.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_414.Parsetree.value_binding -> Ast_413.Parsetree.value_binding = - fun - { Ast_414.Parsetree.pvb_pat = pvb_pat; - Ast_414.Parsetree.pvb_expr = pvb_expr; - Ast_414.Parsetree.pvb_attributes = pvb_attributes; - Ast_414.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_413.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_413.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_413.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_413.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_414.Parsetree.pattern -> Ast_413.Parsetree.pattern = - fun - { Ast_414.Parsetree.ppat_desc = ppat_desc; - Ast_414.Parsetree.ppat_loc = ppat_loc; - Ast_414.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_414.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_413.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_413.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_413.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_413.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_414.Parsetree.pattern_desc -> Ast_413.Parsetree.pattern_desc = - function - | Ast_414.Parsetree.Ppat_any -> Ast_413.Parsetree.Ppat_any - | Ast_414.Parsetree.Ppat_var x0 -> - Ast_413.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_414.Parsetree.Ppat_alias (x0, x1) -> - Ast_413.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_414.Parsetree.Ppat_constant x0 -> - Ast_413.Parsetree.Ppat_constant (copy_constant x0) - | Ast_414.Parsetree.Ppat_interval (x0, x1) -> - Ast_413.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_414.Parsetree.Ppat_tuple x0 -> - Ast_413.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_414.Parsetree.Ppat_construct (x0, x1) -> - Ast_413.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), - (Option.map - (fun x -> - let (x0, x1) = x in - x0, copy_pattern x1) x1)) - | Ast_414.Parsetree.Ppat_variant (x0, x1) -> - Ast_413.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_414.Parsetree.Ppat_record (x0, x1) -> - Ast_413.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_414.Parsetree.Ppat_array x0 -> - Ast_413.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_414.Parsetree.Ppat_or (x0, x1) -> - Ast_413.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_414.Parsetree.Ppat_constraint (x0, x1) -> - Ast_413.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_414.Parsetree.Ppat_type x0 -> - Ast_413.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Ppat_lazy x0 -> - Ast_413.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_414.Parsetree.Ppat_unpack x0 -> - Ast_413.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_414.Parsetree.Ppat_exception x0 -> - Ast_413.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_414.Parsetree.Ppat_extension x0 -> - Ast_413.Parsetree.Ppat_extension (copy_extension x0) - | Ast_414.Parsetree.Ppat_open (x0, x1) -> - Ast_413.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_414.Parsetree.core_type -> Ast_413.Parsetree.core_type = - fun - { Ast_414.Parsetree.ptyp_desc = ptyp_desc; - Ast_414.Parsetree.ptyp_loc = ptyp_loc; - Ast_414.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_414.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_413.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_413.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_413.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_413.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_414.Parsetree.location_stack -> Ast_413.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_414.Parsetree.core_type_desc -> Ast_413.Parsetree.core_type_desc = - function - | Ast_414.Parsetree.Ptyp_any -> Ast_413.Parsetree.Ptyp_any - | Ast_414.Parsetree.Ptyp_var x0 -> Ast_413.Parsetree.Ptyp_var x0 - | Ast_414.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_413.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_414.Parsetree.Ptyp_tuple x0 -> - Ast_413.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_414.Parsetree.Ptyp_constr (x0, x1) -> - Ast_413.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_object (x0, x1) -> - Ast_413.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_414.Parsetree.Ptyp_class (x0, x1) -> - Ast_413.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_alias (x0, x1) -> - Ast_413.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_414.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_413.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_414.Parsetree.Ptyp_poly (x0, x1) -> - Ast_413.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_package x0 -> - Ast_413.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_414.Parsetree.Ptyp_extension x0 -> - Ast_413.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_414.Parsetree.package_type -> Ast_413.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_414.Parsetree.row_field -> Ast_413.Parsetree.row_field = - fun - { Ast_414.Parsetree.prf_desc = prf_desc; - Ast_414.Parsetree.prf_loc = prf_loc; - Ast_414.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_413.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_413.Parsetree.prf_loc = (copy_location prf_loc); - Ast_413.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_414.Parsetree.row_field_desc -> Ast_413.Parsetree.row_field_desc = - function - | Ast_414.Parsetree.Rtag (x0, x1, x2) -> - Ast_413.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_414.Parsetree.Rinherit x0 -> - Ast_413.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_414.Parsetree.object_field -> Ast_413.Parsetree.object_field = - fun - { Ast_414.Parsetree.pof_desc = pof_desc; - Ast_414.Parsetree.pof_loc = pof_loc; - Ast_414.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_413.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_413.Parsetree.pof_loc = (copy_location pof_loc); - Ast_413.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_414.Parsetree.attributes -> Ast_413.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_414.Parsetree.attribute -> Ast_413.Parsetree.attribute = - fun - { Ast_414.Parsetree.attr_name = attr_name; - Ast_414.Parsetree.attr_payload = attr_payload; - Ast_414.Parsetree.attr_loc = attr_loc } - -> - { - Ast_413.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_413.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_413.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_414.Parsetree.payload -> Ast_413.Parsetree.payload = - function - | Ast_414.Parsetree.PStr x0 -> Ast_413.Parsetree.PStr (copy_structure x0) - | Ast_414.Parsetree.PSig x0 -> Ast_413.Parsetree.PSig (copy_signature x0) - | Ast_414.Parsetree.PTyp x0 -> Ast_413.Parsetree.PTyp (copy_core_type x0) - | Ast_414.Parsetree.PPat (x0, x1) -> - Ast_413.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_414.Parsetree.structure -> Ast_413.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_414.Parsetree.structure_item -> Ast_413.Parsetree.structure_item = - fun - { Ast_414.Parsetree.pstr_desc = pstr_desc; - Ast_414.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_413.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_413.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_414.Parsetree.structure_item_desc -> - Ast_413.Parsetree.structure_item_desc - = - function - | Ast_414.Parsetree.Pstr_eval (x0, x1) -> - Ast_413.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_414.Parsetree.Pstr_value (x0, x1) -> - Ast_413.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_414.Parsetree.Pstr_primitive x0 -> - Ast_413.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_414.Parsetree.Pstr_type (x0, x1) -> - Ast_413.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_414.Parsetree.Pstr_typext x0 -> - Ast_413.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_414.Parsetree.Pstr_exception x0 -> - Ast_413.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_414.Parsetree.Pstr_module x0 -> - Ast_413.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_414.Parsetree.Pstr_recmodule x0 -> - Ast_413.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_414.Parsetree.Pstr_modtype x0 -> - Ast_413.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_414.Parsetree.Pstr_open x0 -> - Ast_413.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_414.Parsetree.Pstr_class x0 -> - Ast_413.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_414.Parsetree.Pstr_class_type x0 -> - Ast_413.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_414.Parsetree.Pstr_include x0 -> - Ast_413.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_414.Parsetree.Pstr_attribute x0 -> - Ast_413.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pstr_extension (x0, x1) -> - Ast_413.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_414.Parsetree.include_declaration -> - Ast_413.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_414.Parsetree.class_declaration -> Ast_413.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_414.Parsetree.class_expr -> Ast_413.Parsetree.class_expr = - fun - { Ast_414.Parsetree.pcl_desc = pcl_desc; - Ast_414.Parsetree.pcl_loc = pcl_loc; - Ast_414.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_413.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_413.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_413.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_414.Parsetree.class_expr_desc -> Ast_413.Parsetree.class_expr_desc = - function - | Ast_414.Parsetree.Pcl_constr (x0, x1) -> - Ast_413.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Pcl_structure x0 -> - Ast_413.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_414.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_413.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_414.Parsetree.Pcl_apply (x0, x1) -> - Ast_413.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_414.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_413.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_414.Parsetree.Pcl_constraint (x0, x1) -> - Ast_413.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_414.Parsetree.Pcl_extension x0 -> - Ast_413.Parsetree.Pcl_extension (copy_extension x0) - | Ast_414.Parsetree.Pcl_open (x0, x1) -> - Ast_413.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_414.Parsetree.class_structure -> Ast_413.Parsetree.class_structure = - fun - { Ast_414.Parsetree.pcstr_self = pcstr_self; - Ast_414.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_413.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_413.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_414.Parsetree.class_field -> Ast_413.Parsetree.class_field = - fun - { Ast_414.Parsetree.pcf_desc = pcf_desc; - Ast_414.Parsetree.pcf_loc = pcf_loc; - Ast_414.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_413.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_413.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_413.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_414.Parsetree.class_field_desc -> Ast_413.Parsetree.class_field_desc = - function - | Ast_414.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_413.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_414.Parsetree.Pcf_val x0 -> - Ast_413.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_414.Parsetree.Pcf_method x0 -> - Ast_413.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_414.Parsetree.Pcf_constraint x0 -> - Ast_413.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_414.Parsetree.Pcf_initializer x0 -> - Ast_413.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_414.Parsetree.Pcf_attribute x0 -> - Ast_413.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pcf_extension x0 -> - Ast_413.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_414.Parsetree.class_field_kind -> Ast_413.Parsetree.class_field_kind = - function - | Ast_414.Parsetree.Cfk_virtual x0 -> - Ast_413.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_414.Parsetree.Cfk_concrete (x0, x1) -> - Ast_413.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_414.Parsetree.open_declaration -> Ast_413.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_414.Parsetree.module_binding -> Ast_413.Parsetree.module_binding = - fun - { Ast_414.Parsetree.pmb_name = pmb_name; - Ast_414.Parsetree.pmb_expr = pmb_expr; - Ast_414.Parsetree.pmb_attributes = pmb_attributes; - Ast_414.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_413.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_413.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_413.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_413.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_414.Parsetree.module_expr -> Ast_413.Parsetree.module_expr = - fun - { Ast_414.Parsetree.pmod_desc = pmod_desc; - Ast_414.Parsetree.pmod_loc = pmod_loc; - Ast_414.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_413.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_413.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_413.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_414.Parsetree.module_expr_desc -> Ast_413.Parsetree.module_expr_desc = - function - | Ast_414.Parsetree.Pmod_ident x0 -> - Ast_413.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pmod_structure x0 -> - Ast_413.Parsetree.Pmod_structure (copy_structure x0) - | Ast_414.Parsetree.Pmod_functor (x0, x1) -> - Ast_413.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_414.Parsetree.Pmod_apply (x0, x1) -> - Ast_413.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_414.Parsetree.Pmod_constraint (x0, x1) -> - Ast_413.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pmod_unpack x0 -> - Ast_413.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_414.Parsetree.Pmod_extension x0 -> - Ast_413.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_414.Parsetree.functor_parameter -> Ast_413.Parsetree.functor_parameter - = - function - | Ast_414.Parsetree.Unit -> Ast_413.Parsetree.Unit - | Ast_414.Parsetree.Named (x0, x1) -> - Ast_413.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_414.Parsetree.module_type -> Ast_413.Parsetree.module_type = - fun - { Ast_414.Parsetree.pmty_desc = pmty_desc; - Ast_414.Parsetree.pmty_loc = pmty_loc; - Ast_414.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_413.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_413.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_413.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_414.Parsetree.module_type_desc -> Ast_413.Parsetree.module_type_desc = - function - | Ast_414.Parsetree.Pmty_ident x0 -> - Ast_413.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pmty_signature x0 -> - Ast_413.Parsetree.Pmty_signature (copy_signature x0) - | Ast_414.Parsetree.Pmty_functor (x0, x1) -> - Ast_413.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pmty_with (x0, x1) -> - Ast_413.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_414.Parsetree.Pmty_typeof x0 -> - Ast_413.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_414.Parsetree.Pmty_extension x0 -> - Ast_413.Parsetree.Pmty_extension (copy_extension x0) - | Ast_414.Parsetree.Pmty_alias x0 -> - Ast_413.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_414.Parsetree.with_constraint -> Ast_413.Parsetree.with_constraint = - function - | Ast_414.Parsetree.Pwith_type (x0, x1) -> - Ast_413.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_414.Parsetree.Pwith_module (x0, x1) -> - Ast_413.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_414.Parsetree.Pwith_modtype (_, x1) -> - migration_error x1.Ast_414.Parsetree.pmty_loc With_modtype - | Ast_414.Parsetree.Pwith_modtypesubst (_, x1) -> - migration_error x1.Ast_414.Parsetree.pmty_loc With_modtypesubst - | Ast_414.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_413.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_414.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_413.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_414.Parsetree.signature -> Ast_413.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_414.Parsetree.signature_item -> Ast_413.Parsetree.signature_item = - fun - { Ast_414.Parsetree.psig_desc = psig_desc; - Ast_414.Parsetree.psig_loc = psig_loc } - -> - { - Ast_413.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_413.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_414.Parsetree.signature_item_desc -> - Ast_413.Parsetree.signature_item_desc - = - function - | Ast_414.Parsetree.Psig_value x0 -> - Ast_413.Parsetree.Psig_value (copy_value_description x0) - | Ast_414.Parsetree.Psig_type (x0, x1) -> - Ast_413.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_414.Parsetree.Psig_typesubst x0 -> - Ast_413.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_414.Parsetree.Psig_typext x0 -> - Ast_413.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_414.Parsetree.Psig_exception x0 -> - Ast_413.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_414.Parsetree.Psig_module x0 -> - Ast_413.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_414.Parsetree.Psig_modsubst x0 -> - Ast_413.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_414.Parsetree.Psig_recmodule x0 -> - Ast_413.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_414.Parsetree.Psig_modtype x0 -> - Ast_413.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_414.Parsetree.Psig_modtypesubst x0 -> - migration_error x0.Ast_414.Parsetree.pmtd_loc Psig_modtypesubst - | Ast_414.Parsetree.Psig_open x0 -> - Ast_413.Parsetree.Psig_open (copy_open_description x0) - | Ast_414.Parsetree.Psig_include x0 -> - Ast_413.Parsetree.Psig_include (copy_include_description x0) - | Ast_414.Parsetree.Psig_class x0 -> - Ast_413.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_414.Parsetree.Psig_class_type x0 -> - Ast_413.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_414.Parsetree.Psig_attribute x0 -> - Ast_413.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_414.Parsetree.Psig_extension (x0, x1) -> - Ast_413.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_414.Parsetree.class_type_declaration -> - Ast_413.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_414.Parsetree.class_description -> Ast_413.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_414.Parsetree.class_type -> Ast_413.Parsetree.class_type = - fun - { Ast_414.Parsetree.pcty_desc = pcty_desc; - Ast_414.Parsetree.pcty_loc = pcty_loc; - Ast_414.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_413.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_413.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_413.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_414.Parsetree.class_type_desc -> Ast_413.Parsetree.class_type_desc = - function - | Ast_414.Parsetree.Pcty_constr (x0, x1) -> - Ast_413.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Pcty_signature x0 -> - Ast_413.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_414.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_413.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_414.Parsetree.Pcty_extension x0 -> - Ast_413.Parsetree.Pcty_extension (copy_extension x0) - | Ast_414.Parsetree.Pcty_open (x0, x1) -> - Ast_413.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_414.Parsetree.class_signature -> Ast_413.Parsetree.class_signature = - fun - { Ast_414.Parsetree.pcsig_self = pcsig_self; - Ast_414.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_413.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_413.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_414.Parsetree.class_type_field -> Ast_413.Parsetree.class_type_field = - fun - { Ast_414.Parsetree.pctf_desc = pctf_desc; - Ast_414.Parsetree.pctf_loc = pctf_loc; - Ast_414.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_413.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_413.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_413.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_414.Parsetree.class_type_field_desc -> - Ast_413.Parsetree.class_type_field_desc - = - function - | Ast_414.Parsetree.Pctf_inherit x0 -> - Ast_413.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_414.Parsetree.Pctf_val x0 -> - Ast_413.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_414.Parsetree.Pctf_method x0 -> - Ast_413.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_414.Parsetree.Pctf_constraint x0 -> - Ast_413.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_414.Parsetree.Pctf_attribute x0 -> - Ast_413.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pctf_extension x0 -> - Ast_413.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_414.Parsetree.extension -> Ast_413.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_414.Parsetree.class_infos -> 'g0 Ast_413.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.pci_virt = pci_virt; - Ast_414.Parsetree.pci_params = pci_params; - Ast_414.Parsetree.pci_name = pci_name; - Ast_414.Parsetree.pci_expr = pci_expr; - Ast_414.Parsetree.pci_loc = pci_loc; - Ast_414.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_413.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_413.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_413.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_413.Parsetree.pci_expr = (f0 pci_expr); - Ast_413.Parsetree.pci_loc = (copy_location pci_loc); - Ast_413.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_414.Asttypes.virtual_flag -> Ast_413.Asttypes.virtual_flag = - function - | Ast_414.Asttypes.Virtual -> Ast_413.Asttypes.Virtual - | Ast_414.Asttypes.Concrete -> Ast_413.Asttypes.Concrete -and copy_include_description : - Ast_414.Parsetree.include_description -> - Ast_413.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_414.Parsetree.include_infos -> - 'g0 Ast_413.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.pincl_mod = pincl_mod; - Ast_414.Parsetree.pincl_loc = pincl_loc; - Ast_414.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_413.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_413.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_413.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_414.Parsetree.open_description -> Ast_413.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_414.Parsetree.open_infos -> 'g0 Ast_413.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.popen_expr = popen_expr; - Ast_414.Parsetree.popen_override = popen_override; - Ast_414.Parsetree.popen_loc = popen_loc; - Ast_414.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_413.Parsetree.popen_expr = (f0 popen_expr); - Ast_413.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_413.Parsetree.popen_loc = (copy_location popen_loc); - Ast_413.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_414.Asttypes.override_flag -> Ast_413.Asttypes.override_flag = - function - | Ast_414.Asttypes.Override -> Ast_413.Asttypes.Override - | Ast_414.Asttypes.Fresh -> Ast_413.Asttypes.Fresh -and copy_module_type_declaration : - Ast_414.Parsetree.module_type_declaration -> - Ast_413.Parsetree.module_type_declaration - = - fun - { Ast_414.Parsetree.pmtd_name = pmtd_name; - Ast_414.Parsetree.pmtd_type = pmtd_type; - Ast_414.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_414.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_413.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_413.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_413.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_413.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_414.Parsetree.module_substitution -> - Ast_413.Parsetree.module_substitution - = - fun - { Ast_414.Parsetree.pms_name = pms_name; - Ast_414.Parsetree.pms_manifest = pms_manifest; - Ast_414.Parsetree.pms_attributes = pms_attributes; - Ast_414.Parsetree.pms_loc = pms_loc } - -> - { - Ast_413.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_413.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_413.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_413.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_414.Parsetree.module_declaration -> - Ast_413.Parsetree.module_declaration - = - fun - { Ast_414.Parsetree.pmd_name = pmd_name; - Ast_414.Parsetree.pmd_type = pmd_type; - Ast_414.Parsetree.pmd_attributes = pmd_attributes; - Ast_414.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_413.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_413.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_413.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_413.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_414.Parsetree.type_exception -> Ast_413.Parsetree.type_exception = - fun - { Ast_414.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_414.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_414.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_413.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_413.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_413.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_414.Parsetree.type_extension -> Ast_413.Parsetree.type_extension = - fun - { Ast_414.Parsetree.ptyext_path = ptyext_path; - Ast_414.Parsetree.ptyext_params = ptyext_params; - Ast_414.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_414.Parsetree.ptyext_private = ptyext_private; - Ast_414.Parsetree.ptyext_loc = ptyext_loc; - Ast_414.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_413.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_413.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_413.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_413.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_413.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_413.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_414.Parsetree.extension_constructor -> - Ast_413.Parsetree.extension_constructor - = - fun - { Ast_414.Parsetree.pext_name = pext_name; - Ast_414.Parsetree.pext_kind = pext_kind; - Ast_414.Parsetree.pext_loc = pext_loc; - Ast_414.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_413.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_413.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_413.Parsetree.pext_loc = (copy_location pext_loc); - Ast_413.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_414.Parsetree.extension_constructor_kind -> - Ast_413.Parsetree.extension_constructor_kind - = - function - | Ast_414.Parsetree.Pext_decl (x0, x1, x2) -> - (match x0 with - | [] -> Ast_413.Parsetree.Pext_decl - ((copy_constructor_arguments x1), (Option.map copy_core_type x2)) - | hd :: _ -> migration_error hd.loc Extension_constructor) - | Ast_414.Parsetree.Pext_rebind x0 -> - Ast_413.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_414.Parsetree.type_declaration -> Ast_413.Parsetree.type_declaration = - fun - { Ast_414.Parsetree.ptype_name = ptype_name; - Ast_414.Parsetree.ptype_params = ptype_params; - Ast_414.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_414.Parsetree.ptype_kind = ptype_kind; - Ast_414.Parsetree.ptype_private = ptype_private; - Ast_414.Parsetree.ptype_manifest = ptype_manifest; - Ast_414.Parsetree.ptype_attributes = ptype_attributes; - Ast_414.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_413.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_413.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_413.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_413.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_413.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_413.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_413.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_413.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_414.Asttypes.private_flag -> Ast_413.Asttypes.private_flag = - function - | Ast_414.Asttypes.Private -> Ast_413.Asttypes.Private - | Ast_414.Asttypes.Public -> Ast_413.Asttypes.Public -and copy_type_kind : - Ast_414.Parsetree.type_kind -> Ast_413.Parsetree.type_kind = - function - | Ast_414.Parsetree.Ptype_abstract -> Ast_413.Parsetree.Ptype_abstract - | Ast_414.Parsetree.Ptype_variant x0 -> - Ast_413.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_414.Parsetree.Ptype_record x0 -> - Ast_413.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_414.Parsetree.Ptype_open -> Ast_413.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_414.Parsetree.constructor_declaration -> - Ast_413.Parsetree.constructor_declaration - = - fun - { Ast_414.Parsetree.pcd_name = pcd_name; - Ast_414.Parsetree.pcd_args = pcd_args; - Ast_414.Parsetree.pcd_res = pcd_res; - Ast_414.Parsetree.pcd_loc = pcd_loc; - Ast_414.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_413.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_413.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_413.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_413.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_413.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_414.Parsetree.constructor_arguments -> - Ast_413.Parsetree.constructor_arguments - = - function - | Ast_414.Parsetree.Pcstr_tuple x0 -> - Ast_413.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_414.Parsetree.Pcstr_record x0 -> - Ast_413.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_414.Parsetree.label_declaration -> Ast_413.Parsetree.label_declaration - = - fun - { Ast_414.Parsetree.pld_name = pld_name; - Ast_414.Parsetree.pld_mutable = pld_mutable; - Ast_414.Parsetree.pld_type = pld_type; - Ast_414.Parsetree.pld_loc = pld_loc; - Ast_414.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_413.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_413.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_413.Parsetree.pld_type = (copy_core_type pld_type); - Ast_413.Parsetree.pld_loc = (copy_location pld_loc); - Ast_413.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_414.Asttypes.mutable_flag -> Ast_413.Asttypes.mutable_flag = - function - | Ast_414.Asttypes.Immutable -> Ast_413.Asttypes.Immutable - | Ast_414.Asttypes.Mutable -> Ast_413.Asttypes.Mutable -and copy_injectivity : - Ast_414.Asttypes.injectivity -> Ast_413.Asttypes.injectivity = - function - | Ast_414.Asttypes.Injective -> Ast_413.Asttypes.Injective - | Ast_414.Asttypes.NoInjectivity -> Ast_413.Asttypes.NoInjectivity -and copy_variance : Ast_414.Asttypes.variance -> Ast_413.Asttypes.variance = - function - | Ast_414.Asttypes.Covariant -> Ast_413.Asttypes.Covariant - | Ast_414.Asttypes.Contravariant -> Ast_413.Asttypes.Contravariant - | Ast_414.Asttypes.NoVariance -> Ast_413.Asttypes.NoVariance -and copy_value_description : - Ast_414.Parsetree.value_description -> Ast_413.Parsetree.value_description - = - fun - { Ast_414.Parsetree.pval_name = pval_name; - Ast_414.Parsetree.pval_type = pval_type; - Ast_414.Parsetree.pval_prim = pval_prim; - Ast_414.Parsetree.pval_attributes = pval_attributes; - Ast_414.Parsetree.pval_loc = pval_loc } - -> - { - Ast_413.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_413.Parsetree.pval_type = (copy_core_type pval_type); - Ast_413.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_413.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_413.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_414.Parsetree.object_field_desc -> Ast_413.Parsetree.object_field_desc - = - function - | Ast_414.Parsetree.Otag (x0, x1) -> - Ast_413.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_414.Parsetree.Oinherit x0 -> - Ast_413.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_414.Asttypes.arg_label -> Ast_413.Asttypes.arg_label - = - function - | Ast_414.Asttypes.Nolabel -> Ast_413.Asttypes.Nolabel - | Ast_414.Asttypes.Labelled x0 -> Ast_413.Asttypes.Labelled x0 - | Ast_414.Asttypes.Optional x0 -> Ast_413.Asttypes.Optional x0 -and copy_closed_flag : - Ast_414.Asttypes.closed_flag -> Ast_413.Asttypes.closed_flag = - function - | Ast_414.Asttypes.Closed -> Ast_413.Asttypes.Closed - | Ast_414.Asttypes.Open -> Ast_413.Asttypes.Open -and copy_label : Ast_414.Asttypes.label -> Ast_413.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_414.Asttypes.rec_flag -> Ast_413.Asttypes.rec_flag = - function - | Ast_414.Asttypes.Nonrecursive -> Ast_413.Asttypes.Nonrecursive - | Ast_414.Asttypes.Recursive -> Ast_413.Asttypes.Recursive -and copy_constant : Ast_414.Parsetree.constant -> Ast_413.Parsetree.constant - = - function - | Ast_414.Parsetree.Pconst_integer (x0, x1) -> - Ast_413.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_414.Parsetree.Pconst_char x0 -> Ast_413.Parsetree.Pconst_char x0 - | Ast_414.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_413.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_414.Parsetree.Pconst_float (x0, x1) -> - Ast_413.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_414.Asttypes.loc -> 'g0 Ast_413.Asttypes.loc - = - fun f0 -> - fun { Ast_414.Asttypes.txt = txt; Ast_414.Asttypes.loc = loc } -> - { - Ast_413.Asttypes.txt = (f0 txt); - Ast_413.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_414_500.ml b/src/vendored-omp/src/migrate_parsetree_414_500.ml index 992e651b8..ab244b249 100644 --- a/src/vendored-omp/src/migrate_parsetree_414_500.ml +++ b/src/vendored-omp/src/migrate_parsetree_414_500.ml @@ -15,131 +15,3 @@ include Migrate_parsetree_414_500_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_500_414_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } - - diff --git a/src/vendored-omp/src/migrate_parsetree_414_500_migrate.ml b/src/vendored-omp/src/migrate_parsetree_414_500_migrate.ml index c7f4b5902..b39f06473 100644 --- a/src/vendored-omp/src/migrate_parsetree_414_500_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_414_500_migrate.ml @@ -152,6 +152,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_500.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_414.Asttypes.private_flag -> Ast_500.Asttypes.private_flag = + function + | Ast_414.Asttypes.Private -> Ast_500.Asttypes.Private + | Ast_414.Asttypes.Public -> Ast_500.Asttypes.Public and copy_out_rec_status : Ast_414.Outcometree.out_rec_status -> Ast_500.Outcometree.out_rec_status = function @@ -188,6 +193,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_414.Asttypes.injectivity -> Ast_500.Asttypes.injectivity = + function + | Ast_414.Asttypes.Injective -> Ast_500.Asttypes.Injective + | Ast_414.Asttypes.NoInjectivity -> Ast_500.Asttypes.NoInjectivity +and copy_variance : Ast_414.Asttypes.variance -> Ast_500.Asttypes.variance = + function + | Ast_414.Asttypes.Covariant -> Ast_500.Asttypes.Covariant + | Ast_414.Asttypes.Contravariant -> Ast_500.Asttypes.Contravariant + | Ast_414.Asttypes.NoVariance -> Ast_500.Asttypes.NoVariance and copy_out_type : Ast_414.Outcometree.out_type -> Ast_500.Outcometree.out_type = function @@ -318,1229 +333,3 @@ and copy_out_name : Ast_414.Outcometree.out_name -> Ast_500.Outcometree.out_name = fun { Ast_414.Outcometree.printed_name = printed_name } -> { Ast_500.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_414.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase = - function - | Ast_414.Parsetree.Ptop_def x0 -> - Ast_500.Parsetree.Ptop_def (copy_structure x0) - | Ast_414.Parsetree.Ptop_dir x0 -> - Ast_500.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_414.Parsetree.toplevel_directive -> - Ast_500.Parsetree.toplevel_directive - = - fun - { Ast_414.Parsetree.pdir_name = pdir_name; - Ast_414.Parsetree.pdir_arg = pdir_arg; - Ast_414.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_500.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_500.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_500.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_414.Parsetree.directive_argument -> - Ast_500.Parsetree.directive_argument - = - fun - { Ast_414.Parsetree.pdira_desc = pdira_desc; - Ast_414.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_500.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_500.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_414.Parsetree.directive_argument_desc -> - Ast_500.Parsetree.directive_argument_desc - = - function - | Ast_414.Parsetree.Pdir_string x0 -> Ast_500.Parsetree.Pdir_string x0 - | Ast_414.Parsetree.Pdir_int (x0, x1) -> - Ast_500.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_414.Parsetree.Pdir_ident x0 -> - Ast_500.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_414.Parsetree.Pdir_bool x0 -> Ast_500.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_414.Parsetree.expression -> Ast_500.Parsetree.expression = - fun - { Ast_414.Parsetree.pexp_desc = pexp_desc; - Ast_414.Parsetree.pexp_loc = pexp_loc; - Ast_414.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_414.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_500.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_500.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_500.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_500.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_414.Parsetree.expression_desc -> Ast_500.Parsetree.expression_desc = - function - | Ast_414.Parsetree.Pexp_ident x0 -> - Ast_500.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pexp_constant x0 -> - Ast_500.Parsetree.Pexp_constant (copy_constant x0) - | Ast_414.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_500.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_414.Parsetree.Pexp_function x0 -> - Ast_500.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_414.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_500.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_414.Parsetree.Pexp_apply (x0, x1) -> - Ast_500.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_414.Parsetree.Pexp_match (x0, x1) -> - Ast_500.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_414.Parsetree.Pexp_try (x0, x1) -> - Ast_500.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_414.Parsetree.Pexp_tuple x0 -> - Ast_500.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_414.Parsetree.Pexp_construct (x0, x1) -> - Ast_500.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_414.Parsetree.Pexp_variant (x0, x1) -> - Ast_500.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_414.Parsetree.Pexp_record (x0, x1) -> - Ast_500.Parsetree.Pexp_record - ((List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), - (Option.map copy_expression x1)) - | Ast_414.Parsetree.Pexp_field (x0, x1) -> - Ast_500.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_414.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_500.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_414.Parsetree.Pexp_array x0 -> - Ast_500.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_414.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_500.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_414.Parsetree.Pexp_sequence (x0, x1) -> - Ast_500.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_while (x0, x1) -> - Ast_500.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_500.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_414.Parsetree.Pexp_constraint (x0, x1) -> - Ast_500.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_414.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_500.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_414.Parsetree.Pexp_send (x0, x1) -> - Ast_500.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_414.Parsetree.Pexp_new x0 -> - Ast_500.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_500.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_override x0 -> - Ast_500.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_414.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_500.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_414.Parsetree.Pexp_letexception (x0, x1) -> - Ast_500.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_assert x0 -> - Ast_500.Parsetree.Pexp_assert (copy_expression x0) - | Ast_414.Parsetree.Pexp_lazy x0 -> - Ast_500.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_414.Parsetree.Pexp_poly (x0, x1) -> - Ast_500.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_414.Parsetree.Pexp_object x0 -> - Ast_500.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_414.Parsetree.Pexp_newtype (x0, x1) -> - Ast_500.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_pack x0 -> - Ast_500.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_414.Parsetree.Pexp_open (x0, x1) -> - Ast_500.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_414.Parsetree.Pexp_letop x0 -> - Ast_500.Parsetree.Pexp_letop (copy_letop x0) - | Ast_414.Parsetree.Pexp_extension x0 -> - Ast_500.Parsetree.Pexp_extension (copy_extension x0) - | Ast_414.Parsetree.Pexp_unreachable -> Ast_500.Parsetree.Pexp_unreachable -and copy_letop : Ast_414.Parsetree.letop -> Ast_500.Parsetree.letop = - fun - { Ast_414.Parsetree.let_ = let_; Ast_414.Parsetree.ands = ands; - Ast_414.Parsetree.body = body } - -> - { - Ast_500.Parsetree.let_ = (copy_binding_op let_); - Ast_500.Parsetree.ands = (List.map copy_binding_op ands); - Ast_500.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_414.Parsetree.binding_op -> Ast_500.Parsetree.binding_op = - fun - { Ast_414.Parsetree.pbop_op = pbop_op; - Ast_414.Parsetree.pbop_pat = pbop_pat; - Ast_414.Parsetree.pbop_exp = pbop_exp; - Ast_414.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_500.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_500.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_500.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_500.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_414.Asttypes.direction_flag -> Ast_500.Asttypes.direction_flag = - function - | Ast_414.Asttypes.Upto -> Ast_500.Asttypes.Upto - | Ast_414.Asttypes.Downto -> Ast_500.Asttypes.Downto -and copy_case : Ast_414.Parsetree.case -> Ast_500.Parsetree.case = - fun - { Ast_414.Parsetree.pc_lhs = pc_lhs; - Ast_414.Parsetree.pc_guard = pc_guard; - Ast_414.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_500.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_500.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_500.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_414.Parsetree.value_binding -> Ast_500.Parsetree.value_binding = - fun - { Ast_414.Parsetree.pvb_pat = pvb_pat; - Ast_414.Parsetree.pvb_expr = pvb_expr; - Ast_414.Parsetree.pvb_attributes = pvb_attributes; - Ast_414.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_500.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_500.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_500.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_500.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_414.Parsetree.pattern -> Ast_500.Parsetree.pattern = - fun - { Ast_414.Parsetree.ppat_desc = ppat_desc; - Ast_414.Parsetree.ppat_loc = ppat_loc; - Ast_414.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_414.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_500.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_500.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_500.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_500.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_414.Parsetree.pattern_desc -> Ast_500.Parsetree.pattern_desc = - function - | Ast_414.Parsetree.Ppat_any -> Ast_500.Parsetree.Ppat_any - | Ast_414.Parsetree.Ppat_var x0 -> - Ast_500.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_414.Parsetree.Ppat_alias (x0, x1) -> - Ast_500.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_414.Parsetree.Ppat_constant x0 -> - Ast_500.Parsetree.Ppat_constant (copy_constant x0) - | Ast_414.Parsetree.Ppat_interval (x0, x1) -> - Ast_500.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_414.Parsetree.Ppat_tuple x0 -> - Ast_500.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_414.Parsetree.Ppat_construct (x0, x1) -> - Ast_500.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), - (Option.map - (fun x -> - let (x0, x1) = x in - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_pattern x1))) x1)) - | Ast_414.Parsetree.Ppat_variant (x0, x1) -> - Ast_500.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_414.Parsetree.Ppat_record (x0, x1) -> - Ast_500.Parsetree.Ppat_record - ((List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), - (copy_closed_flag x1)) - | Ast_414.Parsetree.Ppat_array x0 -> - Ast_500.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_414.Parsetree.Ppat_or (x0, x1) -> - Ast_500.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_414.Parsetree.Ppat_constraint (x0, x1) -> - Ast_500.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_414.Parsetree.Ppat_type x0 -> - Ast_500.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Ppat_lazy x0 -> - Ast_500.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_414.Parsetree.Ppat_unpack x0 -> - Ast_500.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_414.Parsetree.Ppat_exception x0 -> - Ast_500.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_414.Parsetree.Ppat_extension x0 -> - Ast_500.Parsetree.Ppat_extension (copy_extension x0) - | Ast_414.Parsetree.Ppat_open (x0, x1) -> - Ast_500.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_414.Parsetree.core_type -> Ast_500.Parsetree.core_type = - fun - { Ast_414.Parsetree.ptyp_desc = ptyp_desc; - Ast_414.Parsetree.ptyp_loc = ptyp_loc; - Ast_414.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_414.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_500.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_500.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_500.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_500.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_414.Parsetree.location_stack -> Ast_500.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_414.Parsetree.core_type_desc -> Ast_500.Parsetree.core_type_desc = - function - | Ast_414.Parsetree.Ptyp_any -> Ast_500.Parsetree.Ptyp_any - | Ast_414.Parsetree.Ptyp_var x0 -> Ast_500.Parsetree.Ptyp_var x0 - | Ast_414.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_500.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_414.Parsetree.Ptyp_tuple x0 -> - Ast_500.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_414.Parsetree.Ptyp_constr (x0, x1) -> - Ast_500.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_object (x0, x1) -> - Ast_500.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_414.Parsetree.Ptyp_class (x0, x1) -> - Ast_500.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_alias (x0, x1) -> - Ast_500.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_414.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_500.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_414.Parsetree.Ptyp_poly (x0, x1) -> - Ast_500.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_414.Parsetree.Ptyp_package x0 -> - Ast_500.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_414.Parsetree.Ptyp_extension x0 -> - Ast_500.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_414.Parsetree.package_type -> Ast_500.Parsetree.package_type = - fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) -and copy_row_field : - Ast_414.Parsetree.row_field -> Ast_500.Parsetree.row_field = - fun - { Ast_414.Parsetree.prf_desc = prf_desc; - Ast_414.Parsetree.prf_loc = prf_loc; - Ast_414.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_500.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_500.Parsetree.prf_loc = (copy_location prf_loc); - Ast_500.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_414.Parsetree.row_field_desc -> Ast_500.Parsetree.row_field_desc = - function - | Ast_414.Parsetree.Rtag (x0, x1, x2) -> - Ast_500.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_414.Parsetree.Rinherit x0 -> - Ast_500.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_414.Parsetree.object_field -> Ast_500.Parsetree.object_field = - fun - { Ast_414.Parsetree.pof_desc = pof_desc; - Ast_414.Parsetree.pof_loc = pof_loc; - Ast_414.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_500.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_500.Parsetree.pof_loc = (copy_location pof_loc); - Ast_500.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_414.Parsetree.attributes -> Ast_500.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_414.Parsetree.attribute -> Ast_500.Parsetree.attribute = - fun - { Ast_414.Parsetree.attr_name = attr_name; - Ast_414.Parsetree.attr_payload = attr_payload; - Ast_414.Parsetree.attr_loc = attr_loc } - -> - { - Ast_500.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_500.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_500.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_414.Parsetree.payload -> Ast_500.Parsetree.payload = - function - | Ast_414.Parsetree.PStr x0 -> Ast_500.Parsetree.PStr (copy_structure x0) - | Ast_414.Parsetree.PSig x0 -> Ast_500.Parsetree.PSig (copy_signature x0) - | Ast_414.Parsetree.PTyp x0 -> Ast_500.Parsetree.PTyp (copy_core_type x0) - | Ast_414.Parsetree.PPat (x0, x1) -> - Ast_500.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_414.Parsetree.structure -> Ast_500.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_414.Parsetree.structure_item -> Ast_500.Parsetree.structure_item = - fun - { Ast_414.Parsetree.pstr_desc = pstr_desc; - Ast_414.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_500.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_500.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_414.Parsetree.structure_item_desc -> - Ast_500.Parsetree.structure_item_desc - = - function - | Ast_414.Parsetree.Pstr_eval (x0, x1) -> - Ast_500.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_414.Parsetree.Pstr_value (x0, x1) -> - Ast_500.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_414.Parsetree.Pstr_primitive x0 -> - Ast_500.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_414.Parsetree.Pstr_type (x0, x1) -> - Ast_500.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_414.Parsetree.Pstr_typext x0 -> - Ast_500.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_414.Parsetree.Pstr_exception x0 -> - Ast_500.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_414.Parsetree.Pstr_module x0 -> - Ast_500.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_414.Parsetree.Pstr_recmodule x0 -> - Ast_500.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_414.Parsetree.Pstr_modtype x0 -> - Ast_500.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_414.Parsetree.Pstr_open x0 -> - Ast_500.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_414.Parsetree.Pstr_class x0 -> - Ast_500.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_414.Parsetree.Pstr_class_type x0 -> - Ast_500.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_414.Parsetree.Pstr_include x0 -> - Ast_500.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_414.Parsetree.Pstr_attribute x0 -> - Ast_500.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pstr_extension (x0, x1) -> - Ast_500.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_414.Parsetree.include_declaration -> - Ast_500.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_414.Parsetree.class_declaration -> Ast_500.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_414.Parsetree.class_expr -> Ast_500.Parsetree.class_expr = - fun - { Ast_414.Parsetree.pcl_desc = pcl_desc; - Ast_414.Parsetree.pcl_loc = pcl_loc; - Ast_414.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_500.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_500.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_500.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_414.Parsetree.class_expr_desc -> Ast_500.Parsetree.class_expr_desc = - function - | Ast_414.Parsetree.Pcl_constr (x0, x1) -> - Ast_500.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Pcl_structure x0 -> - Ast_500.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_414.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_500.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_414.Parsetree.Pcl_apply (x0, x1) -> - Ast_500.Parsetree.Pcl_apply - ((copy_class_expr x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_414.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_500.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_414.Parsetree.Pcl_constraint (x0, x1) -> - Ast_500.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_414.Parsetree.Pcl_extension x0 -> - Ast_500.Parsetree.Pcl_extension (copy_extension x0) - | Ast_414.Parsetree.Pcl_open (x0, x1) -> - Ast_500.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_414.Parsetree.class_structure -> Ast_500.Parsetree.class_structure = - fun - { Ast_414.Parsetree.pcstr_self = pcstr_self; - Ast_414.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_500.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_500.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_414.Parsetree.class_field -> Ast_500.Parsetree.class_field = - fun - { Ast_414.Parsetree.pcf_desc = pcf_desc; - Ast_414.Parsetree.pcf_loc = pcf_loc; - Ast_414.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_500.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_500.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_500.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_414.Parsetree.class_field_desc -> Ast_500.Parsetree.class_field_desc = - function - | Ast_414.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_500.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_414.Parsetree.Pcf_val x0 -> - Ast_500.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_414.Parsetree.Pcf_method x0 -> - Ast_500.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_414.Parsetree.Pcf_constraint x0 -> - Ast_500.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_414.Parsetree.Pcf_initializer x0 -> - Ast_500.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_414.Parsetree.Pcf_attribute x0 -> - Ast_500.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pcf_extension x0 -> - Ast_500.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_414.Parsetree.class_field_kind -> Ast_500.Parsetree.class_field_kind = - function - | Ast_414.Parsetree.Cfk_virtual x0 -> - Ast_500.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_414.Parsetree.Cfk_concrete (x0, x1) -> - Ast_500.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_414.Parsetree.open_declaration -> Ast_500.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_414.Parsetree.module_binding -> Ast_500.Parsetree.module_binding = - fun - { Ast_414.Parsetree.pmb_name = pmb_name; - Ast_414.Parsetree.pmb_expr = pmb_expr; - Ast_414.Parsetree.pmb_attributes = pmb_attributes; - Ast_414.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_500.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_500.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_500.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_500.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_414.Parsetree.module_expr -> Ast_500.Parsetree.module_expr = - fun - { Ast_414.Parsetree.pmod_desc = pmod_desc; - Ast_414.Parsetree.pmod_loc = pmod_loc; - Ast_414.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_500.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_500.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_500.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_414.Parsetree.module_expr_desc -> Ast_500.Parsetree.module_expr_desc = - function - | Ast_414.Parsetree.Pmod_ident x0 -> - Ast_500.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pmod_structure x0 -> - Ast_500.Parsetree.Pmod_structure (copy_structure x0) - | Ast_414.Parsetree.Pmod_functor (x0, x1) -> - Ast_500.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_414.Parsetree.Pmod_apply (x0, x1) -> - Ast_500.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_414.Parsetree.Pmod_constraint (x0, x1) -> - Ast_500.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pmod_unpack x0 -> - Ast_500.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_414.Parsetree.Pmod_extension x0 -> - Ast_500.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_414.Parsetree.functor_parameter -> Ast_500.Parsetree.functor_parameter - = - function - | Ast_414.Parsetree.Unit -> Ast_500.Parsetree.Unit - | Ast_414.Parsetree.Named (x0, x1) -> - Ast_500.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_414.Parsetree.module_type -> Ast_500.Parsetree.module_type = - fun - { Ast_414.Parsetree.pmty_desc = pmty_desc; - Ast_414.Parsetree.pmty_loc = pmty_loc; - Ast_414.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_500.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_500.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_500.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_414.Parsetree.module_type_desc -> Ast_500.Parsetree.module_type_desc = - function - | Ast_414.Parsetree.Pmty_ident x0 -> - Ast_500.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_414.Parsetree.Pmty_signature x0 -> - Ast_500.Parsetree.Pmty_signature (copy_signature x0) - | Ast_414.Parsetree.Pmty_functor (x0, x1) -> - Ast_500.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pmty_with (x0, x1) -> - Ast_500.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_414.Parsetree.Pmty_typeof x0 -> - Ast_500.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_414.Parsetree.Pmty_extension x0 -> - Ast_500.Parsetree.Pmty_extension (copy_extension x0) - | Ast_414.Parsetree.Pmty_alias x0 -> - Ast_500.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_414.Parsetree.with_constraint -> Ast_500.Parsetree.with_constraint = - function - | Ast_414.Parsetree.Pwith_type (x0, x1) -> - Ast_500.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_414.Parsetree.Pwith_module (x0, x1) -> - Ast_500.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_414.Parsetree.Pwith_modtype (x0, x1) -> - Ast_500.Parsetree.Pwith_modtype - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pwith_modtypesubst (x0, x1) -> - Ast_500.Parsetree.Pwith_modtypesubst - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_414.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_500.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_414.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_500.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_414.Parsetree.signature -> Ast_500.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_414.Parsetree.signature_item -> Ast_500.Parsetree.signature_item = - fun - { Ast_414.Parsetree.psig_desc = psig_desc; - Ast_414.Parsetree.psig_loc = psig_loc } - -> - { - Ast_500.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_500.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_414.Parsetree.signature_item_desc -> - Ast_500.Parsetree.signature_item_desc - = - function - | Ast_414.Parsetree.Psig_value x0 -> - Ast_500.Parsetree.Psig_value (copy_value_description x0) - | Ast_414.Parsetree.Psig_type (x0, x1) -> - Ast_500.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_414.Parsetree.Psig_typesubst x0 -> - Ast_500.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_414.Parsetree.Psig_typext x0 -> - Ast_500.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_414.Parsetree.Psig_exception x0 -> - Ast_500.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_414.Parsetree.Psig_module x0 -> - Ast_500.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_414.Parsetree.Psig_modsubst x0 -> - Ast_500.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_414.Parsetree.Psig_recmodule x0 -> - Ast_500.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_414.Parsetree.Psig_modtype x0 -> - Ast_500.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_414.Parsetree.Psig_modtypesubst x0 -> - Ast_500.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) - | Ast_414.Parsetree.Psig_open x0 -> - Ast_500.Parsetree.Psig_open (copy_open_description x0) - | Ast_414.Parsetree.Psig_include x0 -> - Ast_500.Parsetree.Psig_include (copy_include_description x0) - | Ast_414.Parsetree.Psig_class x0 -> - Ast_500.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_414.Parsetree.Psig_class_type x0 -> - Ast_500.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_414.Parsetree.Psig_attribute x0 -> - Ast_500.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_414.Parsetree.Psig_extension (x0, x1) -> - Ast_500.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_414.Parsetree.class_type_declaration -> - Ast_500.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_414.Parsetree.class_description -> Ast_500.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_414.Parsetree.class_type -> Ast_500.Parsetree.class_type = - fun - { Ast_414.Parsetree.pcty_desc = pcty_desc; - Ast_414.Parsetree.pcty_loc = pcty_loc; - Ast_414.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_500.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_500.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_500.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_414.Parsetree.class_type_desc -> Ast_500.Parsetree.class_type_desc = - function - | Ast_414.Parsetree.Pcty_constr (x0, x1) -> - Ast_500.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_414.Parsetree.Pcty_signature x0 -> - Ast_500.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_414.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_500.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_414.Parsetree.Pcty_extension x0 -> - Ast_500.Parsetree.Pcty_extension (copy_extension x0) - | Ast_414.Parsetree.Pcty_open (x0, x1) -> - Ast_500.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_414.Parsetree.class_signature -> Ast_500.Parsetree.class_signature = - fun - { Ast_414.Parsetree.pcsig_self = pcsig_self; - Ast_414.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_500.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_500.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_414.Parsetree.class_type_field -> Ast_500.Parsetree.class_type_field = - fun - { Ast_414.Parsetree.pctf_desc = pctf_desc; - Ast_414.Parsetree.pctf_loc = pctf_loc; - Ast_414.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_500.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_500.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_500.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_414.Parsetree.class_type_field_desc -> - Ast_500.Parsetree.class_type_field_desc - = - function - | Ast_414.Parsetree.Pctf_inherit x0 -> - Ast_500.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_414.Parsetree.Pctf_val x0 -> - Ast_500.Parsetree.Pctf_val - (let (x0, x1, x2, x3) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_virtual_flag x2), (copy_core_type x3))) - | Ast_414.Parsetree.Pctf_method x0 -> - Ast_500.Parsetree.Pctf_method - (let (x0, x1, x2, x3) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_virtual_flag x2), (copy_core_type x3))) - | Ast_414.Parsetree.Pctf_constraint x0 -> - Ast_500.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_414.Parsetree.Pctf_attribute x0 -> - Ast_500.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_414.Parsetree.Pctf_extension x0 -> - Ast_500.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_414.Parsetree.extension -> Ast_500.Parsetree.extension = - fun x -> - let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) -and copy_class_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_414.Parsetree.class_infos -> 'g0 Ast_500.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.pci_virt = pci_virt; - Ast_414.Parsetree.pci_params = pci_params; - Ast_414.Parsetree.pci_name = pci_name; - Ast_414.Parsetree.pci_expr = pci_expr; - Ast_414.Parsetree.pci_loc = pci_loc; - Ast_414.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_500.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_500.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_500.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_500.Parsetree.pci_expr = (f0 pci_expr); - Ast_500.Parsetree.pci_loc = (copy_location pci_loc); - Ast_500.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_414.Asttypes.virtual_flag -> Ast_500.Asttypes.virtual_flag = - function - | Ast_414.Asttypes.Virtual -> Ast_500.Asttypes.Virtual - | Ast_414.Asttypes.Concrete -> Ast_500.Asttypes.Concrete -and copy_include_description : - Ast_414.Parsetree.include_description -> - Ast_500.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_414.Parsetree.include_infos -> - 'g0 Ast_500.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.pincl_mod = pincl_mod; - Ast_414.Parsetree.pincl_loc = pincl_loc; - Ast_414.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_500.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_500.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_500.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_414.Parsetree.open_description -> Ast_500.Parsetree.open_description = - fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x -and copy_open_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_414.Parsetree.open_infos -> 'g0 Ast_500.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_414.Parsetree.popen_expr = popen_expr; - Ast_414.Parsetree.popen_override = popen_override; - Ast_414.Parsetree.popen_loc = popen_loc; - Ast_414.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_500.Parsetree.popen_expr = (f0 popen_expr); - Ast_500.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_500.Parsetree.popen_loc = (copy_location popen_loc); - Ast_500.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_414.Asttypes.override_flag -> Ast_500.Asttypes.override_flag = - function - | Ast_414.Asttypes.Override -> Ast_500.Asttypes.Override - | Ast_414.Asttypes.Fresh -> Ast_500.Asttypes.Fresh -and copy_module_type_declaration : - Ast_414.Parsetree.module_type_declaration -> - Ast_500.Parsetree.module_type_declaration - = - fun - { Ast_414.Parsetree.pmtd_name = pmtd_name; - Ast_414.Parsetree.pmtd_type = pmtd_type; - Ast_414.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_414.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_500.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_500.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_500.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_500.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_414.Parsetree.module_substitution -> - Ast_500.Parsetree.module_substitution - = - fun - { Ast_414.Parsetree.pms_name = pms_name; - Ast_414.Parsetree.pms_manifest = pms_manifest; - Ast_414.Parsetree.pms_attributes = pms_attributes; - Ast_414.Parsetree.pms_loc = pms_loc } - -> - { - Ast_500.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_500.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_500.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_500.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_414.Parsetree.module_declaration -> - Ast_500.Parsetree.module_declaration - = - fun - { Ast_414.Parsetree.pmd_name = pmd_name; - Ast_414.Parsetree.pmd_type = pmd_type; - Ast_414.Parsetree.pmd_attributes = pmd_attributes; - Ast_414.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_500.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_500.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_500.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_500.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_414.Parsetree.type_exception -> Ast_500.Parsetree.type_exception = - fun - { Ast_414.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_414.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_414.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_500.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_500.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_500.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_414.Parsetree.type_extension -> Ast_500.Parsetree.type_extension = - fun - { Ast_414.Parsetree.ptyext_path = ptyext_path; - Ast_414.Parsetree.ptyext_params = ptyext_params; - Ast_414.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_414.Parsetree.ptyext_private = ptyext_private; - Ast_414.Parsetree.ptyext_loc = ptyext_loc; - Ast_414.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_500.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_500.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_500.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_500.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_500.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_500.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_414.Parsetree.extension_constructor -> - Ast_500.Parsetree.extension_constructor - = - fun - { Ast_414.Parsetree.pext_name = pext_name; - Ast_414.Parsetree.pext_kind = pext_kind; - Ast_414.Parsetree.pext_loc = pext_loc; - Ast_414.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_500.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_500.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_500.Parsetree.pext_loc = (copy_location pext_loc); - Ast_500.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_414.Parsetree.extension_constructor_kind -> - Ast_500.Parsetree.extension_constructor_kind - = - function - | Ast_414.Parsetree.Pext_decl (x0, x1, x2) -> - Ast_500.Parsetree.Pext_decl - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_constructor_arguments x1), (Option.map copy_core_type x2)) - | Ast_414.Parsetree.Pext_rebind x0 -> - Ast_500.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_414.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration = - fun - { Ast_414.Parsetree.ptype_name = ptype_name; - Ast_414.Parsetree.ptype_params = ptype_params; - Ast_414.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_414.Parsetree.ptype_kind = ptype_kind; - Ast_414.Parsetree.ptype_private = ptype_private; - Ast_414.Parsetree.ptype_manifest = ptype_manifest; - Ast_414.Parsetree.ptype_attributes = ptype_attributes; - Ast_414.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_500.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_500.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_500.Parsetree.ptype_cstrs = - (List.map - (fun x -> - let (x0, x1, x2) = x in - ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) - ptype_cstrs); - Ast_500.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_500.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_500.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_500.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_500.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_414.Asttypes.private_flag -> Ast_500.Asttypes.private_flag = - function - | Ast_414.Asttypes.Private -> Ast_500.Asttypes.Private - | Ast_414.Asttypes.Public -> Ast_500.Asttypes.Public -and copy_type_kind : - Ast_414.Parsetree.type_kind -> Ast_500.Parsetree.type_kind = - function - | Ast_414.Parsetree.Ptype_abstract -> Ast_500.Parsetree.Ptype_abstract - | Ast_414.Parsetree.Ptype_variant x0 -> - Ast_500.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_414.Parsetree.Ptype_record x0 -> - Ast_500.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_414.Parsetree.Ptype_open -> Ast_500.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_414.Parsetree.constructor_declaration -> - Ast_500.Parsetree.constructor_declaration - = - fun - { Ast_414.Parsetree.pcd_name = pcd_name; - Ast_414.Parsetree.pcd_vars = pcd_vars; - Ast_414.Parsetree.pcd_args = pcd_args; - Ast_414.Parsetree.pcd_res = pcd_res; - Ast_414.Parsetree.pcd_loc = pcd_loc; - Ast_414.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_500.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_500.Parsetree.pcd_vars = - (List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars); - Ast_500.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_500.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_500.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_500.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_414.Parsetree.constructor_arguments -> - Ast_500.Parsetree.constructor_arguments - = - function - | Ast_414.Parsetree.Pcstr_tuple x0 -> - Ast_500.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_414.Parsetree.Pcstr_record x0 -> - Ast_500.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_414.Parsetree.label_declaration -> Ast_500.Parsetree.label_declaration - = - fun - { Ast_414.Parsetree.pld_name = pld_name; - Ast_414.Parsetree.pld_mutable = pld_mutable; - Ast_414.Parsetree.pld_type = pld_type; - Ast_414.Parsetree.pld_loc = pld_loc; - Ast_414.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_500.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_500.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_500.Parsetree.pld_type = (copy_core_type pld_type); - Ast_500.Parsetree.pld_loc = (copy_location pld_loc); - Ast_500.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_414.Asttypes.mutable_flag -> Ast_500.Asttypes.mutable_flag = - function - | Ast_414.Asttypes.Immutable -> Ast_500.Asttypes.Immutable - | Ast_414.Asttypes.Mutable -> Ast_500.Asttypes.Mutable -and copy_injectivity : - Ast_414.Asttypes.injectivity -> Ast_500.Asttypes.injectivity = - function - | Ast_414.Asttypes.Injective -> Ast_500.Asttypes.Injective - | Ast_414.Asttypes.NoInjectivity -> Ast_500.Asttypes.NoInjectivity -and copy_variance : Ast_414.Asttypes.variance -> Ast_500.Asttypes.variance = - function - | Ast_414.Asttypes.Covariant -> Ast_500.Asttypes.Covariant - | Ast_414.Asttypes.Contravariant -> Ast_500.Asttypes.Contravariant - | Ast_414.Asttypes.NoVariance -> Ast_500.Asttypes.NoVariance -and copy_value_description : - Ast_414.Parsetree.value_description -> Ast_500.Parsetree.value_description - = - fun - { Ast_414.Parsetree.pval_name = pval_name; - Ast_414.Parsetree.pval_type = pval_type; - Ast_414.Parsetree.pval_prim = pval_prim; - Ast_414.Parsetree.pval_attributes = pval_attributes; - Ast_414.Parsetree.pval_loc = pval_loc } - -> - { - Ast_500.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_500.Parsetree.pval_type = (copy_core_type pval_type); - Ast_500.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_500.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_500.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_414.Parsetree.object_field_desc -> Ast_500.Parsetree.object_field_desc - = - function - | Ast_414.Parsetree.Otag (x0, x1) -> - Ast_500.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_414.Parsetree.Oinherit x0 -> - Ast_500.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_414.Asttypes.arg_label -> Ast_500.Asttypes.arg_label - = - function - | Ast_414.Asttypes.Nolabel -> Ast_500.Asttypes.Nolabel - | Ast_414.Asttypes.Labelled x0 -> Ast_500.Asttypes.Labelled x0 - | Ast_414.Asttypes.Optional x0 -> Ast_500.Asttypes.Optional x0 -and copy_closed_flag : - Ast_414.Asttypes.closed_flag -> Ast_500.Asttypes.closed_flag = - function - | Ast_414.Asttypes.Closed -> Ast_500.Asttypes.Closed - | Ast_414.Asttypes.Open -> Ast_500.Asttypes.Open -and copy_label : Ast_414.Asttypes.label -> Ast_500.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_414.Asttypes.rec_flag -> Ast_500.Asttypes.rec_flag = - function - | Ast_414.Asttypes.Nonrecursive -> Ast_500.Asttypes.Nonrecursive - | Ast_414.Asttypes.Recursive -> Ast_500.Asttypes.Recursive -and copy_constant : Ast_414.Parsetree.constant -> Ast_500.Parsetree.constant - = - function - | Ast_414.Parsetree.Pconst_integer (x0, x1) -> - Ast_500.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_414.Parsetree.Pconst_char x0 -> Ast_500.Parsetree.Pconst_char x0 - | Ast_414.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_500.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_414.Parsetree.Pconst_float (x0, x1) -> - Ast_500.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_414.Asttypes.loc -> 'g0 Ast_500.Asttypes.loc - = - fun f0 -> - fun { Ast_414.Asttypes.txt = txt; Ast_414.Asttypes.loc = loc } -> - { - Ast_500.Asttypes.txt = (f0 txt); - Ast_500.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_500_414.ml b/src/vendored-omp/src/migrate_parsetree_500_414.ml index 5cf09bc0a..3023b5a13 100644 --- a/src/vendored-omp/src/migrate_parsetree_500_414.ml +++ b/src/vendored-omp/src/migrate_parsetree_500_414.ml @@ -14,131 +14,3 @@ (**************************************************************************) include Migrate_parsetree_500_414_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"; - "constant" - ] - 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 module Def = Migrate_parsetree_def in - let module R = Migrate_parsetree_414_500_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 -> List.map copy_case (cases mapper (List.map R.copy_case 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_expression (expr mapper (R.copy_expression 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_pattern (pat mapper (R.copy_pattern 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_core_type (typ mapper (R.copy_core_type 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 -> copy_constant (constant mapper (R.copy_constant x))); - (*$*) - } diff --git a/src/vendored-omp/src/migrate_parsetree_500_414_migrate.ml b/src/vendored-omp/src/migrate_parsetree_500_414_migrate.ml index b8722778f..f78548d43 100644 --- a/src/vendored-omp/src/migrate_parsetree_500_414_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_500_414_migrate.ml @@ -152,6 +152,11 @@ and copy_out_extension_constructor : (Option.map copy_out_type oext_ret_type); Ast_414.Outcometree.oext_private = (copy_private_flag oext_private) } +and copy_private_flag : + Ast_500.Asttypes.private_flag -> Ast_414.Asttypes.private_flag = + function + | Ast_500.Asttypes.Private -> Ast_414.Asttypes.Private + | Ast_500.Asttypes.Public -> Ast_414.Asttypes.Public and copy_out_rec_status : Ast_500.Outcometree.out_rec_status -> Ast_414.Outcometree.out_rec_status = function @@ -188,6 +193,16 @@ and copy_out_type_param : fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_500.Asttypes.injectivity -> Ast_414.Asttypes.injectivity = + function + | Ast_500.Asttypes.Injective -> Ast_414.Asttypes.Injective + | Ast_500.Asttypes.NoInjectivity -> Ast_414.Asttypes.NoInjectivity +and copy_variance : Ast_500.Asttypes.variance -> Ast_414.Asttypes.variance = + function + | Ast_500.Asttypes.Covariant -> Ast_414.Asttypes.Covariant + | Ast_500.Asttypes.Contravariant -> Ast_414.Asttypes.Contravariant + | Ast_500.Asttypes.NoVariance -> Ast_414.Asttypes.NoVariance and copy_out_type : Ast_500.Outcometree.out_type -> Ast_414.Outcometree.out_type = function @@ -318,1229 +333,3 @@ and copy_out_name : Ast_500.Outcometree.out_name -> Ast_414.Outcometree.out_name = fun { Ast_500.Outcometree.printed_name = printed_name } -> { Ast_414.Outcometree.printed_name = printed_name } -and copy_toplevel_phrase : - Ast_500.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase = - function - | Ast_500.Parsetree.Ptop_def x0 -> - Ast_414.Parsetree.Ptop_def (copy_structure x0) - | Ast_500.Parsetree.Ptop_dir x0 -> - Ast_414.Parsetree.Ptop_dir (copy_toplevel_directive x0) -and copy_toplevel_directive : - Ast_500.Parsetree.toplevel_directive -> - Ast_414.Parsetree.toplevel_directive - = - fun - { Ast_500.Parsetree.pdir_name = pdir_name; - Ast_500.Parsetree.pdir_arg = pdir_arg; - Ast_500.Parsetree.pdir_loc = pdir_loc } - -> - { - Ast_414.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); - Ast_414.Parsetree.pdir_arg = - (Option.map copy_directive_argument pdir_arg); - Ast_414.Parsetree.pdir_loc = (copy_location pdir_loc) - } -and copy_directive_argument : - Ast_500.Parsetree.directive_argument -> - Ast_414.Parsetree.directive_argument - = - fun - { Ast_500.Parsetree.pdira_desc = pdira_desc; - Ast_500.Parsetree.pdira_loc = pdira_loc } - -> - { - Ast_414.Parsetree.pdira_desc = - (copy_directive_argument_desc pdira_desc); - Ast_414.Parsetree.pdira_loc = (copy_location pdira_loc) - } -and copy_directive_argument_desc : - Ast_500.Parsetree.directive_argument_desc -> - Ast_414.Parsetree.directive_argument_desc - = - function - | Ast_500.Parsetree.Pdir_string x0 -> Ast_414.Parsetree.Pdir_string x0 - | Ast_500.Parsetree.Pdir_int (x0, x1) -> - Ast_414.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) - | Ast_500.Parsetree.Pdir_ident x0 -> - Ast_414.Parsetree.Pdir_ident (copy_Longident_t x0) - | Ast_500.Parsetree.Pdir_bool x0 -> Ast_414.Parsetree.Pdir_bool x0 -and copy_expression : - Ast_500.Parsetree.expression -> Ast_414.Parsetree.expression = - fun - { Ast_500.Parsetree.pexp_desc = pexp_desc; - Ast_500.Parsetree.pexp_loc = pexp_loc; - Ast_500.Parsetree.pexp_loc_stack = pexp_loc_stack; - Ast_500.Parsetree.pexp_attributes = pexp_attributes } - -> - { - Ast_414.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); - Ast_414.Parsetree.pexp_loc = (copy_location pexp_loc); - Ast_414.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); - Ast_414.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) - } -and copy_expression_desc : - Ast_500.Parsetree.expression_desc -> Ast_414.Parsetree.expression_desc = - function - | Ast_500.Parsetree.Pexp_ident x0 -> - Ast_414.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) - | Ast_500.Parsetree.Pexp_constant x0 -> - Ast_414.Parsetree.Pexp_constant (copy_constant x0) - | Ast_500.Parsetree.Pexp_let (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_expression x2)) - | Ast_500.Parsetree.Pexp_function x0 -> - Ast_414.Parsetree.Pexp_function (List.map copy_case x0) - | Ast_500.Parsetree.Pexp_fun (x0, x1, x2, x3) -> - Ast_414.Parsetree.Pexp_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_expression x3)) - | Ast_500.Parsetree.Pexp_apply (x0, x1) -> - Ast_414.Parsetree.Pexp_apply - ((copy_expression x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_500.Parsetree.Pexp_match (x0, x1) -> - Ast_414.Parsetree.Pexp_match - ((copy_expression x0), (List.map copy_case x1)) - | Ast_500.Parsetree.Pexp_try (x0, x1) -> - Ast_414.Parsetree.Pexp_try - ((copy_expression x0), (List.map copy_case x1)) - | Ast_500.Parsetree.Pexp_tuple x0 -> - Ast_414.Parsetree.Pexp_tuple (List.map copy_expression x0) - | Ast_500.Parsetree.Pexp_construct (x0, x1) -> - Ast_414.Parsetree.Pexp_construct - ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) - | Ast_500.Parsetree.Pexp_variant (x0, x1) -> - Ast_414.Parsetree.Pexp_variant - ((copy_label x0), (Option.map copy_expression x1)) - | Ast_500.Parsetree.Pexp_record (x0, x1) -> - Ast_414.Parsetree.Pexp_record - ((List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), - (Option.map copy_expression x1)) - | Ast_500.Parsetree.Pexp_field (x0, x1) -> - Ast_414.Parsetree.Pexp_field - ((copy_expression x0), (copy_loc copy_Longident_t x1)) - | Ast_500.Parsetree.Pexp_setfield (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_setfield - ((copy_expression x0), (copy_loc copy_Longident_t x1), - (copy_expression x2)) - | Ast_500.Parsetree.Pexp_array x0 -> - Ast_414.Parsetree.Pexp_array (List.map copy_expression x0) - | Ast_500.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_ifthenelse - ((copy_expression x0), (copy_expression x1), - (Option.map copy_expression x2)) - | Ast_500.Parsetree.Pexp_sequence (x0, x1) -> - Ast_414.Parsetree.Pexp_sequence - ((copy_expression x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_while (x0, x1) -> - Ast_414.Parsetree.Pexp_while - ((copy_expression x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> - Ast_414.Parsetree.Pexp_for - ((copy_pattern x0), (copy_expression x1), (copy_expression x2), - (copy_direction_flag x3), (copy_expression x4)) - | Ast_500.Parsetree.Pexp_constraint (x0, x1) -> - Ast_414.Parsetree.Pexp_constraint - ((copy_expression x0), (copy_core_type x1)) - | Ast_500.Parsetree.Pexp_coerce (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_coerce - ((copy_expression x0), (Option.map copy_core_type x1), - (copy_core_type x2)) - | Ast_500.Parsetree.Pexp_send (x0, x1) -> - Ast_414.Parsetree.Pexp_send - ((copy_expression x0), (copy_loc copy_label x1)) - | Ast_500.Parsetree.Pexp_new x0 -> - Ast_414.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) - | Ast_500.Parsetree.Pexp_setinstvar (x0, x1) -> - Ast_414.Parsetree.Pexp_setinstvar - ((copy_loc copy_label x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_override x0 -> - Ast_414.Parsetree.Pexp_override - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_label x0), (copy_expression x1))) x0) - | Ast_500.Parsetree.Pexp_letmodule (x0, x1, x2) -> - Ast_414.Parsetree.Pexp_letmodule - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_expr x1), (copy_expression x2)) - | Ast_500.Parsetree.Pexp_letexception (x0, x1) -> - Ast_414.Parsetree.Pexp_letexception - ((copy_extension_constructor x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_assert x0 -> - Ast_414.Parsetree.Pexp_assert (copy_expression x0) - | Ast_500.Parsetree.Pexp_lazy x0 -> - Ast_414.Parsetree.Pexp_lazy (copy_expression x0) - | Ast_500.Parsetree.Pexp_poly (x0, x1) -> - Ast_414.Parsetree.Pexp_poly - ((copy_expression x0), (Option.map copy_core_type x1)) - | Ast_500.Parsetree.Pexp_object x0 -> - Ast_414.Parsetree.Pexp_object (copy_class_structure x0) - | Ast_500.Parsetree.Pexp_newtype (x0, x1) -> - Ast_414.Parsetree.Pexp_newtype - ((copy_loc (fun x -> x) x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_pack x0 -> - Ast_414.Parsetree.Pexp_pack (copy_module_expr x0) - | Ast_500.Parsetree.Pexp_open (x0, x1) -> - Ast_414.Parsetree.Pexp_open - ((copy_open_declaration x0), (copy_expression x1)) - | Ast_500.Parsetree.Pexp_letop x0 -> - Ast_414.Parsetree.Pexp_letop (copy_letop x0) - | Ast_500.Parsetree.Pexp_extension x0 -> - Ast_414.Parsetree.Pexp_extension (copy_extension x0) - | Ast_500.Parsetree.Pexp_unreachable -> Ast_414.Parsetree.Pexp_unreachable -and copy_letop : Ast_500.Parsetree.letop -> Ast_414.Parsetree.letop = - fun - { Ast_500.Parsetree.let_ = let_; Ast_500.Parsetree.ands = ands; - Ast_500.Parsetree.body = body } - -> - { - Ast_414.Parsetree.let_ = (copy_binding_op let_); - Ast_414.Parsetree.ands = (List.map copy_binding_op ands); - Ast_414.Parsetree.body = (copy_expression body) - } -and copy_binding_op : - Ast_500.Parsetree.binding_op -> Ast_414.Parsetree.binding_op = - fun - { Ast_500.Parsetree.pbop_op = pbop_op; - Ast_500.Parsetree.pbop_pat = pbop_pat; - Ast_500.Parsetree.pbop_exp = pbop_exp; - Ast_500.Parsetree.pbop_loc = pbop_loc } - -> - { - Ast_414.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); - Ast_414.Parsetree.pbop_pat = (copy_pattern pbop_pat); - Ast_414.Parsetree.pbop_exp = (copy_expression pbop_exp); - Ast_414.Parsetree.pbop_loc = (copy_location pbop_loc) - } -and copy_direction_flag : - Ast_500.Asttypes.direction_flag -> Ast_414.Asttypes.direction_flag = - function - | Ast_500.Asttypes.Upto -> Ast_414.Asttypes.Upto - | Ast_500.Asttypes.Downto -> Ast_414.Asttypes.Downto -and copy_case : Ast_500.Parsetree.case -> Ast_414.Parsetree.case = - fun - { Ast_500.Parsetree.pc_lhs = pc_lhs; - Ast_500.Parsetree.pc_guard = pc_guard; - Ast_500.Parsetree.pc_rhs = pc_rhs } - -> - { - Ast_414.Parsetree.pc_lhs = (copy_pattern pc_lhs); - Ast_414.Parsetree.pc_guard = (Option.map copy_expression pc_guard); - Ast_414.Parsetree.pc_rhs = (copy_expression pc_rhs) - } -and copy_value_binding : - Ast_500.Parsetree.value_binding -> Ast_414.Parsetree.value_binding = - fun - { Ast_500.Parsetree.pvb_pat = pvb_pat; - Ast_500.Parsetree.pvb_expr = pvb_expr; - Ast_500.Parsetree.pvb_attributes = pvb_attributes; - Ast_500.Parsetree.pvb_loc = pvb_loc } - -> - { - Ast_414.Parsetree.pvb_pat = (copy_pattern pvb_pat); - Ast_414.Parsetree.pvb_expr = (copy_expression pvb_expr); - Ast_414.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); - Ast_414.Parsetree.pvb_loc = (copy_location pvb_loc) - } -and copy_pattern : Ast_500.Parsetree.pattern -> Ast_414.Parsetree.pattern = - fun - { Ast_500.Parsetree.ppat_desc = ppat_desc; - Ast_500.Parsetree.ppat_loc = ppat_loc; - Ast_500.Parsetree.ppat_loc_stack = ppat_loc_stack; - Ast_500.Parsetree.ppat_attributes = ppat_attributes } - -> - { - Ast_414.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); - Ast_414.Parsetree.ppat_loc = (copy_location ppat_loc); - Ast_414.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); - Ast_414.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) - } -and copy_pattern_desc : - Ast_500.Parsetree.pattern_desc -> Ast_414.Parsetree.pattern_desc = - function - | Ast_500.Parsetree.Ppat_any -> Ast_414.Parsetree.Ppat_any - | Ast_500.Parsetree.Ppat_var x0 -> - Ast_414.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) - | Ast_500.Parsetree.Ppat_alias (x0, x1) -> - Ast_414.Parsetree.Ppat_alias - ((copy_pattern x0), (copy_loc (fun x -> x) x1)) - | Ast_500.Parsetree.Ppat_constant x0 -> - Ast_414.Parsetree.Ppat_constant (copy_constant x0) - | Ast_500.Parsetree.Ppat_interval (x0, x1) -> - Ast_414.Parsetree.Ppat_interval - ((copy_constant x0), (copy_constant x1)) - | Ast_500.Parsetree.Ppat_tuple x0 -> - Ast_414.Parsetree.Ppat_tuple (List.map copy_pattern x0) - | Ast_500.Parsetree.Ppat_construct (x0, x1) -> - Ast_414.Parsetree.Ppat_construct - ((copy_loc copy_Longident_t x0), - (Option.map - (fun x -> - let (x0, x1) = x in - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_pattern x1))) x1)) - | Ast_500.Parsetree.Ppat_variant (x0, x1) -> - Ast_414.Parsetree.Ppat_variant - ((copy_label x0), (Option.map copy_pattern x1)) - | Ast_500.Parsetree.Ppat_record (x0, x1) -> - Ast_414.Parsetree.Ppat_record - ((List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), - (copy_closed_flag x1)) - | Ast_500.Parsetree.Ppat_array x0 -> - Ast_414.Parsetree.Ppat_array (List.map copy_pattern x0) - | Ast_500.Parsetree.Ppat_or (x0, x1) -> - Ast_414.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) - | Ast_500.Parsetree.Ppat_constraint (x0, x1) -> - Ast_414.Parsetree.Ppat_constraint - ((copy_pattern x0), (copy_core_type x1)) - | Ast_500.Parsetree.Ppat_type x0 -> - Ast_414.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) - | Ast_500.Parsetree.Ppat_lazy x0 -> - Ast_414.Parsetree.Ppat_lazy (copy_pattern x0) - | Ast_500.Parsetree.Ppat_unpack x0 -> - Ast_414.Parsetree.Ppat_unpack - (copy_loc (fun x -> Option.map (fun x -> x) x) x0) - | Ast_500.Parsetree.Ppat_exception x0 -> - Ast_414.Parsetree.Ppat_exception (copy_pattern x0) - | Ast_500.Parsetree.Ppat_extension x0 -> - Ast_414.Parsetree.Ppat_extension (copy_extension x0) - | Ast_500.Parsetree.Ppat_open (x0, x1) -> - Ast_414.Parsetree.Ppat_open - ((copy_loc copy_Longident_t x0), (copy_pattern x1)) -and copy_core_type : - Ast_500.Parsetree.core_type -> Ast_414.Parsetree.core_type = - fun - { Ast_500.Parsetree.ptyp_desc = ptyp_desc; - Ast_500.Parsetree.ptyp_loc = ptyp_loc; - Ast_500.Parsetree.ptyp_loc_stack = ptyp_loc_stack; - Ast_500.Parsetree.ptyp_attributes = ptyp_attributes } - -> - { - Ast_414.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); - Ast_414.Parsetree.ptyp_loc = (copy_location ptyp_loc); - Ast_414.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); - Ast_414.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) - } -and copy_location_stack : - Ast_500.Parsetree.location_stack -> Ast_414.Parsetree.location_stack = - fun x -> List.map copy_location x -and copy_core_type_desc : - Ast_500.Parsetree.core_type_desc -> Ast_414.Parsetree.core_type_desc = - function - | Ast_500.Parsetree.Ptyp_any -> Ast_414.Parsetree.Ptyp_any - | Ast_500.Parsetree.Ptyp_var x0 -> Ast_414.Parsetree.Ptyp_var x0 - | Ast_500.Parsetree.Ptyp_arrow (x0, x1, x2) -> - Ast_414.Parsetree.Ptyp_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) - | Ast_500.Parsetree.Ptyp_tuple x0 -> - Ast_414.Parsetree.Ptyp_tuple (List.map copy_core_type x0) - | Ast_500.Parsetree.Ptyp_constr (x0, x1) -> - Ast_414.Parsetree.Ptyp_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_500.Parsetree.Ptyp_object (x0, x1) -> - Ast_414.Parsetree.Ptyp_object - ((List.map copy_object_field x0), (copy_closed_flag x1)) - | Ast_500.Parsetree.Ptyp_class (x0, x1) -> - Ast_414.Parsetree.Ptyp_class - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_500.Parsetree.Ptyp_alias (x0, x1) -> - Ast_414.Parsetree.Ptyp_alias ((copy_core_type x0), x1) - | Ast_500.Parsetree.Ptyp_variant (x0, x1, x2) -> - Ast_414.Parsetree.Ptyp_variant - ((List.map copy_row_field x0), (copy_closed_flag x1), - (Option.map (fun x -> List.map copy_label x) x2)) - | Ast_500.Parsetree.Ptyp_poly (x0, x1) -> - Ast_414.Parsetree.Ptyp_poly - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_core_type x1)) - | Ast_500.Parsetree.Ptyp_package x0 -> - Ast_414.Parsetree.Ptyp_package (copy_package_type x0) - | Ast_500.Parsetree.Ptyp_extension x0 -> - Ast_414.Parsetree.Ptyp_extension (copy_extension x0) -and copy_package_type : - Ast_500.Parsetree.package_type -> Ast_414.Parsetree.package_type = - fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) -and copy_row_field : - Ast_500.Parsetree.row_field -> Ast_414.Parsetree.row_field = - fun - { Ast_500.Parsetree.prf_desc = prf_desc; - Ast_500.Parsetree.prf_loc = prf_loc; - Ast_500.Parsetree.prf_attributes = prf_attributes } - -> - { - Ast_414.Parsetree.prf_desc = (copy_row_field_desc prf_desc); - Ast_414.Parsetree.prf_loc = (copy_location prf_loc); - Ast_414.Parsetree.prf_attributes = (copy_attributes prf_attributes) - } -and copy_row_field_desc : - Ast_500.Parsetree.row_field_desc -> Ast_414.Parsetree.row_field_desc = - function - | Ast_500.Parsetree.Rtag (x0, x1, x2) -> - Ast_414.Parsetree.Rtag - ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) - | Ast_500.Parsetree.Rinherit x0 -> - Ast_414.Parsetree.Rinherit (copy_core_type x0) -and copy_object_field : - Ast_500.Parsetree.object_field -> Ast_414.Parsetree.object_field = - fun - { Ast_500.Parsetree.pof_desc = pof_desc; - Ast_500.Parsetree.pof_loc = pof_loc; - Ast_500.Parsetree.pof_attributes = pof_attributes } - -> - { - Ast_414.Parsetree.pof_desc = (copy_object_field_desc pof_desc); - Ast_414.Parsetree.pof_loc = (copy_location pof_loc); - Ast_414.Parsetree.pof_attributes = (copy_attributes pof_attributes) - } -and copy_attributes : - Ast_500.Parsetree.attributes -> Ast_414.Parsetree.attributes = - fun x -> List.map copy_attribute x -and copy_attribute : - Ast_500.Parsetree.attribute -> Ast_414.Parsetree.attribute = - fun - { Ast_500.Parsetree.attr_name = attr_name; - Ast_500.Parsetree.attr_payload = attr_payload; - Ast_500.Parsetree.attr_loc = attr_loc } - -> - { - Ast_414.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); - Ast_414.Parsetree.attr_payload = (copy_payload attr_payload); - Ast_414.Parsetree.attr_loc = (copy_location attr_loc) - } -and copy_payload : Ast_500.Parsetree.payload -> Ast_414.Parsetree.payload = - function - | Ast_500.Parsetree.PStr x0 -> Ast_414.Parsetree.PStr (copy_structure x0) - | Ast_500.Parsetree.PSig x0 -> Ast_414.Parsetree.PSig (copy_signature x0) - | Ast_500.Parsetree.PTyp x0 -> Ast_414.Parsetree.PTyp (copy_core_type x0) - | Ast_500.Parsetree.PPat (x0, x1) -> - Ast_414.Parsetree.PPat - ((copy_pattern x0), (Option.map copy_expression x1)) -and copy_structure : - Ast_500.Parsetree.structure -> Ast_414.Parsetree.structure = - fun x -> List.map copy_structure_item x -and copy_structure_item : - Ast_500.Parsetree.structure_item -> Ast_414.Parsetree.structure_item = - fun - { Ast_500.Parsetree.pstr_desc = pstr_desc; - Ast_500.Parsetree.pstr_loc = pstr_loc } - -> - { - Ast_414.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); - Ast_414.Parsetree.pstr_loc = (copy_location pstr_loc) - } -and copy_structure_item_desc : - Ast_500.Parsetree.structure_item_desc -> - Ast_414.Parsetree.structure_item_desc - = - function - | Ast_500.Parsetree.Pstr_eval (x0, x1) -> - Ast_414.Parsetree.Pstr_eval - ((copy_expression x0), (copy_attributes x1)) - | Ast_500.Parsetree.Pstr_value (x0, x1) -> - Ast_414.Parsetree.Pstr_value - ((copy_rec_flag x0), (List.map copy_value_binding x1)) - | Ast_500.Parsetree.Pstr_primitive x0 -> - Ast_414.Parsetree.Pstr_primitive (copy_value_description x0) - | Ast_500.Parsetree.Pstr_type (x0, x1) -> - Ast_414.Parsetree.Pstr_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_500.Parsetree.Pstr_typext x0 -> - Ast_414.Parsetree.Pstr_typext (copy_type_extension x0) - | Ast_500.Parsetree.Pstr_exception x0 -> - Ast_414.Parsetree.Pstr_exception (copy_type_exception x0) - | Ast_500.Parsetree.Pstr_module x0 -> - Ast_414.Parsetree.Pstr_module (copy_module_binding x0) - | Ast_500.Parsetree.Pstr_recmodule x0 -> - Ast_414.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) - | Ast_500.Parsetree.Pstr_modtype x0 -> - Ast_414.Parsetree.Pstr_modtype (copy_module_type_declaration x0) - | Ast_500.Parsetree.Pstr_open x0 -> - Ast_414.Parsetree.Pstr_open (copy_open_declaration x0) - | Ast_500.Parsetree.Pstr_class x0 -> - Ast_414.Parsetree.Pstr_class (List.map copy_class_declaration x0) - | Ast_500.Parsetree.Pstr_class_type x0 -> - Ast_414.Parsetree.Pstr_class_type - (List.map copy_class_type_declaration x0) - | Ast_500.Parsetree.Pstr_include x0 -> - Ast_414.Parsetree.Pstr_include (copy_include_declaration x0) - | Ast_500.Parsetree.Pstr_attribute x0 -> - Ast_414.Parsetree.Pstr_attribute (copy_attribute x0) - | Ast_500.Parsetree.Pstr_extension (x0, x1) -> - Ast_414.Parsetree.Pstr_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_include_declaration : - Ast_500.Parsetree.include_declaration -> - Ast_414.Parsetree.include_declaration - = fun x -> copy_include_infos copy_module_expr x -and copy_class_declaration : - Ast_500.Parsetree.class_declaration -> Ast_414.Parsetree.class_declaration - = fun x -> copy_class_infos copy_class_expr x -and copy_class_expr : - Ast_500.Parsetree.class_expr -> Ast_414.Parsetree.class_expr = - fun - { Ast_500.Parsetree.pcl_desc = pcl_desc; - Ast_500.Parsetree.pcl_loc = pcl_loc; - Ast_500.Parsetree.pcl_attributes = pcl_attributes } - -> - { - Ast_414.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); - Ast_414.Parsetree.pcl_loc = (copy_location pcl_loc); - Ast_414.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) - } -and copy_class_expr_desc : - Ast_500.Parsetree.class_expr_desc -> Ast_414.Parsetree.class_expr_desc = - function - | Ast_500.Parsetree.Pcl_constr (x0, x1) -> - Ast_414.Parsetree.Pcl_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_500.Parsetree.Pcl_structure x0 -> - Ast_414.Parsetree.Pcl_structure (copy_class_structure x0) - | Ast_500.Parsetree.Pcl_fun (x0, x1, x2, x3) -> - Ast_414.Parsetree.Pcl_fun - ((copy_arg_label x0), (Option.map copy_expression x1), - (copy_pattern x2), (copy_class_expr x3)) - | Ast_500.Parsetree.Pcl_apply (x0, x1) -> - Ast_414.Parsetree.Pcl_apply - ((copy_class_expr x0), - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_arg_label x0), (copy_expression x1))) x1)) - | Ast_500.Parsetree.Pcl_let (x0, x1, x2) -> - Ast_414.Parsetree.Pcl_let - ((copy_rec_flag x0), (List.map copy_value_binding x1), - (copy_class_expr x2)) - | Ast_500.Parsetree.Pcl_constraint (x0, x1) -> - Ast_414.Parsetree.Pcl_constraint - ((copy_class_expr x0), (copy_class_type x1)) - | Ast_500.Parsetree.Pcl_extension x0 -> - Ast_414.Parsetree.Pcl_extension (copy_extension x0) - | Ast_500.Parsetree.Pcl_open (x0, x1) -> - Ast_414.Parsetree.Pcl_open - ((copy_open_description x0), (copy_class_expr x1)) -and copy_class_structure : - Ast_500.Parsetree.class_structure -> Ast_414.Parsetree.class_structure = - fun - { Ast_500.Parsetree.pcstr_self = pcstr_self; - Ast_500.Parsetree.pcstr_fields = pcstr_fields } - -> - { - Ast_414.Parsetree.pcstr_self = (copy_pattern pcstr_self); - Ast_414.Parsetree.pcstr_fields = - (List.map copy_class_field pcstr_fields) - } -and copy_class_field : - Ast_500.Parsetree.class_field -> Ast_414.Parsetree.class_field = - fun - { Ast_500.Parsetree.pcf_desc = pcf_desc; - Ast_500.Parsetree.pcf_loc = pcf_loc; - Ast_500.Parsetree.pcf_attributes = pcf_attributes } - -> - { - Ast_414.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); - Ast_414.Parsetree.pcf_loc = (copy_location pcf_loc); - Ast_414.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) - } -and copy_class_field_desc : - Ast_500.Parsetree.class_field_desc -> Ast_414.Parsetree.class_field_desc = - function - | Ast_500.Parsetree.Pcf_inherit (x0, x1, x2) -> - Ast_414.Parsetree.Pcf_inherit - ((copy_override_flag x0), (copy_class_expr x1), - (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) - | Ast_500.Parsetree.Pcf_val x0 -> - Ast_414.Parsetree.Pcf_val - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_class_field_kind x2))) - | Ast_500.Parsetree.Pcf_method x0 -> - Ast_414.Parsetree.Pcf_method - (let (x0, x1, x2) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_class_field_kind x2))) - | Ast_500.Parsetree.Pcf_constraint x0 -> - Ast_414.Parsetree.Pcf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_500.Parsetree.Pcf_initializer x0 -> - Ast_414.Parsetree.Pcf_initializer (copy_expression x0) - | Ast_500.Parsetree.Pcf_attribute x0 -> - Ast_414.Parsetree.Pcf_attribute (copy_attribute x0) - | Ast_500.Parsetree.Pcf_extension x0 -> - Ast_414.Parsetree.Pcf_extension (copy_extension x0) -and copy_class_field_kind : - Ast_500.Parsetree.class_field_kind -> Ast_414.Parsetree.class_field_kind = - function - | Ast_500.Parsetree.Cfk_virtual x0 -> - Ast_414.Parsetree.Cfk_virtual (copy_core_type x0) - | Ast_500.Parsetree.Cfk_concrete (x0, x1) -> - Ast_414.Parsetree.Cfk_concrete - ((copy_override_flag x0), (copy_expression x1)) -and copy_open_declaration : - Ast_500.Parsetree.open_declaration -> Ast_414.Parsetree.open_declaration = - fun x -> copy_open_infos copy_module_expr x -and copy_module_binding : - Ast_500.Parsetree.module_binding -> Ast_414.Parsetree.module_binding = - fun - { Ast_500.Parsetree.pmb_name = pmb_name; - Ast_500.Parsetree.pmb_expr = pmb_expr; - Ast_500.Parsetree.pmb_attributes = pmb_attributes; - Ast_500.Parsetree.pmb_loc = pmb_loc } - -> - { - Ast_414.Parsetree.pmb_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmb_name); - Ast_414.Parsetree.pmb_expr = (copy_module_expr pmb_expr); - Ast_414.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); - Ast_414.Parsetree.pmb_loc = (copy_location pmb_loc) - } -and copy_module_expr : - Ast_500.Parsetree.module_expr -> Ast_414.Parsetree.module_expr = - fun - { Ast_500.Parsetree.pmod_desc = pmod_desc; - Ast_500.Parsetree.pmod_loc = pmod_loc; - Ast_500.Parsetree.pmod_attributes = pmod_attributes } - -> - { - Ast_414.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); - Ast_414.Parsetree.pmod_loc = (copy_location pmod_loc); - Ast_414.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) - } -and copy_module_expr_desc : - Ast_500.Parsetree.module_expr_desc -> Ast_414.Parsetree.module_expr_desc = - function - | Ast_500.Parsetree.Pmod_ident x0 -> - Ast_414.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) - | Ast_500.Parsetree.Pmod_structure x0 -> - Ast_414.Parsetree.Pmod_structure (copy_structure x0) - | Ast_500.Parsetree.Pmod_functor (x0, x1) -> - Ast_414.Parsetree.Pmod_functor - ((copy_functor_parameter x0), (copy_module_expr x1)) - | Ast_500.Parsetree.Pmod_apply (x0, x1) -> - Ast_414.Parsetree.Pmod_apply - ((copy_module_expr x0), (copy_module_expr x1)) - | Ast_500.Parsetree.Pmod_constraint (x0, x1) -> - Ast_414.Parsetree.Pmod_constraint - ((copy_module_expr x0), (copy_module_type x1)) - | Ast_500.Parsetree.Pmod_unpack x0 -> - Ast_414.Parsetree.Pmod_unpack (copy_expression x0) - | Ast_500.Parsetree.Pmod_extension x0 -> - Ast_414.Parsetree.Pmod_extension (copy_extension x0) -and copy_functor_parameter : - Ast_500.Parsetree.functor_parameter -> Ast_414.Parsetree.functor_parameter - = - function - | Ast_500.Parsetree.Unit -> Ast_414.Parsetree.Unit - | Ast_500.Parsetree.Named (x0, x1) -> - Ast_414.Parsetree.Named - ((copy_loc (fun x -> Option.map (fun x -> x) x) x0), - (copy_module_type x1)) -and copy_module_type : - Ast_500.Parsetree.module_type -> Ast_414.Parsetree.module_type = - fun - { Ast_500.Parsetree.pmty_desc = pmty_desc; - Ast_500.Parsetree.pmty_loc = pmty_loc; - Ast_500.Parsetree.pmty_attributes = pmty_attributes } - -> - { - Ast_414.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); - Ast_414.Parsetree.pmty_loc = (copy_location pmty_loc); - Ast_414.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) - } -and copy_module_type_desc : - Ast_500.Parsetree.module_type_desc -> Ast_414.Parsetree.module_type_desc = - function - | Ast_500.Parsetree.Pmty_ident x0 -> - Ast_414.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) - | Ast_500.Parsetree.Pmty_signature x0 -> - Ast_414.Parsetree.Pmty_signature (copy_signature x0) - | Ast_500.Parsetree.Pmty_functor (x0, x1) -> - Ast_414.Parsetree.Pmty_functor - ((copy_functor_parameter x0), (copy_module_type x1)) - | Ast_500.Parsetree.Pmty_with (x0, x1) -> - Ast_414.Parsetree.Pmty_with - ((copy_module_type x0), (List.map copy_with_constraint x1)) - | Ast_500.Parsetree.Pmty_typeof x0 -> - Ast_414.Parsetree.Pmty_typeof (copy_module_expr x0) - | Ast_500.Parsetree.Pmty_extension x0 -> - Ast_414.Parsetree.Pmty_extension (copy_extension x0) - | Ast_500.Parsetree.Pmty_alias x0 -> - Ast_414.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) -and copy_with_constraint : - Ast_500.Parsetree.with_constraint -> Ast_414.Parsetree.with_constraint = - function - | Ast_500.Parsetree.Pwith_type (x0, x1) -> - Ast_414.Parsetree.Pwith_type - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_500.Parsetree.Pwith_module (x0, x1) -> - Ast_414.Parsetree.Pwith_module - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) - | Ast_500.Parsetree.Pwith_modtype (x0, x1) -> - Ast_414.Parsetree.Pwith_modtype - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_500.Parsetree.Pwith_modtypesubst (x0, x1) -> - Ast_414.Parsetree.Pwith_modtypesubst - ((copy_loc copy_Longident_t x0), (copy_module_type x1)) - | Ast_500.Parsetree.Pwith_typesubst (x0, x1) -> - Ast_414.Parsetree.Pwith_typesubst - ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) - | Ast_500.Parsetree.Pwith_modsubst (x0, x1) -> - Ast_414.Parsetree.Pwith_modsubst - ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) -and copy_signature : - Ast_500.Parsetree.signature -> Ast_414.Parsetree.signature = - fun x -> List.map copy_signature_item x -and copy_signature_item : - Ast_500.Parsetree.signature_item -> Ast_414.Parsetree.signature_item = - fun - { Ast_500.Parsetree.psig_desc = psig_desc; - Ast_500.Parsetree.psig_loc = psig_loc } - -> - { - Ast_414.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); - Ast_414.Parsetree.psig_loc = (copy_location psig_loc) - } -and copy_signature_item_desc : - Ast_500.Parsetree.signature_item_desc -> - Ast_414.Parsetree.signature_item_desc - = - function - | Ast_500.Parsetree.Psig_value x0 -> - Ast_414.Parsetree.Psig_value (copy_value_description x0) - | Ast_500.Parsetree.Psig_type (x0, x1) -> - Ast_414.Parsetree.Psig_type - ((copy_rec_flag x0), (List.map copy_type_declaration x1)) - | Ast_500.Parsetree.Psig_typesubst x0 -> - Ast_414.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) - | Ast_500.Parsetree.Psig_typext x0 -> - Ast_414.Parsetree.Psig_typext (copy_type_extension x0) - | Ast_500.Parsetree.Psig_exception x0 -> - Ast_414.Parsetree.Psig_exception (copy_type_exception x0) - | Ast_500.Parsetree.Psig_module x0 -> - Ast_414.Parsetree.Psig_module (copy_module_declaration x0) - | Ast_500.Parsetree.Psig_modsubst x0 -> - Ast_414.Parsetree.Psig_modsubst (copy_module_substitution x0) - | Ast_500.Parsetree.Psig_recmodule x0 -> - Ast_414.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) - | Ast_500.Parsetree.Psig_modtype x0 -> - Ast_414.Parsetree.Psig_modtype (copy_module_type_declaration x0) - | Ast_500.Parsetree.Psig_modtypesubst x0 -> - Ast_414.Parsetree.Psig_modtypesubst (copy_module_type_declaration x0) - | Ast_500.Parsetree.Psig_open x0 -> - Ast_414.Parsetree.Psig_open (copy_open_description x0) - | Ast_500.Parsetree.Psig_include x0 -> - Ast_414.Parsetree.Psig_include (copy_include_description x0) - | Ast_500.Parsetree.Psig_class x0 -> - Ast_414.Parsetree.Psig_class (List.map copy_class_description x0) - | Ast_500.Parsetree.Psig_class_type x0 -> - Ast_414.Parsetree.Psig_class_type - (List.map copy_class_type_declaration x0) - | Ast_500.Parsetree.Psig_attribute x0 -> - Ast_414.Parsetree.Psig_attribute (copy_attribute x0) - | Ast_500.Parsetree.Psig_extension (x0, x1) -> - Ast_414.Parsetree.Psig_extension - ((copy_extension x0), (copy_attributes x1)) -and copy_class_type_declaration : - Ast_500.Parsetree.class_type_declaration -> - Ast_414.Parsetree.class_type_declaration - = fun x -> copy_class_infos copy_class_type x -and copy_class_description : - Ast_500.Parsetree.class_description -> Ast_414.Parsetree.class_description - = fun x -> copy_class_infos copy_class_type x -and copy_class_type : - Ast_500.Parsetree.class_type -> Ast_414.Parsetree.class_type = - fun - { Ast_500.Parsetree.pcty_desc = pcty_desc; - Ast_500.Parsetree.pcty_loc = pcty_loc; - Ast_500.Parsetree.pcty_attributes = pcty_attributes } - -> - { - Ast_414.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); - Ast_414.Parsetree.pcty_loc = (copy_location pcty_loc); - Ast_414.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) - } -and copy_class_type_desc : - Ast_500.Parsetree.class_type_desc -> Ast_414.Parsetree.class_type_desc = - function - | Ast_500.Parsetree.Pcty_constr (x0, x1) -> - Ast_414.Parsetree.Pcty_constr - ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) - | Ast_500.Parsetree.Pcty_signature x0 -> - Ast_414.Parsetree.Pcty_signature (copy_class_signature x0) - | Ast_500.Parsetree.Pcty_arrow (x0, x1, x2) -> - Ast_414.Parsetree.Pcty_arrow - ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) - | Ast_500.Parsetree.Pcty_extension x0 -> - Ast_414.Parsetree.Pcty_extension (copy_extension x0) - | Ast_500.Parsetree.Pcty_open (x0, x1) -> - Ast_414.Parsetree.Pcty_open - ((copy_open_description x0), (copy_class_type x1)) -and copy_class_signature : - Ast_500.Parsetree.class_signature -> Ast_414.Parsetree.class_signature = - fun - { Ast_500.Parsetree.pcsig_self = pcsig_self; - Ast_500.Parsetree.pcsig_fields = pcsig_fields } - -> - { - Ast_414.Parsetree.pcsig_self = (copy_core_type pcsig_self); - Ast_414.Parsetree.pcsig_fields = - (List.map copy_class_type_field pcsig_fields) - } -and copy_class_type_field : - Ast_500.Parsetree.class_type_field -> Ast_414.Parsetree.class_type_field = - fun - { Ast_500.Parsetree.pctf_desc = pctf_desc; - Ast_500.Parsetree.pctf_loc = pctf_loc; - Ast_500.Parsetree.pctf_attributes = pctf_attributes } - -> - { - Ast_414.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); - Ast_414.Parsetree.pctf_loc = (copy_location pctf_loc); - Ast_414.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) - } -and copy_class_type_field_desc : - Ast_500.Parsetree.class_type_field_desc -> - Ast_414.Parsetree.class_type_field_desc - = - function - | Ast_500.Parsetree.Pctf_inherit x0 -> - Ast_414.Parsetree.Pctf_inherit (copy_class_type x0) - | Ast_500.Parsetree.Pctf_val x0 -> - Ast_414.Parsetree.Pctf_val - (let (x0, x1, x2, x3) = x0 in - ((copy_loc copy_label x0), (copy_mutable_flag x1), - (copy_virtual_flag x2), (copy_core_type x3))) - | Ast_500.Parsetree.Pctf_method x0 -> - Ast_414.Parsetree.Pctf_method - (let (x0, x1, x2, x3) = x0 in - ((copy_loc copy_label x0), (copy_private_flag x1), - (copy_virtual_flag x2), (copy_core_type x3))) - | Ast_500.Parsetree.Pctf_constraint x0 -> - Ast_414.Parsetree.Pctf_constraint - (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) - | Ast_500.Parsetree.Pctf_attribute x0 -> - Ast_414.Parsetree.Pctf_attribute (copy_attribute x0) - | Ast_500.Parsetree.Pctf_extension x0 -> - Ast_414.Parsetree.Pctf_extension (copy_extension x0) -and copy_extension : - Ast_500.Parsetree.extension -> Ast_414.Parsetree.extension = - fun x -> - let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) -and copy_class_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_500.Parsetree.class_infos -> 'g0 Ast_414.Parsetree.class_infos - = - fun f0 -> - fun - { Ast_500.Parsetree.pci_virt = pci_virt; - Ast_500.Parsetree.pci_params = pci_params; - Ast_500.Parsetree.pci_name = pci_name; - Ast_500.Parsetree.pci_expr = pci_expr; - Ast_500.Parsetree.pci_loc = pci_loc; - Ast_500.Parsetree.pci_attributes = pci_attributes } - -> - { - Ast_414.Parsetree.pci_virt = (copy_virtual_flag pci_virt); - Ast_414.Parsetree.pci_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) pci_params); - Ast_414.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); - Ast_414.Parsetree.pci_expr = (f0 pci_expr); - Ast_414.Parsetree.pci_loc = (copy_location pci_loc); - Ast_414.Parsetree.pci_attributes = (copy_attributes pci_attributes) - } -and copy_virtual_flag : - Ast_500.Asttypes.virtual_flag -> Ast_414.Asttypes.virtual_flag = - function - | Ast_500.Asttypes.Virtual -> Ast_414.Asttypes.Virtual - | Ast_500.Asttypes.Concrete -> Ast_414.Asttypes.Concrete -and copy_include_description : - Ast_500.Parsetree.include_description -> - Ast_414.Parsetree.include_description - = fun x -> copy_include_infos copy_module_type x -and copy_include_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_500.Parsetree.include_infos -> - 'g0 Ast_414.Parsetree.include_infos - = - fun f0 -> - fun - { Ast_500.Parsetree.pincl_mod = pincl_mod; - Ast_500.Parsetree.pincl_loc = pincl_loc; - Ast_500.Parsetree.pincl_attributes = pincl_attributes } - -> - { - Ast_414.Parsetree.pincl_mod = (f0 pincl_mod); - Ast_414.Parsetree.pincl_loc = (copy_location pincl_loc); - Ast_414.Parsetree.pincl_attributes = - (copy_attributes pincl_attributes) - } -and copy_open_description : - Ast_500.Parsetree.open_description -> Ast_414.Parsetree.open_description = - fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x -and copy_open_infos : - 'f0 'g0 . - ('f0 -> 'g0) -> - 'f0 Ast_500.Parsetree.open_infos -> 'g0 Ast_414.Parsetree.open_infos - = - fun f0 -> - fun - { Ast_500.Parsetree.popen_expr = popen_expr; - Ast_500.Parsetree.popen_override = popen_override; - Ast_500.Parsetree.popen_loc = popen_loc; - Ast_500.Parsetree.popen_attributes = popen_attributes } - -> - { - Ast_414.Parsetree.popen_expr = (f0 popen_expr); - Ast_414.Parsetree.popen_override = - (copy_override_flag popen_override); - Ast_414.Parsetree.popen_loc = (copy_location popen_loc); - Ast_414.Parsetree.popen_attributes = - (copy_attributes popen_attributes) - } -and copy_override_flag : - Ast_500.Asttypes.override_flag -> Ast_414.Asttypes.override_flag = - function - | Ast_500.Asttypes.Override -> Ast_414.Asttypes.Override - | Ast_500.Asttypes.Fresh -> Ast_414.Asttypes.Fresh -and copy_module_type_declaration : - Ast_500.Parsetree.module_type_declaration -> - Ast_414.Parsetree.module_type_declaration - = - fun - { Ast_500.Parsetree.pmtd_name = pmtd_name; - Ast_500.Parsetree.pmtd_type = pmtd_type; - Ast_500.Parsetree.pmtd_attributes = pmtd_attributes; - Ast_500.Parsetree.pmtd_loc = pmtd_loc } - -> - { - Ast_414.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); - Ast_414.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); - Ast_414.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); - Ast_414.Parsetree.pmtd_loc = (copy_location pmtd_loc) - } -and copy_module_substitution : - Ast_500.Parsetree.module_substitution -> - Ast_414.Parsetree.module_substitution - = - fun - { Ast_500.Parsetree.pms_name = pms_name; - Ast_500.Parsetree.pms_manifest = pms_manifest; - Ast_500.Parsetree.pms_attributes = pms_attributes; - Ast_500.Parsetree.pms_loc = pms_loc } - -> - { - Ast_414.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); - Ast_414.Parsetree.pms_manifest = - (copy_loc copy_Longident_t pms_manifest); - Ast_414.Parsetree.pms_attributes = (copy_attributes pms_attributes); - Ast_414.Parsetree.pms_loc = (copy_location pms_loc) - } -and copy_module_declaration : - Ast_500.Parsetree.module_declaration -> - Ast_414.Parsetree.module_declaration - = - fun - { Ast_500.Parsetree.pmd_name = pmd_name; - Ast_500.Parsetree.pmd_type = pmd_type; - Ast_500.Parsetree.pmd_attributes = pmd_attributes; - Ast_500.Parsetree.pmd_loc = pmd_loc } - -> - { - Ast_414.Parsetree.pmd_name = - (copy_loc (fun x -> Option.map (fun x -> x) x) pmd_name); - Ast_414.Parsetree.pmd_type = (copy_module_type pmd_type); - Ast_414.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); - Ast_414.Parsetree.pmd_loc = (copy_location pmd_loc) - } -and copy_type_exception : - Ast_500.Parsetree.type_exception -> Ast_414.Parsetree.type_exception = - fun - { Ast_500.Parsetree.ptyexn_constructor = ptyexn_constructor; - Ast_500.Parsetree.ptyexn_loc = ptyexn_loc; - Ast_500.Parsetree.ptyexn_attributes = ptyexn_attributes } - -> - { - Ast_414.Parsetree.ptyexn_constructor = - (copy_extension_constructor ptyexn_constructor); - Ast_414.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); - Ast_414.Parsetree.ptyexn_attributes = - (copy_attributes ptyexn_attributes) - } -and copy_type_extension : - Ast_500.Parsetree.type_extension -> Ast_414.Parsetree.type_extension = - fun - { Ast_500.Parsetree.ptyext_path = ptyext_path; - Ast_500.Parsetree.ptyext_params = ptyext_params; - Ast_500.Parsetree.ptyext_constructors = ptyext_constructors; - Ast_500.Parsetree.ptyext_private = ptyext_private; - Ast_500.Parsetree.ptyext_loc = ptyext_loc; - Ast_500.Parsetree.ptyext_attributes = ptyext_attributes } - -> - { - Ast_414.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); - Ast_414.Parsetree.ptyext_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptyext_params); - Ast_414.Parsetree.ptyext_constructors = - (List.map copy_extension_constructor ptyext_constructors); - Ast_414.Parsetree.ptyext_private = (copy_private_flag ptyext_private); - Ast_414.Parsetree.ptyext_loc = (copy_location ptyext_loc); - Ast_414.Parsetree.ptyext_attributes = - (copy_attributes ptyext_attributes) - } -and copy_extension_constructor : - Ast_500.Parsetree.extension_constructor -> - Ast_414.Parsetree.extension_constructor - = - fun - { Ast_500.Parsetree.pext_name = pext_name; - Ast_500.Parsetree.pext_kind = pext_kind; - Ast_500.Parsetree.pext_loc = pext_loc; - Ast_500.Parsetree.pext_attributes = pext_attributes } - -> - { - Ast_414.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); - Ast_414.Parsetree.pext_kind = - (copy_extension_constructor_kind pext_kind); - Ast_414.Parsetree.pext_loc = (copy_location pext_loc); - Ast_414.Parsetree.pext_attributes = (copy_attributes pext_attributes) - } -and copy_extension_constructor_kind : - Ast_500.Parsetree.extension_constructor_kind -> - Ast_414.Parsetree.extension_constructor_kind - = - function - | Ast_500.Parsetree.Pext_decl (x0, x1, x2) -> - Ast_414.Parsetree.Pext_decl - ((List.map (fun x -> copy_loc (fun x -> x) x) x0), - (copy_constructor_arguments x1), (Option.map copy_core_type x2)) - | Ast_500.Parsetree.Pext_rebind x0 -> - Ast_414.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) -and copy_type_declaration : - Ast_500.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration = - fun - { Ast_500.Parsetree.ptype_name = ptype_name; - Ast_500.Parsetree.ptype_params = ptype_params; - Ast_500.Parsetree.ptype_cstrs = ptype_cstrs; - Ast_500.Parsetree.ptype_kind = ptype_kind; - Ast_500.Parsetree.ptype_private = ptype_private; - Ast_500.Parsetree.ptype_manifest = ptype_manifest; - Ast_500.Parsetree.ptype_attributes = ptype_attributes; - Ast_500.Parsetree.ptype_loc = ptype_loc } - -> - { - Ast_414.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); - Ast_414.Parsetree.ptype_params = - (List.map - (fun x -> - let (x0, x1) = x in - ((copy_core_type x0), - (let (x0, x1) = x1 in - ((copy_variance x0), (copy_injectivity x1))))) ptype_params); - Ast_414.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_414.Parsetree.ptype_kind = (copy_type_kind ptype_kind); - Ast_414.Parsetree.ptype_private = (copy_private_flag ptype_private); - Ast_414.Parsetree.ptype_manifest = - (Option.map copy_core_type ptype_manifest); - Ast_414.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); - Ast_414.Parsetree.ptype_loc = (copy_location ptype_loc) - } -and copy_private_flag : - Ast_500.Asttypes.private_flag -> Ast_414.Asttypes.private_flag = - function - | Ast_500.Asttypes.Private -> Ast_414.Asttypes.Private - | Ast_500.Asttypes.Public -> Ast_414.Asttypes.Public -and copy_type_kind : - Ast_500.Parsetree.type_kind -> Ast_414.Parsetree.type_kind = - function - | Ast_500.Parsetree.Ptype_abstract -> Ast_414.Parsetree.Ptype_abstract - | Ast_500.Parsetree.Ptype_variant x0 -> - Ast_414.Parsetree.Ptype_variant - (List.map copy_constructor_declaration x0) - | Ast_500.Parsetree.Ptype_record x0 -> - Ast_414.Parsetree.Ptype_record (List.map copy_label_declaration x0) - | Ast_500.Parsetree.Ptype_open -> Ast_414.Parsetree.Ptype_open -and copy_constructor_declaration : - Ast_500.Parsetree.constructor_declaration -> - Ast_414.Parsetree.constructor_declaration - = - fun - { Ast_500.Parsetree.pcd_name = pcd_name; - Ast_500.Parsetree.pcd_vars = pcd_vars; - Ast_500.Parsetree.pcd_args = pcd_args; - Ast_500.Parsetree.pcd_res = pcd_res; - Ast_500.Parsetree.pcd_loc = pcd_loc; - Ast_500.Parsetree.pcd_attributes = pcd_attributes } - -> - { - Ast_414.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); - Ast_414.Parsetree.pcd_vars = - (List.map (fun x -> copy_loc (fun x -> x) x) pcd_vars); - Ast_414.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); - Ast_414.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); - Ast_414.Parsetree.pcd_loc = (copy_location pcd_loc); - Ast_414.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) - } -and copy_constructor_arguments : - Ast_500.Parsetree.constructor_arguments -> - Ast_414.Parsetree.constructor_arguments - = - function - | Ast_500.Parsetree.Pcstr_tuple x0 -> - Ast_414.Parsetree.Pcstr_tuple (List.map copy_core_type x0) - | Ast_500.Parsetree.Pcstr_record x0 -> - Ast_414.Parsetree.Pcstr_record (List.map copy_label_declaration x0) -and copy_label_declaration : - Ast_500.Parsetree.label_declaration -> Ast_414.Parsetree.label_declaration - = - fun - { Ast_500.Parsetree.pld_name = pld_name; - Ast_500.Parsetree.pld_mutable = pld_mutable; - Ast_500.Parsetree.pld_type = pld_type; - Ast_500.Parsetree.pld_loc = pld_loc; - Ast_500.Parsetree.pld_attributes = pld_attributes } - -> - { - Ast_414.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); - Ast_414.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); - Ast_414.Parsetree.pld_type = (copy_core_type pld_type); - Ast_414.Parsetree.pld_loc = (copy_location pld_loc); - Ast_414.Parsetree.pld_attributes = (copy_attributes pld_attributes) - } -and copy_mutable_flag : - Ast_500.Asttypes.mutable_flag -> Ast_414.Asttypes.mutable_flag = - function - | Ast_500.Asttypes.Immutable -> Ast_414.Asttypes.Immutable - | Ast_500.Asttypes.Mutable -> Ast_414.Asttypes.Mutable -and copy_injectivity : - Ast_500.Asttypes.injectivity -> Ast_414.Asttypes.injectivity = - function - | Ast_500.Asttypes.Injective -> Ast_414.Asttypes.Injective - | Ast_500.Asttypes.NoInjectivity -> Ast_414.Asttypes.NoInjectivity -and copy_variance : Ast_500.Asttypes.variance -> Ast_414.Asttypes.variance = - function - | Ast_500.Asttypes.Covariant -> Ast_414.Asttypes.Covariant - | Ast_500.Asttypes.Contravariant -> Ast_414.Asttypes.Contravariant - | Ast_500.Asttypes.NoVariance -> Ast_414.Asttypes.NoVariance -and copy_value_description : - Ast_500.Parsetree.value_description -> Ast_414.Parsetree.value_description - = - fun - { Ast_500.Parsetree.pval_name = pval_name; - Ast_500.Parsetree.pval_type = pval_type; - Ast_500.Parsetree.pval_prim = pval_prim; - Ast_500.Parsetree.pval_attributes = pval_attributes; - Ast_500.Parsetree.pval_loc = pval_loc } - -> - { - Ast_414.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); - Ast_414.Parsetree.pval_type = (copy_core_type pval_type); - Ast_414.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); - Ast_414.Parsetree.pval_attributes = (copy_attributes pval_attributes); - Ast_414.Parsetree.pval_loc = (copy_location pval_loc) - } -and copy_object_field_desc : - Ast_500.Parsetree.object_field_desc -> Ast_414.Parsetree.object_field_desc - = - function - | Ast_500.Parsetree.Otag (x0, x1) -> - Ast_414.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) - | Ast_500.Parsetree.Oinherit x0 -> - Ast_414.Parsetree.Oinherit (copy_core_type x0) -and copy_arg_label : Ast_500.Asttypes.arg_label -> Ast_414.Asttypes.arg_label - = - function - | Ast_500.Asttypes.Nolabel -> Ast_414.Asttypes.Nolabel - | Ast_500.Asttypes.Labelled x0 -> Ast_414.Asttypes.Labelled x0 - | Ast_500.Asttypes.Optional x0 -> Ast_414.Asttypes.Optional x0 -and copy_closed_flag : - Ast_500.Asttypes.closed_flag -> Ast_414.Asttypes.closed_flag = - function - | Ast_500.Asttypes.Closed -> Ast_414.Asttypes.Closed - | Ast_500.Asttypes.Open -> Ast_414.Asttypes.Open -and copy_label : Ast_500.Asttypes.label -> Ast_414.Asttypes.label = - fun x -> x -and copy_rec_flag : Ast_500.Asttypes.rec_flag -> Ast_414.Asttypes.rec_flag = - function - | Ast_500.Asttypes.Nonrecursive -> Ast_414.Asttypes.Nonrecursive - | Ast_500.Asttypes.Recursive -> Ast_414.Asttypes.Recursive -and copy_constant : Ast_500.Parsetree.constant -> Ast_414.Parsetree.constant - = - function - | Ast_500.Parsetree.Pconst_integer (x0, x1) -> - Ast_414.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) - | Ast_500.Parsetree.Pconst_char x0 -> Ast_414.Parsetree.Pconst_char x0 - | Ast_500.Parsetree.Pconst_string (x0, x1, x2) -> - Ast_414.Parsetree.Pconst_string - (x0, (copy_location x1), (Option.map (fun x -> x) x2)) - | Ast_500.Parsetree.Pconst_float (x0, x1) -> - Ast_414.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) -and copy_Longident_t : Longident.t -> Longident.t = - function - | Longident.Lident x0 -> Longident.Lident x0 - | Longident.Ldot (x0, x1) -> Longident.Ldot ((copy_Longident_t x0), x1) - | Longident.Lapply (x0, x1) -> - Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) -and copy_loc : - 'f0 'g0 . - ('f0 -> 'g0) -> 'f0 Ast_500.Asttypes.loc -> 'g0 Ast_414.Asttypes.loc - = - fun f0 -> - fun { Ast_500.Asttypes.txt = txt; Ast_500.Asttypes.loc = loc } -> - { - Ast_414.Asttypes.txt = (f0 txt); - Ast_414.Asttypes.loc = (copy_location loc) - } -and copy_location : Location.t -> Location.t = - fun - { Location.loc_start = loc_start; Location.loc_end = loc_end; - Location.loc_ghost = loc_ghost } - -> - { - Location.loc_start = (copy_position loc_start); - Location.loc_end = (copy_position loc_end); - 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-omp/src/migrate_parsetree_ast_io.ml b/src/vendored-omp/src/migrate_parsetree_ast_io.ml deleted file mode 100644 index 6d6d529d0..000000000 --- a/src/vendored-omp/src/migrate_parsetree_ast_io.ml +++ /dev/null @@ -1,101 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -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-omp/src/migrate_parsetree_ast_io.mli b/src/vendored-omp/src/migrate_parsetree_ast_io.mli deleted file mode 100644 index 41ab59ef8..000000000 --- a/src/vendored-omp/src/migrate_parsetree_ast_io.mli +++ /dev/null @@ -1,49 +0,0 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(** 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-omp/src/migrate_parsetree_driver.ml b/src/vendored-omp/src/migrate_parsetree_driver.ml deleted file mode 100644 index 5d1ed626a..000000000 --- a/src/vendored-omp/src/migrate_parsetree_driver.ml +++ /dev/null @@ -1,599 +0,0 @@ -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-omp/src/migrate_parsetree_driver.mli b/src/vendored-omp/src/migrate_parsetree_driver.mli deleted file mode 100644 index 11a0bebfa..000000000 --- a/src/vendored-omp/src/migrate_parsetree_driver.mli +++ /dev/null @@ -1,113 +0,0 @@ -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-omp/src/migrate_parsetree_parse.ml b/src/vendored-omp/src/migrate_parsetree_parse.ml deleted file mode 100644 index e2aef0d27..000000000 --- a/src/vendored-omp/src/migrate_parsetree_parse.ml +++ /dev/null @@ -1,53 +0,0 @@ - -(**************************************************************************) -(* *) -(* 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-omp/src/migrate_parsetree_parse.mli b/src/vendored-omp/src/migrate_parsetree_parse.mli deleted file mode 100644 index 7d0ad48ad..000000000 --- a/src/vendored-omp/src/migrate_parsetree_parse.mli +++ /dev/null @@ -1,32 +0,0 @@ -(**************************************************************************) -(* *) -(* 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-omp/src/migrate_parsetree_versions.ml b/src/vendored-omp/src/migrate_parsetree_versions.ml index 36743eadc..239f033b9 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.ml +++ b/src/vendored-omp/src/migrate_parsetree_versions.ml @@ -35,18 +35,6 @@ module type Ast = sig 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 @@ -56,21 +44,7 @@ module type Ast = sig 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 *) @@ -78,16 +52,6 @@ end 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 : _; @@ -95,7 +59,6 @@ type 'a _types = 'a constraint 'a out_sig_item : _; out_type_extension : _; out_phrase : _; - mapper : _; (*$*) > ;; @@ -104,26 +67,6 @@ type 'a _types = 'a constraint 'a 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 = @@ -138,8 +81,6 @@ 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 @@ -148,16 +89,6 @@ module type OCaml_version = sig 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; @@ -165,7 +96,6 @@ module type OCaml_version = sig 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 @@ -176,16 +106,6 @@ 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; @@ -193,7 +113,6 @@ struct 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 @@ -206,24 +125,13 @@ type 'types 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 + with 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 (*$*) ) @@ -234,16 +142,6 @@ type ('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) @@ -251,20 +149,9 @@ let compare_ocaml_version (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; @@ -272,21 +159,10 @@ let compare_ocaml_version 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; @@ -294,7 +170,6 @@ let compare_ocaml_version 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 @@ -308,16 +183,6 @@ let compare_ocaml_version 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; @@ -325,23 +190,12 @@ type ('from, 'to_) migration_functions = { 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; @@ -349,7 +203,6 @@ let migration_identity : ('a, 'a) migration_functions = { copy_out_sig_item = id; copy_out_type_extension = id; copy_out_phrase = id; - copy_mapper = id; (*$*) } @@ -357,16 +210,6 @@ 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; @@ -374,7 +217,6 @@ let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migrati 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; (*$*) } @@ -385,16 +227,6 @@ module type Migrate_module = sig 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 @@ -402,7 +234,6 @@ module type Migrate_module = sig 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 @@ -415,16 +246,6 @@ struct 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; @@ -432,7 +253,6 @@ struct copy_out_sig_item; copy_out_type_extension; copy_out_phrase; - copy_mapper; (*$*) } end @@ -467,16 +287,6 @@ type '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) @@ -484,20 +294,9 @@ let immediate_migration (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; @@ -505,7 +304,6 @@ let immediate_migration out_sig_item : out_sig_item; out_type_extension : out_type_extension; out_phrase : out_phrase; - mapper : mapper; (*$*) > ocaml_version) direction @@ -521,16 +319,6 @@ let immediate_migration 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) @@ -538,20 +326,9 @@ let migrate (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; @@ -559,21 +336,10 @@ let migrate 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; @@ -581,7 +347,6 @@ let migrate 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 @@ -607,16 +372,6 @@ let migrate 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; @@ -624,7 +379,6 @@ module Convert (A : OCaml_version) (B : OCaml_version) = struct copy_out_sig_item; copy_out_type_extension; copy_out_phrase; - copy_mapper; (*$*) } : (A.types, B.types) migration_functions = migrate (module A) (module B) @@ -798,4 +552,4 @@ 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 +let _f (x : Outcometree.out_type) : OCaml_current.Ast.Outcometree.out_type = x diff --git a/src/vendored-omp/src/migrate_parsetree_versions.mli b/src/vendored-omp/src/migrate_parsetree_versions.mli index b31f6888c..e7c5e105f 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.mli +++ b/src/vendored-omp/src/migrate_parsetree_versions.mli @@ -26,18 +26,6 @@ module type Ast = sig 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 @@ -47,21 +35,7 @@ module type Ast = sig 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 *) @@ -69,16 +43,6 @@ end 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 : _; @@ -86,7 +50,6 @@ type 'a _types = 'a constraint 'a out_sig_item : _; out_type_extension : _; out_phrase : _; - mapper : _; (*$*) > ;; @@ -95,16 +58,6 @@ type 'a _types = 'a constraint 'a 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; .. > @@ -112,7 +65,6 @@ 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; .. > ;; (*$*) @@ -140,16 +92,6 @@ module type OCaml_version = sig (** 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; @@ -157,7 +99,6 @@ module type OCaml_version = sig 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 @@ -175,24 +116,13 @@ type 'types 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 + with 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 (*$*) ) @@ -252,16 +182,6 @@ val compare_ocaml_version : 'a ocaml_version -> 'b ocaml_version -> ('a, 'b) typ 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; @@ -269,7 +189,6 @@ type ('from, 'to_) migration_functions = { 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; (*$*) } @@ -300,16 +219,6 @@ 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 @@ -317,6 +226,5 @@ module Convert (A : OCaml_version) (B : OCaml_version) : sig 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-omp/src/reason_omp.ml b/src/vendored-omp/src/reason_omp.ml index dac4f478b..c7e58d2e4 100644 --- a/src/vendored-omp/src/reason_omp.ml +++ b/src/vendored-omp/src/reason_omp.ml @@ -40,9 +40,6 @@ module Ast_414 = Ast_414 module Ast_500 = Ast_500 (*$*) -(* 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; @@ -106,12 +103,6 @@ module OCaml_current = Versions.OCaml_current 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 diff --git a/src/vendored-omp/tools/dune b/src/vendored-omp/tools/dune index af40a159e..8122ac6b4 100644 --- a/src/vendored-omp/tools/dune +++ b/src/vendored-omp/tools/dune @@ -3,11 +3,8 @@ (modules add_special_comments) (libraries compiler-libs.common compiler-libs.bytecomp) (flags :standard -w -3) - (enabled_if - (and - (>= %{ocaml_version} 4.13) - (< %{ocaml_version} 4.14)))) - + (enabled_if + (>= %{ocaml_version} 4.13))) (executables (names pp) @@ -21,8 +18,7 @@ (name gencopy) (enabled_if (and - (>= %{ocaml_version} 4.13) - (< %{ocaml_version} 4.14))) + (>= %{ocaml_version} 5.0))) (modules gencopy) (libraries compiler-libs.common compiler-libs.bytecomp) (flags :standard -w -3)) diff --git a/src/vendored-omp/tools/gencopy.ml b/src/vendored-omp/tools/gencopy.ml index f821c6d8e..4e2684722 100644 --- a/src/vendored-omp/tools/gencopy.ml +++ b/src/vendored-omp/tools/gencopy.ml @@ -82,7 +82,7 @@ module Main : sig end = struct (*************************************************************************) - let env = Env.initial_safe_string + let env = Env.initial let module_mapping = ref [] @@ -144,7 +144,7 @@ module Main : sig end = struct td.type_params in let env = - List.map2 (fun s t -> (t.id, evar s.txt)) params_in td.type_params + List.map2 (fun s t -> (Types.get_id t, evar s.txt)) params_in td.type_params in let make_result_t tyargs_in tyargs_out = Typ.( @@ -212,9 +212,9 @@ module Main : sig end = struct List.split (List.mapi arg tl) and tyexpr env ty x = - match ty.desc with + match Types.get_desc ty with | Tvar _ -> ( - match List.assoc ty.id env with + match List.assoc (Types.get_id ty) env with | f -> app f [ x ] | exception Not_found -> failwith "Existentials not supported" ) | Ttuple tl -> @@ -312,7 +312,7 @@ module Main : sig end = struct let usage = Printf.sprintf "%s [options] \n" Sys.argv.(0) let main () = - Load_path.init [ Config.standard_library ]; + Load_path.init ~auto_include:Compmisc.auto_include [ Config.standard_library ]; Arg.parse (Arg.align args) gen usage; let from_, to_ = match !module_mapping with @@ -341,3 +341,11 @@ module Main : sig end = struct Format.eprintf "%a@?" Errors.report_error exn; exit 1 end + +(* ../../_build/default/src/vendored-omp/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_403:Ast_402 Ast_403.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_403_402_migrate.ml *) +(* ../../_build/default/src/vendored-omp/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_402:Ast_403 Ast_402.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_402_403_migrate.ml *) + + +(* ../../_build/default/src/vendored-omp/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_500:Ast_414 Ast_500.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_500_414_migrate.ml *) +(* ../../_build/default/src/vendored-omp/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_414:Ast_500 Ast_414.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_414_500_migrate.ml *) + diff --git a/test/basics.t/run.t b/test/basics.t/run.t index df08f6c0b..14913bf7e 100644 --- a/test/basics.t/run.t +++ b/test/basics.t/run.t @@ -1,5 +1,6 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +$ cat formatted.re Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/lib/typedtreePrinter.cppo.ml b/test/lib/typedtreePrinter.cppo.ml index 00cc7ade4..233c2deb4 100644 --- a/test/lib/typedtreePrinter.cppo.ml +++ b/test/lib/typedtreePrinter.cppo.ml @@ -20,9 +20,9 @@ *) open Reason_omp +module Ast = Ast_414 -module Convert = Reason_omp.Convert (Reason_omp.OCaml_411) (Reason_omp.OCaml_current) -module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_411) +module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) let main () = let filename = "./TestTest.ml" in @@ -39,7 +39,7 @@ let main () = Env.set_unit_name modulename; let ast = impl lexbuf in - let ast = Convert.copy_structure ast in + let ast = Reason_toolchain.To_current.copy_structure ast in let env = Compmisc.initial_env() in #if OCAML_VERSION >= (4,13,0) let { Typedtree.structure = typedtree; _ } = @@ -48,7 +48,7 @@ let main () = #endif Typemod.type_implementation modulename modulename modulename env ast in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in - let phrase = (Ast_411.Outcometree.Ophr_signature + let phrase = (Ast.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) ) in let fmt = Format.str_formatter in From db01501bcdb28e27139f768789447cb6eca8b9fc Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 28 Apr 2023 03:01:05 -0700 Subject: [PATCH 02/64] feat: Support OCaml 5.1 (#2714) --- HISTORY.md | 6 +- flake.lock | 14 +- src/reason-parser/dune | 2 + src/reason-parser/ocaml_util.ml-5.1 | 11 + src/vendored-omp/README.md | 2 +- src/vendored-omp/src/ast_51.ml | 196 +++++++++++ src/vendored-omp/src/cinaps_helpers | 4 + src/vendored-omp/src/config/gen.ml | 1 + .../src/migrate_parsetree_500_51.ml | 17 + .../src/migrate_parsetree_500_51_migrate.ml | 332 ++++++++++++++++++ .../src/migrate_parsetree_51_500.ml | 16 + .../src/migrate_parsetree_51_500_migrate.ml | 332 ++++++++++++++++++ .../src/migrate_parsetree_versions.ml | 10 + .../src/migrate_parsetree_versions.mli | 2 + src/vendored-omp/src/reason_omp.ml | 4 + src/vendored-omp/tools/dune | 3 +- 16 files changed, 941 insertions(+), 11 deletions(-) create mode 100644 src/reason-parser/ocaml_util.ml-5.1 create mode 100644 src/vendored-omp/src/ast_51.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_500_51.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_500_51_migrate.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_51_500.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_51_500_migrate.ml diff --git a/HISTORY.md b/HISTORY.md index d5b055021..9ff8d51d2 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,13 +1,15 @@ ## 3.9 (unreleased) -- Reduce the amount of parentheses around functor usage. [#2683](https://github.com/reasonml/reason/pull/2683) -- Print module type body on separate line (@SanderSpies) [#2709](https://github.com/reasonml/reason/pull/2709) +- Reduce the amount of parentheses around functor usage (@SanderSpies, [#2683](https://github.com/reasonml/reason/pull/2683)) +- Print module type body on separate line (@SanderSpies, [#2709](https://github.com/reasonml/reason/pull/2709)) - Fix missing patterns around contraint pattern (a pattern with a type annotation). - Fix top level extension printing - Remove the dependency on the `result` package, which isn't needed for OCaml 4.03 and above (@anmonteiro) [#2703](https://github.com/reasonml/reason/pull/2703) - Fix the binary parser by converting to the internal AST version used by Reason (@anmonteiro) [#2713](https://github.com/reasonml/reason/pull/2713) +- Port Reason to `ppxlib` (@anmonteiro, [#2711](https://github.com/reasonml/reason/pull/2711)) +- Support OCaml 5.1 (@anmonteiro, [#2714](https://github.com/reasonml/reason/pull/2714)) ## 3.8.2 diff --git a/flake.lock b/flake.lock index 5b53b8411..031b284d5 100644 --- a/flake.lock +++ b/flake.lock @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1681761444, - "narHash": "sha256-FM2yAWrPnAITvMgRlgqNSpCh1ieKvLmd+pG144bp8Ks=", + "lastModified": 1682622444, + "narHash": "sha256-V9GsNIiDcwzQe7y7y1cIp5A0QK8SuG6CRUqV1hRYxDE=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "9859e425c67c121709f323a54fda2e4e456a3196", + "rev": "f05f850a4e7fb4ff3cb351339271c3cf7310695a", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1681713375, - "narHash": "sha256-UPDEwrzOQLTNzNDMkcf3J7+7vV3zlQCCrO33kwlFsdY=", + "lastModified": 1682556406, + "narHash": "sha256-8kLelu0INHMEJxyeehuFv1+FwKUy4fSaY1hh65rhsF4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "9a60b3eef1a0ccb4e3459eba1814bae91d07134e", + "rev": "af4cf4d6ae4a47fc9a8b58ea6238455a3acf0292", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "9a60b3eef1a0ccb4e3459eba1814bae91d07134e", + "rev": "af4cf4d6ae4a47fc9a8b58ea6238455a3acf0292", "type": "github" } }, diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 2bb29de80..97ff1fb12 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -7,6 +7,7 @@ (targets ocaml_util.ml) (deps ../generate/select.exe + ocaml_util.ml-5.1 ocaml_util.ml-5.0 ocaml_util.ml-5.00 ocaml_util.ml-4.14 @@ -24,6 +25,7 @@ %{targets} (run ../generate/select.exe + ocaml_util.ml-5.1 ocaml_util.ml-5.0 ocaml_util.ml-5.00 ocaml_util.ml-4.14 diff --git a/src/reason-parser/ocaml_util.ml-5.1 b/src/reason-parser/ocaml_util.ml-5.1 new file mode 100644 index 000000000..d46adf43f --- /dev/null +++ b/src/reason-parser/ocaml_util.ml-5.1 @@ -0,0 +1,11 @@ +let warn_latin1 lexbuf = + Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" +;; + +let print_loc ppf loc = + Location.print_loc ppf loc + + +let print_error loc f ppf x = + let error = Location.error_of_printer ~loc f x in + Location.print_report ppf error diff --git a/src/vendored-omp/README.md b/src/vendored-omp/README.md index d532a01e7..ed5bcd813 100644 --- a/src/vendored-omp/README.md +++ b/src/vendored-omp/README.md @@ -140,7 +140,7 @@ 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__`) +- Manually compile the asts (`ocamlc -c src/ast_{NEW,OLD}.ml -I +compiler-libs -I _build/default/src/vendored-omp/src/.reason_omp.objs/byte -open Reason_omp__`) - 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 diff --git a/src/vendored-omp/src/ast_51.ml b/src/vendored-omp/src/ast_51.ml new file mode 100644 index 000000000..61d8b91c4 --- /dev/null +++ b/src/vendored-omp/src/ast_51.ml @@ -0,0 +1,196 @@ +module Asttypes = struct + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * Location.t * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive + + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto + + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public + + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable + + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete + + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh + + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open + + type label = string + + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (** [label:T -> ...] *) + | Optional of string (** [?label:T -> ...] *) + + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; + } + + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity +end + +module 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_param = string * (Asttypes.variance * Asttypes.injectivity) + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of {non_gen:bool; aliased:out_type; alias:string} + | Otyp_arrow of string * out_type * out_type + | Otyp_class of out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of { fields: (string * out_type) list; open_row:bool} + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of out_constructor list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * (string * out_type) list + | Otyp_attribute of out_type * out_attribute + + and out_constructor (*IF_CURRENT = Outcometree.out_constructor *) = { + ocstr_name: string; + ocstr_args: out_type list; + ocstr_return_type: out_type option; + } + + 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 * out_type_param list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * out_type_param 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: out_type_param 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: out_constructor 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 diff --git a/src/vendored-omp/src/cinaps_helpers b/src/vendored-omp/src/cinaps_helpers index 1fffdc67a..0968e5401 100644 --- a/src/vendored-omp/src/cinaps_helpers +++ b/src/vendored-omp/src/cinaps_helpers @@ -17,6 +17,10 @@ let supported_versions = [ ("410", "4.10"); ("411", "4.11"); ("412", "4.12"); + ("413", "4.13"); + ("414", "4.14"); + ("5.0", "5.0"); + ("5.1", "5.1"); ] let qualified_types = [ diff --git a/src/vendored-omp/src/config/gen.ml b/src/vendored-omp/src/config/gen.ml index bf99e5e3d..f09d05fbc 100644 --- a/src/vendored-omp/src/config/gen.ml +++ b/src/vendored-omp/src/config/gen.ml @@ -24,6 +24,7 @@ let () = | (4, 13) -> "413" | (4, 14) -> "414" | (5, 0) -> "500" + | (5, 1) -> "51" | _ -> Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str; exit 1); diff --git a/src/vendored-omp/src/migrate_parsetree_500_51.ml b/src/vendored-omp/src/migrate_parsetree_500_51.ml new file mode 100644 index 000000000..f3cfd9036 --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_500_51.ml @@ -0,0 +1,17 @@ +(**************************************************************************) +(* *) +(* 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_500_51_migrate + diff --git a/src/vendored-omp/src/migrate_parsetree_500_51_migrate.ml b/src/vendored-omp/src/migrate_parsetree_500_51_migrate.ml new file mode 100644 index 000000000..bd1f02fba --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_500_51_migrate.ml @@ -0,0 +1,332 @@ +open Stdlib0 +module From = Ast_500 +module To = Ast_51 +let rec copy_out_type_extension : + Ast_500.Outcometree.out_type_extension -> + Ast_51.Outcometree.out_type_extension + = + fun + { Ast_500.Outcometree.otyext_name = otyext_name; + Ast_500.Outcometree.otyext_params = otyext_params; + Ast_500.Outcometree.otyext_constructors = otyext_constructors; + Ast_500.Outcometree.otyext_private = otyext_private } + -> + { + Ast_51.Outcometree.otyext_name = otyext_name; + Ast_51.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_51.Outcometree.otyext_constructors = + (List.map copy_out_constructor otyext_constructors); + Ast_51.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_500.Outcometree.out_phrase -> Ast_51.Outcometree.out_phrase = + function + | Ast_500.Outcometree.Ophr_eval (x0, x1) -> + Ast_51.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_500.Outcometree.Ophr_signature x0 -> + Ast_51.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_500.Outcometree.Ophr_exception x0 -> + Ast_51.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_500.Outcometree.out_sig_item -> Ast_51.Outcometree.out_sig_item = + function + | Ast_500.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_51.Outcometree.Osig_class + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_500.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_51.Outcometree.Osig_class_type + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_500.Outcometree.Osig_typext (x0, x1) -> + Ast_51.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_500.Outcometree.Osig_modtype (x0, x1) -> + Ast_51.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_500.Outcometree.Osig_module (x0, x1, x2) -> + Ast_51.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_500.Outcometree.Osig_type (x0, x1) -> + Ast_51.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_500.Outcometree.Osig_value x0 -> + Ast_51.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_500.Outcometree.Osig_ellipsis -> Ast_51.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_500.Outcometree.out_val_decl -> Ast_51.Outcometree.out_val_decl = + fun + { Ast_500.Outcometree.oval_name = oval_name; + Ast_500.Outcometree.oval_type = oval_type; + Ast_500.Outcometree.oval_prims = oval_prims; + Ast_500.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_51.Outcometree.oval_name = oval_name; + Ast_51.Outcometree.oval_type = (copy_out_type oval_type); + Ast_51.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_51.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_500.Outcometree.out_type_decl -> Ast_51.Outcometree.out_type_decl = + fun + { Ast_500.Outcometree.otype_name = otype_name; + Ast_500.Outcometree.otype_params = otype_params; + Ast_500.Outcometree.otype_type = otype_type; + Ast_500.Outcometree.otype_private = otype_private; + Ast_500.Outcometree.otype_immediate = otype_immediate; + Ast_500.Outcometree.otype_unboxed = otype_unboxed; + Ast_500.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_51.Outcometree.otype_name = otype_name; + Ast_51.Outcometree.otype_params = + (List.map copy_out_type_param otype_params); + Ast_51.Outcometree.otype_type = (copy_out_type otype_type); + Ast_51.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_51.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_51.Outcometree.otype_unboxed = otype_unboxed; + Ast_51.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_500.Type_immediacy.t -> Ast_51.Type_immediacy.t = + function + | Ast_500.Type_immediacy.Unknown -> Ast_51.Type_immediacy.Unknown + | Ast_500.Type_immediacy.Always -> Ast_51.Type_immediacy.Always + | Ast_500.Type_immediacy.Always_on_64bits -> + Ast_51.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_500.Outcometree.out_module_type -> Ast_51.Outcometree.out_module_type = + function + | Ast_500.Outcometree.Omty_abstract -> Ast_51.Outcometree.Omty_abstract + | Ast_500.Outcometree.Omty_functor (x0, x1) -> + Ast_51.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_500.Outcometree.Omty_ident x0 -> + Ast_51.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_500.Outcometree.Omty_signature x0 -> + Ast_51.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_500.Outcometree.Omty_alias x0 -> + Ast_51.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_500.Outcometree.out_ext_status -> Ast_51.Outcometree.out_ext_status = + function + | Ast_500.Outcometree.Oext_first -> Ast_51.Outcometree.Oext_first + | Ast_500.Outcometree.Oext_next -> Ast_51.Outcometree.Oext_next + | Ast_500.Outcometree.Oext_exception -> Ast_51.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_500.Outcometree.out_extension_constructor -> + Ast_51.Outcometree.out_extension_constructor + = + fun + { Ast_500.Outcometree.oext_name = oext_name; + Ast_500.Outcometree.oext_type_name = oext_type_name; + Ast_500.Outcometree.oext_type_params = oext_type_params; + Ast_500.Outcometree.oext_args = oext_args; + Ast_500.Outcometree.oext_ret_type = oext_ret_type; + Ast_500.Outcometree.oext_private = oext_private } + -> + { + Ast_51.Outcometree.oext_name = oext_name; + Ast_51.Outcometree.oext_type_name = oext_type_name; + Ast_51.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_51.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_51.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_51.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_private_flag : + Ast_500.Asttypes.private_flag -> Ast_51.Asttypes.private_flag = + function + | Ast_500.Asttypes.Private -> Ast_51.Asttypes.Private + | Ast_500.Asttypes.Public -> Ast_51.Asttypes.Public +and copy_out_rec_status : + Ast_500.Outcometree.out_rec_status -> Ast_51.Outcometree.out_rec_status = + function + | Ast_500.Outcometree.Orec_not -> Ast_51.Outcometree.Orec_not + | Ast_500.Outcometree.Orec_first -> Ast_51.Outcometree.Orec_first + | Ast_500.Outcometree.Orec_next -> Ast_51.Outcometree.Orec_next +and copy_out_class_type : + Ast_500.Outcometree.out_class_type -> Ast_51.Outcometree.out_class_type = + function + | Ast_500.Outcometree.Octy_constr (x0, x1) -> + Ast_51.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_500.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_51.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_500.Outcometree.Octy_signature (x0, x1) -> + Ast_51.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_500.Outcometree.out_class_sig_item -> + Ast_51.Outcometree.out_class_sig_item + = + function + | Ast_500.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_51.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_500.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_51.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_500.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_51.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type_param : + Ast_500.Outcometree.out_type_param -> Ast_51.Outcometree.out_type_param = + fun x -> + let (x0, x1) = x in + (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_500.Asttypes.injectivity -> Ast_51.Asttypes.injectivity = + function + | Ast_500.Asttypes.Injective -> Ast_51.Asttypes.Injective + | Ast_500.Asttypes.NoInjectivity -> Ast_51.Asttypes.NoInjectivity +and copy_variance : Ast_500.Asttypes.variance -> Ast_51.Asttypes.variance = + function + | Ast_500.Asttypes.Covariant -> Ast_51.Asttypes.Covariant + | Ast_500.Asttypes.Contravariant -> Ast_51.Asttypes.Contravariant + | Ast_500.Asttypes.NoVariance -> Ast_51.Asttypes.NoVariance +and copy_out_type : + Ast_500.Outcometree.out_type -> Ast_51.Outcometree.out_type = + function + | Ast_500.Outcometree.Otyp_abstract -> Ast_51.Outcometree.Otyp_abstract + | Ast_500.Outcometree.Otyp_open -> Ast_51.Outcometree.Otyp_open + | Ast_500.Outcometree.Otyp_alias (x0, x1) -> + Ast_51.Outcometree.Otyp_alias {non_gen=false;aliased=(copy_out_type x0);alias=x1} + | Ast_500.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_51.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_500.Outcometree.Otyp_class (_x0, x1, x2) -> + Ast_51.Outcometree.Otyp_class + ((copy_out_ident x1), (List.map copy_out_type x2)) + | Ast_500.Outcometree.Otyp_constr (x0, x1) -> + Ast_51.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_500.Outcometree.Otyp_manifest (x0, x1) -> + Ast_51.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_500.Outcometree.Otyp_object (x0, x1) -> + Ast_51.Outcometree.Otyp_object + {fields=(List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0); + open_row=match x1 with None -> false | Some b ->b} + | Ast_500.Outcometree.Otyp_record x0 -> + Ast_51.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_500.Outcometree.Otyp_stuff x0 -> Ast_51.Outcometree.Otyp_stuff x0 + | Ast_500.Outcometree.Otyp_sum x0 -> + Ast_51.Outcometree.Otyp_sum (List.map copy_out_constructor x0) + | Ast_500.Outcometree.Otyp_tuple x0 -> + Ast_51.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_500.Outcometree.Otyp_var (x0, x1) -> + Ast_51.Outcometree.Otyp_var (x0, x1) + | Ast_500.Outcometree.Otyp_variant (_x0, x1, x2, x3) -> + Ast_51.Outcometree.Otyp_variant + ((copy_out_variant x1), x2, + (Option.map (fun x -> List.map (fun x -> x) x) x3)) + | Ast_500.Outcometree.Otyp_poly (x0, x1) -> + Ast_51.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_500.Outcometree.Otyp_module (x0, x1) -> + Ast_51.Outcometree.Otyp_module + ((copy_out_ident x0), + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) + | Ast_500.Outcometree.Otyp_attribute (x0, x1) -> + Ast_51.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_500.Outcometree.out_attribute -> Ast_51.Outcometree.out_attribute = + fun { Ast_500.Outcometree.oattr_name = oattr_name } -> + { Ast_51.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_500.Outcometree.out_variant -> Ast_51.Outcometree.out_variant = + function + | Ast_500.Outcometree.Ovar_fields x0 -> + Ast_51.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_500.Outcometree.Ovar_typ x0 -> + Ast_51.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_constructor : + Ast_500.Outcometree.out_constructor -> Ast_51.Outcometree.out_constructor = + fun + { Ast_500.Outcometree.ocstr_name = ocstr_name; + Ast_500.Outcometree.ocstr_args = ocstr_args; + Ast_500.Outcometree.ocstr_return_type = ocstr_return_type } + -> + { + Ast_51.Outcometree.ocstr_name = ocstr_name; + Ast_51.Outcometree.ocstr_args = (List.map copy_out_type ocstr_args); + Ast_51.Outcometree.ocstr_return_type = + (Option.map copy_out_type ocstr_return_type) + } +and copy_out_value : + Ast_500.Outcometree.out_value -> Ast_51.Outcometree.out_value = + function + | Ast_500.Outcometree.Oval_array x0 -> + Ast_51.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_500.Outcometree.Oval_char x0 -> Ast_51.Outcometree.Oval_char x0 + | Ast_500.Outcometree.Oval_constr (x0, x1) -> + Ast_51.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_500.Outcometree.Oval_ellipsis -> Ast_51.Outcometree.Oval_ellipsis + | Ast_500.Outcometree.Oval_float x0 -> Ast_51.Outcometree.Oval_float x0 + | Ast_500.Outcometree.Oval_int x0 -> Ast_51.Outcometree.Oval_int x0 + | Ast_500.Outcometree.Oval_int32 x0 -> Ast_51.Outcometree.Oval_int32 x0 + | Ast_500.Outcometree.Oval_int64 x0 -> Ast_51.Outcometree.Oval_int64 x0 + | Ast_500.Outcometree.Oval_nativeint x0 -> + Ast_51.Outcometree.Oval_nativeint x0 + | Ast_500.Outcometree.Oval_list x0 -> + Ast_51.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_500.Outcometree.Oval_printer x0 -> Ast_51.Outcometree.Oval_printer x0 + | Ast_500.Outcometree.Oval_record x0 -> + Ast_51.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_500.Outcometree.Oval_string (x0, x1, x2) -> + Ast_51.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_500.Outcometree.Oval_stuff x0 -> Ast_51.Outcometree.Oval_stuff x0 + | Ast_500.Outcometree.Oval_tuple x0 -> + Ast_51.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_500.Outcometree.Oval_variant (x0, x1) -> + Ast_51.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_500.Outcometree.out_string -> Ast_51.Outcometree.out_string = + function + | Ast_500.Outcometree.Ostr_string -> Ast_51.Outcometree.Ostr_string + | Ast_500.Outcometree.Ostr_bytes -> Ast_51.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_500.Outcometree.out_ident -> Ast_51.Outcometree.out_ident = + function + | Ast_500.Outcometree.Oide_apply (x0, x1) -> + Ast_51.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_500.Outcometree.Oide_dot (x0, x1) -> + Ast_51.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_500.Outcometree.Oide_ident x0 -> + Ast_51.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_500.Outcometree.out_name -> Ast_51.Outcometree.out_name = + fun { Ast_500.Outcometree.printed_name = printed_name } -> + { Ast_51.Outcometree.printed_name = printed_name } diff --git a/src/vendored-omp/src/migrate_parsetree_51_500.ml b/src/vendored-omp/src/migrate_parsetree_51_500.ml new file mode 100644 index 000000000..ca58ad764 --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_51_500.ml @@ -0,0 +1,16 @@ +(**************************************************************************) +(* *) +(* 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_51_500_migrate diff --git a/src/vendored-omp/src/migrate_parsetree_51_500_migrate.ml b/src/vendored-omp/src/migrate_parsetree_51_500_migrate.ml new file mode 100644 index 000000000..4e1366d0f --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_51_500_migrate.ml @@ -0,0 +1,332 @@ +open Stdlib0 +module From = Ast_51 +module To = Ast_500 +let rec copy_out_type_extension : + Ast_51.Outcometree.out_type_extension -> + Ast_500.Outcometree.out_type_extension + = + fun + { Ast_51.Outcometree.otyext_name = otyext_name; + Ast_51.Outcometree.otyext_params = otyext_params; + Ast_51.Outcometree.otyext_constructors = otyext_constructors; + Ast_51.Outcometree.otyext_private = otyext_private } + -> + { + Ast_500.Outcometree.otyext_name = otyext_name; + Ast_500.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_500.Outcometree.otyext_constructors = + (List.map copy_out_constructor otyext_constructors); + Ast_500.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_51.Outcometree.out_phrase -> Ast_500.Outcometree.out_phrase = + function + | Ast_51.Outcometree.Ophr_eval (x0, x1) -> + Ast_500.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_51.Outcometree.Ophr_signature x0 -> + Ast_500.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_51.Outcometree.Ophr_exception x0 -> + Ast_500.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_51.Outcometree.out_sig_item -> Ast_500.Outcometree.out_sig_item = + function + | Ast_51.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_500.Outcometree.Osig_class + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_51.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_500.Outcometree.Osig_class_type + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_51.Outcometree.Osig_typext (x0, x1) -> + Ast_500.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_51.Outcometree.Osig_modtype (x0, x1) -> + Ast_500.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_51.Outcometree.Osig_module (x0, x1, x2) -> + Ast_500.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_51.Outcometree.Osig_type (x0, x1) -> + Ast_500.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_51.Outcometree.Osig_value x0 -> + Ast_500.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_51.Outcometree.Osig_ellipsis -> Ast_500.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_51.Outcometree.out_val_decl -> Ast_500.Outcometree.out_val_decl = + fun + { Ast_51.Outcometree.oval_name = oval_name; + Ast_51.Outcometree.oval_type = oval_type; + Ast_51.Outcometree.oval_prims = oval_prims; + Ast_51.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_500.Outcometree.oval_name = oval_name; + Ast_500.Outcometree.oval_type = (copy_out_type oval_type); + Ast_500.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_500.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_51.Outcometree.out_type_decl -> Ast_500.Outcometree.out_type_decl = + fun + { Ast_51.Outcometree.otype_name = otype_name; + Ast_51.Outcometree.otype_params = otype_params; + Ast_51.Outcometree.otype_type = otype_type; + Ast_51.Outcometree.otype_private = otype_private; + Ast_51.Outcometree.otype_immediate = otype_immediate; + Ast_51.Outcometree.otype_unboxed = otype_unboxed; + Ast_51.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_500.Outcometree.otype_name = otype_name; + Ast_500.Outcometree.otype_params = + (List.map copy_out_type_param otype_params); + Ast_500.Outcometree.otype_type = (copy_out_type otype_type); + Ast_500.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_500.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_500.Outcometree.otype_unboxed = otype_unboxed; + Ast_500.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_51.Type_immediacy.t -> Ast_500.Type_immediacy.t = + function + | Ast_51.Type_immediacy.Unknown -> Ast_500.Type_immediacy.Unknown + | Ast_51.Type_immediacy.Always -> Ast_500.Type_immediacy.Always + | Ast_51.Type_immediacy.Always_on_64bits -> + Ast_500.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_51.Outcometree.out_module_type -> Ast_500.Outcometree.out_module_type = + function + | Ast_51.Outcometree.Omty_abstract -> Ast_500.Outcometree.Omty_abstract + | Ast_51.Outcometree.Omty_functor (x0, x1) -> + Ast_500.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_51.Outcometree.Omty_ident x0 -> + Ast_500.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_51.Outcometree.Omty_signature x0 -> + Ast_500.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_51.Outcometree.Omty_alias x0 -> + Ast_500.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_51.Outcometree.out_ext_status -> Ast_500.Outcometree.out_ext_status = + function + | Ast_51.Outcometree.Oext_first -> Ast_500.Outcometree.Oext_first + | Ast_51.Outcometree.Oext_next -> Ast_500.Outcometree.Oext_next + | Ast_51.Outcometree.Oext_exception -> Ast_500.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_51.Outcometree.out_extension_constructor -> + Ast_500.Outcometree.out_extension_constructor + = + fun + { Ast_51.Outcometree.oext_name = oext_name; + Ast_51.Outcometree.oext_type_name = oext_type_name; + Ast_51.Outcometree.oext_type_params = oext_type_params; + Ast_51.Outcometree.oext_args = oext_args; + Ast_51.Outcometree.oext_ret_type = oext_ret_type; + Ast_51.Outcometree.oext_private = oext_private } + -> + { + Ast_500.Outcometree.oext_name = oext_name; + Ast_500.Outcometree.oext_type_name = oext_type_name; + Ast_500.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_500.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_500.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_500.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_private_flag : + Ast_51.Asttypes.private_flag -> Ast_500.Asttypes.private_flag = + function + | Ast_51.Asttypes.Private -> Ast_500.Asttypes.Private + | Ast_51.Asttypes.Public -> Ast_500.Asttypes.Public +and copy_out_rec_status : + Ast_51.Outcometree.out_rec_status -> Ast_500.Outcometree.out_rec_status = + function + | Ast_51.Outcometree.Orec_not -> Ast_500.Outcometree.Orec_not + | Ast_51.Outcometree.Orec_first -> Ast_500.Outcometree.Orec_first + | Ast_51.Outcometree.Orec_next -> Ast_500.Outcometree.Orec_next +and copy_out_class_type : + Ast_51.Outcometree.out_class_type -> Ast_500.Outcometree.out_class_type = + function + | Ast_51.Outcometree.Octy_constr (x0, x1) -> + Ast_500.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_500.Outcometree.Octy_arrow + (x0, (copy_out_type x1), (copy_out_class_type x2)) + | Ast_51.Outcometree.Octy_signature (x0, x1) -> + Ast_500.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_51.Outcometree.out_class_sig_item -> + Ast_500.Outcometree.out_class_sig_item + = + function + | Ast_51.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_500.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_51.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_500.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_51.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_500.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type_param : + Ast_51.Outcometree.out_type_param -> Ast_500.Outcometree.out_type_param = + fun x -> + let (x0, x1) = x in + (x0, (let (x0, x1) = x1 in ((copy_variance x0), (copy_injectivity x1)))) +and copy_injectivity : + Ast_51.Asttypes.injectivity -> Ast_500.Asttypes.injectivity = + function + | Ast_51.Asttypes.Injective -> Ast_500.Asttypes.Injective + | Ast_51.Asttypes.NoInjectivity -> Ast_500.Asttypes.NoInjectivity +and copy_variance : Ast_51.Asttypes.variance -> Ast_500.Asttypes.variance = + function + | Ast_51.Asttypes.Covariant -> Ast_500.Asttypes.Covariant + | Ast_51.Asttypes.Contravariant -> Ast_500.Asttypes.Contravariant + | Ast_51.Asttypes.NoVariance -> Ast_500.Asttypes.NoVariance +and copy_out_type : + Ast_51.Outcometree.out_type -> Ast_500.Outcometree.out_type = + function + | Ast_51.Outcometree.Otyp_abstract -> Ast_500.Outcometree.Otyp_abstract + | Ast_51.Outcometree.Otyp_open -> Ast_500.Outcometree.Otyp_open + | Ast_51.Outcometree.Otyp_alias {non_gen = _; aliased=x0; alias=x1} -> + Ast_500.Outcometree.Otyp_alias ((copy_out_type x0), x1) + | Ast_51.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_500.Outcometree.Otyp_arrow + (x0, (copy_out_type x1), (copy_out_type x2)) + | Ast_51.Outcometree.Otyp_class (x0, x1) -> + Ast_500.Outcometree.Otyp_class + (false, (copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Otyp_constr (x0, x1) -> + Ast_500.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Otyp_manifest (x0, x1) -> + Ast_500.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_51.Outcometree.Otyp_object {fields=x0; open_row=x1} -> + Ast_500.Outcometree.Otyp_object + ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x0), Some x1) + | Ast_51.Outcometree.Otyp_record x0 -> + Ast_500.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_51.Outcometree.Otyp_stuff x0 -> Ast_500.Outcometree.Otyp_stuff x0 + | Ast_51.Outcometree.Otyp_sum x0 -> + Ast_500.Outcometree.Otyp_sum (List.map copy_out_constructor x0) + | Ast_51.Outcometree.Otyp_tuple x0 -> + Ast_500.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_51.Outcometree.Otyp_var (x0, x1) -> + Ast_500.Outcometree.Otyp_var (x0, x1) + | Ast_51.Outcometree.Otyp_variant (x0, x1, x2) -> + Ast_500.Outcometree.Otyp_variant + (false, (copy_out_variant x0), x1, + (Option.map (fun x -> List.map (fun x -> x) x) x2)) + | Ast_51.Outcometree.Otyp_poly (x0, x1) -> + Ast_500.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_51.Outcometree.Otyp_module (x0, x1) -> + Ast_500.Outcometree.Otyp_module + ((copy_out_ident x0), + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) + | Ast_51.Outcometree.Otyp_attribute (x0, x1) -> + Ast_500.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_51.Outcometree.out_attribute -> Ast_500.Outcometree.out_attribute = + fun { Ast_51.Outcometree.oattr_name = oattr_name } -> + { Ast_500.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_51.Outcometree.out_variant -> Ast_500.Outcometree.out_variant = + function + | Ast_51.Outcometree.Ovar_fields x0 -> + Ast_500.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_51.Outcometree.Ovar_typ x0 -> + Ast_500.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_constructor : + Ast_51.Outcometree.out_constructor -> Ast_500.Outcometree.out_constructor = + fun + { Ast_51.Outcometree.ocstr_name = ocstr_name; + Ast_51.Outcometree.ocstr_args = ocstr_args; + Ast_51.Outcometree.ocstr_return_type = ocstr_return_type } + -> + { + Ast_500.Outcometree.ocstr_name = ocstr_name; + Ast_500.Outcometree.ocstr_args = (List.map copy_out_type ocstr_args); + Ast_500.Outcometree.ocstr_return_type = + (Option.map copy_out_type ocstr_return_type) + } +and copy_out_value : + Ast_51.Outcometree.out_value -> Ast_500.Outcometree.out_value = + function + | Ast_51.Outcometree.Oval_array x0 -> + Ast_500.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_char x0 -> Ast_500.Outcometree.Oval_char x0 + | Ast_51.Outcometree.Oval_constr (x0, x1) -> + Ast_500.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_51.Outcometree.Oval_ellipsis -> Ast_500.Outcometree.Oval_ellipsis + | Ast_51.Outcometree.Oval_float x0 -> Ast_500.Outcometree.Oval_float x0 + | Ast_51.Outcometree.Oval_int x0 -> Ast_500.Outcometree.Oval_int x0 + | Ast_51.Outcometree.Oval_int32 x0 -> Ast_500.Outcometree.Oval_int32 x0 + | Ast_51.Outcometree.Oval_int64 x0 -> Ast_500.Outcometree.Oval_int64 x0 + | Ast_51.Outcometree.Oval_nativeint x0 -> + Ast_500.Outcometree.Oval_nativeint x0 + | Ast_51.Outcometree.Oval_list x0 -> + Ast_500.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_printer x0 -> Ast_500.Outcometree.Oval_printer x0 + | Ast_51.Outcometree.Oval_record x0 -> + Ast_500.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_51.Outcometree.Oval_string (x0, x1, x2) -> + Ast_500.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_51.Outcometree.Oval_stuff x0 -> Ast_500.Outcometree.Oval_stuff x0 + | Ast_51.Outcometree.Oval_tuple x0 -> + Ast_500.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_variant (x0, x1) -> + Ast_500.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_51.Outcometree.out_string -> Ast_500.Outcometree.out_string = + function + | Ast_51.Outcometree.Ostr_string -> Ast_500.Outcometree.Ostr_string + | Ast_51.Outcometree.Ostr_bytes -> Ast_500.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_51.Outcometree.out_ident -> Ast_500.Outcometree.out_ident = + function + | Ast_51.Outcometree.Oide_apply (x0, x1) -> + Ast_500.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_51.Outcometree.Oide_dot (x0, x1) -> + Ast_500.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_51.Outcometree.Oide_ident x0 -> + Ast_500.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_51.Outcometree.out_name -> Ast_500.Outcometree.out_name = + fun { Ast_51.Outcometree.printed_name = printed_name } -> + { Ast_500.Outcometree.printed_name = printed_name } diff --git a/src/vendored-omp/src/migrate_parsetree_versions.ml b/src/vendored-omp/src/migrate_parsetree_versions.ml index 239f033b9..45f42e9ce 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.ml +++ b/src/vendored-omp/src/migrate_parsetree_versions.ml @@ -493,6 +493,13 @@ module OCaml_500 = struct let string_version = "5.0" end let ocaml_500 : OCaml_500.types ocaml_version = (module OCaml_500) +module OCaml_51 = struct + module Ast = Ast_51 + include Make_witness(Ast_51) + let version = 510 + let string_version = "5.1" +end +let ocaml_51 : OCaml_51.types ocaml_version = (module OCaml_51) (*$*) let all_versions : (module OCaml_version) list = [ @@ -512,6 +519,7 @@ let all_versions : (module OCaml_version) list = [ (module OCaml_413 : OCaml_version); (module OCaml_414 : OCaml_version); (module OCaml_500 : OCaml_version); + (module OCaml_51 : OCaml_version); (*$*) ] @@ -546,6 +554,8 @@ include Register_migration(OCaml_413)(OCaml_414) (Migrate_parsetree_413_414)(Migrate_parsetree_414_413) include Register_migration(OCaml_414)(OCaml_500) (Migrate_parsetree_414_500)(Migrate_parsetree_500_414) +include Register_migration(OCaml_500)(OCaml_51) + (Migrate_parsetree_500_51)(Migrate_parsetree_51_500) (*$*) module OCaml_current = OCaml_OCAML_VERSION diff --git a/src/vendored-omp/src/migrate_parsetree_versions.mli b/src/vendored-omp/src/migrate_parsetree_versions.mli index e7c5e105f..5b4e4c156 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.mli +++ b/src/vendored-omp/src/migrate_parsetree_versions.mli @@ -161,6 +161,8 @@ module OCaml_414 : OCaml_version with module Ast = Ast_414 val ocaml_414 : OCaml_414.types ocaml_version module OCaml_500 : OCaml_version with module Ast = Ast_500 val ocaml_500 : OCaml_500.types ocaml_version +module OCaml_51 : OCaml_version with module Ast = Ast_51 +val ocaml_51 : OCaml_51.types ocaml_version (*$*) (* An alias to the current compiler version *) diff --git a/src/vendored-omp/src/reason_omp.ml b/src/vendored-omp/src/reason_omp.ml index c7e58d2e4..53df0c218 100644 --- a/src/vendored-omp/src/reason_omp.ml +++ b/src/vendored-omp/src/reason_omp.ml @@ -38,6 +38,7 @@ module Ast_412 = Ast_412 module Ast_413 = Ast_413 module Ast_414 = Ast_414 module Ast_500 = Ast_500 +module Ast_51 = Ast_51 (*$*) (* Manual migration between versions *) @@ -71,6 +72,8 @@ module Migrate_413_414 = Migrate_parsetree_413_414 module Migrate_414_413 = Migrate_parsetree_414_413 module Migrate_414_500 = Migrate_parsetree_414_500 module Migrate_500_414 = Migrate_parsetree_500_414 +module Migrate_500_51 = Migrate_parsetree_500_51 +module Migrate_51_500 = Migrate_parsetree_51_500 (*$*) (* An abstraction of OCaml compiler versions *) @@ -96,6 +99,7 @@ module OCaml_412 = Versions.OCaml_412 module OCaml_413 = Versions.OCaml_413 module OCaml_414 = Versions.OCaml_414 module OCaml_500 = Versions.OCaml_500 +module OCaml_51 = Versions.OCaml_51 (*$*) module OCaml_current = Versions.OCaml_current diff --git a/src/vendored-omp/tools/dune b/src/vendored-omp/tools/dune index 8122ac6b4..bd8744eff 100644 --- a/src/vendored-omp/tools/dune +++ b/src/vendored-omp/tools/dune @@ -18,7 +18,8 @@ (name gencopy) (enabled_if (and - (>= %{ocaml_version} 5.0))) + (>= %{ocaml_version} 5.0) + (< %{ocaml_version} 5.1))) (modules gencopy) (libraries compiler-libs.common compiler-libs.bytecomp) (flags :standard -w -3)) From 95485d5c4527641903d9bec81e80aa3c5dfb3d30 Mon Sep 17 00:00:00 2001 From: David Sancho Date: Sun, 30 Apr 2023 21:41:33 +0200 Subject: [PATCH 03/64] Add formatting diff on typecheck (#2717) * Remove old tests * Remove miscTests * Remove azure * Remove CircleCI * Add output/basics to basics.t * Add formatting to basics_no_semi, add cases from basics * Add formatting to typeParameters * Add formatting to sequences * Add formatting to patternMatching, add more cases * Add formatting to oo * Add formatting to mutation * Add formatting to letop * Add formatting to lazy * Add formatting to knownReIssues * Add formatting to bigarraySyntax * Add formatting to reasonComments * Add formatting to attributes * Add formatting to type-pipeFirst * Add formatting to imperative * Run tests on macosx for 4.10 and 4.12 * Polish esy/makefile interface * Add formatting to type-jsx * Add formatting to reasonComments for 4.10 * Add formatting to objects for 4.06 * Rename typedtree to outcometree * Rename typedtree to outcome * Add formatting to attributes @ 4.12 * Add formatting to attributes @ 4.06 * Add formatting to type-trailing @ 4.06 * Add formatting to type-jsx @ 4.08 * Add formatting to attributes @ 4.10 * Pushed attributes to 4.14 --- Makefile | 33 +- esy.json | 4 - test/4.06/attributes.t | 24 + test/4.06/objects.t | 38 + test/4.06/type-trailing.t/run.t | 287 ++++++ test/4.08/type-jsx.t/run.t | 587 +++++++++++++ test/4.10/attributes-re.t/run.t | 828 ++++++++++++++++++ test/4.10/dune | 2 +- test/4.10/reasonComments-re.t/run.t | 759 ++++++++++++++++ test/4.10/type-jsx.t/run.t | 587 +++++++++++++ test/4.12/attributes-re.t/run.t | 828 ++++++++++++++++++ test/4.12/dune | 2 +- test/4.12/reasonComments-re.t/run.t | 759 ++++++++++++++++ test/4.12/type-jsx.t/run.t | 587 +++++++++++++ test/basic.t/run.t | 2 +- test/basics.t/run.t | 143 ++- test/basics_no_semi.t/input.re | 10 + test/basics_no_semi.t/run.t | 141 +++ test/bigarraySyntax.t/run.t | 52 ++ test/class.t/run.t | 2 +- test/dune | 2 +- test/imperative.t/run.t | 98 +++ test/inlineRecord.t/run.t | 2 +- test/knownReIssues.t/run.t | 26 + test/lazy.t/run.t | 41 + test/letop.t/run.t | 47 + test/lib/dune | 8 +- ...ter.cppo.ml => outcometreePrinter.cppo.ml} | 0 test/mutation.t/run.t | 60 ++ test/oo.t/run.t | 436 +++++++++ test/patternMatching.t/run.t | 315 +++++++ test/sequences.t/run.t | 90 ++ test/type-pipeFirst.t/run.t | 186 ++++ test/typeParameters.t/run.t | 89 ++ 34 files changed, 7043 insertions(+), 32 deletions(-) rename test/lib/{typedtreePrinter.cppo.ml => outcometreePrinter.cppo.ml} (100%) diff --git a/Makefile b/Makefile index b365ebab9..e7ee121a0 100644 --- a/Makefile +++ b/Makefile @@ -13,11 +13,13 @@ install: # CI uses opam. Regular workflow needn't. test-ci: install test-once-installed -# Can be run with esy x - no need to build beforehand. -test-once-installed: clean-tests - ./miscTests/rtopIntegrationTest.sh - ./miscTests/backportSyntaxTests.sh - cd formatTest; ./test.sh +test-once-installed: test + +test: + esy dune runtest + +test-watch: + esy dune runtest --watch .PHONY: coverage coverage: @@ -26,15 +28,7 @@ coverage: bisect-ppx-report -ignore-missing-files -I _build/ -html coverage-after/ bisect*.out ./*/*/*/bisect*.out find -iname "bisect*.out" -exec rm {} \; -clean-tests: - rm -rf ./formatTest/**/actual_output - rm -rf ./formatTest/**/intf_output - rm -rf ./formatTest/**/**/TestTest.cmi - rm -f ./formatTest/failed_tests - rm -f ./miscTests/reactjs_jsx_ppx_tests/*.cm* - -testFormat: build clean-tests - cd formatTest; ./test.sh +testFormat: build test-once-installed all_errors: @ echo "Regenerate all the possible error states for Menhir." @@ -42,16 +36,16 @@ all_errors: @ echo "---" menhir --explain --strict --unused-tokens src/reason-parser/reason_parser.mly --list-errors > src/reason-parser/reason_parser.messages.checked-in -clean: clean-tests +clean: dune clean -clean-for-ci: clean-tests +clean-for-ci: rm -rf ./_build .PHONY: build clean # For publishing esy releases to npm -esy-prepublish: build clean-tests +esy-prepublish: build node ./scripts/esy-prepublish.js # For OPAM @@ -76,3 +70,8 @@ all-supported-ocaml-versions: dune build @install @runtest --root . .PHONY: all-supported-ocaml-versions + +doc: + esy dune build @doc + +.PHONY: doc diff --git a/esy.json b/esy.json index f0906fe68..50fb41c02 100644 --- a/esy.json +++ b/esy.json @@ -53,9 +53,5 @@ ], "rewritePrefix": true } - }, - "scripts": { - "test": "esy x make test-once-installed", - "doc": "esy dune build @doc" } } diff --git a/test/4.06/attributes.t b/test/4.06/attributes.t index 2e6c1dda9..dfb6eb807 100644 --- a/test/4.06/attributes.t +++ b/test/4.06/attributes.t @@ -24,6 +24,30 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Pexp_letexception with attributes */ + let () = { + [@attribute] + exception E; + raise(E); + }; + + /** Different payloads **/ + + /* Empty signature */ + + [@haha:] + let x = 5; + + /* signature_item */ + [@haha: let x: option(int)] + let x = 5; + + /* Signature */ + [@haha: type t; let x: option(t)] + let x = 5; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/4.06/objects.t b/test/4.06/objects.t index 07c977e78..5d0b10df6 100644 --- a/test/4.06/objects.t +++ b/test/4.06/objects.t @@ -41,6 +41,44 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Oinherit (https://github.com/ocaml/ocaml/pull/1118) */ + type t = {. a: string}; + + type t1 = { + . + n: string, + ...t, + }; + + type t2('a) = + { + .. + o: string, + ...t, + } as 'a; + + /* Pcl_open, Pcty_open (https://github.com/ocaml/ocaml/pull/1249) */ + module EM = { + type t; + }; + + module OM = { + type t; + }; + + class x = { + open EM; + as self; + }; + + class y = { + open EM; + open OM; + as self; + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/4.06/type-trailing.t/run.t b/test/4.06/type-trailing.t/run.t index df08f6c0b..ed25ea505 100644 --- a/test/4.06/type-trailing.t/run.t +++ b/test/4.06/type-trailing.t/run.t @@ -1,6 +1,293 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file xx + $ cat ./formatted.re + let x = 0; + let y = 0; + + [@warning "-8"] + let [|x, y|] = [|0, y|]; + [@warning "-8"] + let [|x, y|] = [|0, y|]; + + [@warning "-8"] + let [| + reallyLongIdentifier, + reallyLongIdentifier2, + |] = [| + 0, + 1, + |]; + [@warning "-8"] + let [| + reallyLongIdentifier_, + reallyLongIdentifier2_, + |] = [| + 0, + 2, + |]; + + let takesUnit = () => (); + let res = takesUnit(); + let wat = 0; + + type t = { + x: int, + y: int, + }; + let p = {contents: 0}; + let {contents: c} = p; + let point = {x: 0, y: 0}; + let point2 = {...point, y: 200}; + + let myTuple = (0, 0); + let (i, j) = myTuple; + + type foo_('a, 'b) = ('a, 'b); + type foo__ = foo_(int, int); + type foo('a, 'b) = + | Foo('a, 'b); + type tupVariant('a, 'b) = + | Tup(('a, 'b)); + + /* Won't wrap so removes trailing comma */ + let noWrap = (a, b) => { + let x = a; + x + x; + }; + + let res = noWrap(0, 0); + let reallyLongIdentifierCausesWrap = 0; + let wrap = noWrap; + let res = + wrap( + reallyLongIdentifierCausesWrap, + reallyLongIdentifierCausesWrap, + ); + + /* Won't wrap so removes trailing comma */ + let noWrap = (~a, ~b) => { + let x = a; + x + x; + }; + + /* Won't wrap so removes trailing comma */ + let noWrap = (~a=0, ~b=0, ()) => { + let x = a; + x + x; + }; + + let res = + noWrap( + ~a=reallyLongIdentifierCausesWrap, + ~b=reallyLongIdentifierCausesWrap, + (), + ); + + /* Won't wrap so removes trailing comma */ + let noWrap = (~a=0, ~b: int=0, ()) => { + let x = a; + x + x; + }; + + let res = + noWrap( + ~a=reallyLongIdentifierCausesWrap, + ~b=reallyLongIdentifierCausesWrap, + (), + ); + + /* Long enough to wrap the args and therefore remove trail */ + let wrap = (long, enough, toWrap, args) => { + let x = long; + x + enough + toWrap + args; + }; + + let takesPattern = (d, Foo(x, y)) => { + /* won't wrap */ + let _ = Foo(y, x); + /* will wrap */ + let ret = + Foo( + y + y + y + y, + x + x + x + x + x + x + x + x + x, + ); + ret; + }; + + let takesPattern = (d, Tup((x, y))) => { + /* won't wrap */ + let _ = Tup((y, x)); + /* will wrap */ + let ret = + Tup(( + y + y + y + y, + x + x + x + x + x + x + x + x + x, + )); + ret; + }; + + let takesPattern = + ( + d, + Tup(( + thisPatternIsSoLongThatThe, + fooWillWrapItself, + )), + ) => { + /* won't wrap */ + let _ = Tup((d, d)); + /* will wrap */ + let ret = + Tup(( + d + d + d + d, + d + d + d + d + d + d + d + d + d, + )); + ret; + }; + + let myFunc = (type t, ()) => (); + + type funcType = (int, int) => int; + type v = + | Func((int, int) => int); + + type params('a, 'b) = ('a, 'b); + + let myList = [2, 3]; + + let yourList = [5, 6, ...myList]; + + class virtual + tupleStack + ( + 'reallyLongIdentifier, + 'anotherReallyLongIdentifier, + ) + (init, init2) = { + val mutable v: + list( + ( + 'reallyLongIdentifier, + 'anotherReallyLongIdentifier, + ), + ) = [ + (init, init2), + ]; + pub virtual implementMe: + (int, int) => (int, int); + initializer { + print_string("initializing object"); + }; + }; + + class extendedStack + ( + 'reallyLongIdentifier, + 'anotherReallyLongIdentifier, + ) + (init, init2) = { + inherit + ( + class tupleStack( + 'reallyLongIdentifier, + 'anotherReallyLongIdentifier, + ) + )( + init, + init2, + ); + pub implementMe = (i, j) => (i, j); + }; + + module type HasType = { + type t; + }; + module type HasType2 = { + type t; + type q; + }; + module type ReallyReallyReallyLongIdentifierModuleType = { + type t; + }; + module type F = (HasType) => HasType2; + module FInstance = (HasType: HasType) => { + type t = HasType.t; + type q = HasType.t; + }; + module ReallyReallyReallyLongIdentifierModuleName = { + type t = int; + }; + module FResult = + FInstance( + ReallyReallyReallyLongIdentifierModuleName, + ); + + module Component = { + let createElement = (~arg, ~children, ()) => [ + 0, + ]; + }; + + let componentList = []; + let componentList = []; + let componentList = []; + let componentList = []; + let componentList = [ + , + , + ]; + let componentList = [ + , + , + ]; + let componentList = [ + , + , + ]; + let componentList = [ + , + , + ]; + let componentList = [ + , + , + ]; + let componentList = [ + , + , + ]; + + let componentList = [||]; + let componentList = [||]; + let componentList = [||]; + let componentList = [||]; + let componentList = [| + , + , + |]; + let componentList = [| + , + , + |]; + let componentList = [| + , + , + |]; + let componentList = [| + , + , + |]; + let componentList = [| + , + , + |]; + let componentList = [| + , + , + |]; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/4.08/type-jsx.t/run.t b/test/4.08/type-jsx.t/run.t index 58b5a34fe..51295c781 100644 --- a/test/4.08/type-jsx.t/run.t +++ b/test/4.08/type-jsx.t/run.t @@ -1,6 +1,593 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + type component = {displayName: string}; + + module Bar = { + let createElement = (~c=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Nesting = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Much = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo = { + let createElement = + (~a=?, ~b=?, ~children, ()) => { + displayName: "test", + }; + }; + + module One = { + let createElement = + (~test=?, ~foo=?, ~children, ()) => { + displayName: "test", + }; + + let createElementobvioustypo = + (~test, ~children, ()) => { + displayName: "test", + }; + }; + + module Two = { + let createElement = (~foo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Sibling = { + let createElement = + (~foo=?, ~children: list(component), ()) => { + displayName: "test", + }; + }; + + module Test = { + let createElement = (~yo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module So = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Text = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Exp = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Pun = { + let createElement = + (~intended=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Namespace = { + module Foo = { + let createElement = + ( + ~intended=?, + ~anotherOptional as x=100, + ~children, + (), + ) => { + displayName: "test", + }; + }; + }; + + module Optional1 = { + let createElement = (~required, ~children, ()) => { + switch (required) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module Optional2 = { + let createElement = + (~optional=?, ~children, ()) => { + switch (optional) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module DefaultArg = { + let createElement = + (~default=Some("foo"), ~children, ()) => { + switch (default) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module LotsOfArguments = { + let createElement = + ( + ~argument1=?, + ~argument2=?, + ~argument3=?, + ~argument4=?, + ~argument5=?, + ~argument6=?, + ~children, + (), + ) => { + displayName: "test", + }; + }; + + let div = (~argument1=?, ~children, ()) => { + displayName: "test", + }; + + module List1 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List3 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module NotReallyJSX = { + let createElement = (~foo, ~bar, children) => { + displayName: "test", + }; + }; + + let notReallyJSX = (~foo, ~bar, children) => { + displayName: "test", + }; + + let fakeRender = (el: component) => { + el.displayName; + }; + + /* end of setup */ + + let (/><) = (a, b) => a + b; + let (><) = (a, b) => a + b; + let (/>) = (a, b) => a + b; + let (> a + b; + + let tag1 = 5 />< 6; + let tag2 = 5 >< 7; + let tag3 = 5 /> 7; + let tag4 = 5 >; + let selfClosing2 = ; + let selfClosing3 = + ; + let a = a + 2} /> ; + let a3 = ; + let a4 = + + + + ; + let a5 = "testing a string here" ; + let a6 = + + "testing a string here" + + "another string" + + {2 + 4} + ; + let intended = true; + let punning = ; + let namespace = ; + let c = ; + let d = ; + + let spaceBefore = + ; + let spaceBefore2 = ; + let siblingNotSpaced = + ; + let jsxInList = []; + let jsxInList2 = []; + let jsxInListA = []; + let jsxInListB = []; + let jsxInListC = []; + let jsxInListD = []; + let jsxInList3 = [, , ]; + let jsxInList4 = [, , ]; + let jsxInList5 = [, ]; + let jsxInList6 = [, ]; + let jsxInList7 = [, ]; + let jsxInList8 = [, ]; + let testFunc = b => b; + let jsxInFnCall = testFunc(); + let lotsOfArguments = + + + ; + let lowerCase =
; + + let b = 0; + let d = 0; + /* + * Should pun the first example: + */ + let a = 5 ; + let a = 5 ; + let a = 5 ; + let a = 0.55 ; + let a = ; + let ident = a ; + let fragment1 = <> ; + let fragment2 = <> ; + let fragment3 = <> ; + let fragment4 = <> ; + let fragment5 = <> ; + let fragment6 = <> ; + let fragment7 = <> ; + let fragment8 = <> ; + let fragment9 = <> 2 2 2 2 ; + let fragment10 = <> 2.2 3.2 4.6 1.2 ; + let fragment11 = <> "str" ; + let fragment12 = <> {6 + 2} {6 + 2} {6 + 2} ; + let fragment13 = <> fragment11 fragment11 ; + let listOfItems1 = 1 2 3 4 5 ; + let listOfItems2 = + 1.0 2.8 3.8 4.0 5.1 ; + let listOfItems3 = + fragment11 fragment11 ; + + /* + * Several sequential simple jsx expressions must be separated with a space. + */ + let thisIsRight = (a, b) => (); + let tagOne = (~children, ()) => (); + let tagTwo = (~children, ()) => (); + /* thisIsWrong ; */ + thisIsRight(, ); + + /* thisIsWrong ; */ + thisIsRight(, ); + + let a = (~children, ()) => (); + let b = (~children, ()) => (); + + let thisIsOkay = + ; + + let thisIsAlsoOkay = + ; + + /* Doesn't make any sense, but suppose you defined an + infix operator to compare jsx */ + < ; + > ; + + < ; + > ; + + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [ + <> , + <> , + ]; + let listOfListOfJsx = [ + <> , + <> , + ...listOfListOfJsx, + ]; + + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [ + <> , + <> , + ]; + let sameButWithSpaces = [ + <> , + <> , + ...sameButWithSpaces, + ]; + + /* + * Test named tag right next to an open bracket. + */ + + let listOfJsx = []; + let listOfJsx = []; + let listOfJsx = [, ]; + let listOfJsx = [ + , + , + ...listOfJsx, + ]; + + let sameButWithSpaces = []; + let sameButWithSpaces = []; + let sameButWithSpaces = [, ]; + let sameButWithSpaces = [ + , + , + ...sameButWithSpaces, + ]; + + /** + * Test no conflict with polymorphic variant types. + */ + type thisType = [ | `Foo | `Bar]; + type t('a) = [< thisType] as 'a; + + let asd = + [@foo] "a" "b" ; + let asd2 = + [@foo] + + "a" + "b" + ; + + let span = + (~test: bool, ~foo: int, ~children, ()) => 1; + let asd = + [@foo] "a" "b" ; + /* "video" call doesn't end with a list, so the expression isn't converted to JSX */ + let video = (~test: bool, children) => children; + let asd2 = [@foo] [@JSX] video(~test=false, 10); + + let div = (~children) => 1; + [@JSX] ((() => div)())(~children=[]); + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + let myFun = () => { + <> ; + }; + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + /** + * Children should wrap without forcing attributes to. + */ + + + + + + ; + + /** + * Failing test cases: + */ + /* let res = ) > */ + /* */ + /* ; */ + + /* let res = ) />; */ + let zzz = Some("oh hai"); + /* this should be the only test that generates a warning. We're explicitly testing for this */ + let optionalCallSite = + ; + fakeRender(optionalCallSite); + let optionalArgument = ; + fakeRender(optionalArgument); + let optionalArgument = + ; + fakeRender(optionalArgument); + let defaultArg = ; + fakeRender(defaultArg); + let defaultArg = ; + fakeRender(defaultArg); + + ([@bla] + [@JSX] + NotReallyJSX.createElement([], ~foo=1, ~bar=2)); + ([@bla] + [@JSX] + NotReallyJSX.createElement(~foo=1, [], ~bar=2)); + ([@bla] [@JSX] notReallyJSX([], ~foo=1)); + ([@bla] [@JSX] notReallyJSX(~foo=1, [], ~bar=2)); + + /* children can be at any position */ + ; + + ; + + /* preserve some other attributes too! */ + ([@bla] ); + ([@bla] ); + + ([@bla] ); + ([@bla] ); + + /* Overeager JSX punning #1099 */ + module Metal = { + let fiber = "fiber"; + }; + + module OverEager = { + let createElement = (~fiber, ~children, ()) => { + displayName: "test", + }; + }; + + let element = ; + + type style = { + width: int, + height: int, + paddingTop: int, + paddingLeft: int, + paddingRight: int, + paddingBottom: int, + }; + + module Window = { + let createElement = (~style, ~children, ()) => { + displayName: "window", + }; + }; + + let w = + ; + + let foo = None; + + let g = ; + + /* https://github.com/facebook/reason/issues/1428 */ + ...element ; + + ...{a => 1} ; + + ... ; + + ...[|a|] ; + + ...(1, 2) ; + + module Foo3 = { + let createElement = (~bar, ~children, ()) => + (); + }; + + } />; + + let onClickHandler = () => (); + + let div = (~onClick, ~children, ()) => (); + +
+ <> "foobar" +
; + + /* + * This is identical to just having "foobar" as a single JSX child (which means + * it's in a list). + */ + let yetAnotherDiv = +
"foobar"
; + + let tl = []; + + /* + * Spreading a list that has an identifier/expression as its tail. This should + * preserve the spread and preserve the braces. [list] is not considered + * simple for the purposes of spreading into JSX, or as a child. + */ +
+ ...{[yetAnotherDiv, ...tl]} +
; + + /* + * This is equivalent to having no children. + */ +
; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", line 460, characters 23-26: diff --git a/test/4.10/attributes-re.t/run.t b/test/4.10/attributes-re.t/run.t index 08f84df93..379f80c91 100644 --- a/test/4.10/attributes-re.t/run.t +++ b/test/4.10/attributes-re.t/run.t @@ -1,6 +1,834 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + /** + * Generally, dangling attributes [@..] apply to everything to the left of it, + * up until a comma, equals asignment, arrow, bar, or infix symbol (+/-) or + * prefix. + * + * This has a nice side effect when printing the terms: + * If a node has attributes attached to it, + */; + + /**Floating comment text should be removed*/; + + /** + * Core language features: + * ---------------------- + */; + + /**Floating doc text should be removed*/; + + /**removed text on type def*/ + [@itemAttributeOnTypeDef] + type itemText = int; + type nodeText = /**removed text on item*/ int; + /**removed text on type def*/ + [@itemAttributeOnTypeDef] + type nodeAndItemText = + /**removed text on item*/ int; + + /**removed doc on type def*/ + [@itemAttributeOnTypeDef] + type itemDoc = int; + [@itemAttributeOnTypeDef] + type nodeDoc = /**removed text on item*/ int; + /**removed doc on type def*/ + [@itemAttributeOnTypeDef] + type nodeAndItemDoc = + /**removed text on item*/ int; + + [@itemAttributeOnTypeDef] + type x = int; + type attributedInt = [@onTopLevelTypeDef] int; + + [@itemAttributeOnTypeDef] + type attributedIntsInTuple = ( + [@onInt] int, + [@onFloat] float, + ); + + type myDataType('x, 'y) = + | MyDataType('x, 'y); + + type myType = + [@onEntireType] + myDataType( + [@onOptionInt] option(int), + [@onOption] option(float), + ); + + let thisInst: myType = + [@attOnEntireDatatype] + MyDataType(Some(10), Some(10.0)); + + let thisInst: myType = + [@attOnEntireDatatype] + MyDataType( + [@onFirstParam] Some(10), + Some(10.0), + ); + + let x = [@onHello] "hello"; + let x = [@onHello] "hello"; + + let x = "hello" ++ [@onGoodbye] "goodbye"; + let x = [@onHello] "hello" ++ "goodbye"; + let x = [@onHello] "hello" ++ "goodbye"; + let x = "hello" ++ [@onGoodbye] "goodbye"; + let x = [@onEverything] ("hello" ++ "goodbye"); + + let x = 10 + [@on20] 20; + let x = 10 + [@on20] 20; + let x = [@on10] 10 + 20; + let x = [@on10] 10 + 20; + let x = [@attrEverything] (10 + 20); + + let x = 10 - [@on20] 20; + let x = 10 - [@on20] 20; + let x = [@on10] 10 - 20; + let x = [@on10] 10 - 20; + let x = [@attrEntireEverything] (10 - 20); + + let x = true && [@onFalse] false; + let x = true && [@onFalse] false; + let x = [@onTrue] true && false; + let x = [@onTrue] true && false; + let x = [@attrEverything] (true && false); + + /* now make sure to try with variants (tagged and `) */ + + /** + * How attribute parsings respond to other syntactic constructs. + */ + let add = a => + [@onRet] + { + a; + }; + let add = a => [@onRet] a; + let add = [@onEntireFunction] (a => a); + + let res = + if (true) {false} else {[@onFalse] false}; + let res = + [@onEntireIf] (if (true) {false} else {false}); + + let add = (a, b) => + [@onEverything] ([@onA] a + b); + let add = (a, b) => + [@onEverything] ([@onA] a + [@onB] b); + let add = (a, b) => a + [@onB] b; + + let both = [@onEntireFunction] (a => a); + let both = (a, b) => + [@onEverything] ([@onA] a && b); + let both = (a, b) => + [@onA] a && [@onB] [@onB] b; + let both = (a, b) => [@onEverything] (a && b); + + let thisVal = 10; + let x = + 20 + + (- [@onFunctionCall] add(thisVal, thisVal)); + let x = + [@onEverything] + (20 + (- add(thisVal, thisVal))); + let x = + - [@onFunctionCall] add(thisVal, thisVal); + let x = + [@onEverything] (- add(thisVal, thisVal)); + + let bothTrue = (x, y) => {contents: x && y}; + let something = + [@onEverythingToRightOfEquals] + (bothTrue(true, true))^; + let something = + ([@onlyOnArgumentToBang] bothTrue(true, true)) + ^; + + let res = + [@appliesToEntireFunctionApplication] + add(2, 4); + [@appliesToEntireFunctionApplication] + add(2, 4); + + let myObj = {pub p = () => {pub z = () => 10}}; + + let result = + [@onSecondSend] + ([@attOnFirstSend] myObj#p())#z(); + + [@onRecordFunctions] + type recordFunctions = { + p: unit => [@onUnit] recordFunctions, + q: [@onArrow] (unit => unit), + } + [@onUnusedType] + and unusedType = unit; + [@onMyRecord] + let rec myRecord = { + p: () => myRecord, + q: () => (), + } + [@onUnused] + and unused = (); + let result = + [@onSecondSend] + ([@attOnFirstSend] myRecord.p()).q(); + + [@onVariantType] + type variantType = + | [@onInt] Foo(int) + | Bar([@onInt] int) + | Baz; + + [@onVariantType] + type gadtType('x) = + | Foo(int): [@onFirstRow] gadtType(int) + | Bar([@onInt] int) + : [@onSecondRow] gadtType(unit) + | Baz: [@onThirdRow] gadtType([@onUnit] unit); + + [@floatingTopLevelStructureItem hello]; + [@itemAttributeOnEval] + print_string("hello"); + + [@itemAttrOnFirst] + let firstBinding = "first" + [@itemAttrOnSecond] + and secondBinding = "second"; + + /** + * Let bindings. + * ---------------------- + */ + let showLets = () => + [@onOuterLet] + { + let tmp = 20; + [@onFinalLet] + { + let tmpTmp = tmp + tmp; + tmpTmp + tmpTmp; + }; + }; + + /** + * Classes: + * ------------ + */ + /** + * In curried sugar, the class_expr attribute will apply to the return. + */ + [@moduleItemAttribute] + class boxA ('a) (init: 'a) = + [@onReturnClassExpr] { + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + pub pr = init + init + init; + }; + + /** + * In non-curried sugar, the class_expr still sticks to "the simple thing". + */ + class boxB ('a) (init: 'a) = + [@stillOnTheReturnBecauseItsSimple] { + pub pr = init + init + init; + }; + + /* To be able to put an attribute on just the return in that case, use + * parens. */ + [@onBoxC + x; + y + ] + class boxC ('a) = + [@onEntireFunction] ( + fun (init: 'a) => + [@onReturnClassExpr] { + pub pr = init + init + init; + } + ); + + [@moduleItemAttribute onTheTupleClassItem] + class tupleClass ('a, 'b) (init: ('a, 'b)) = { + let one = [@exprAttr ten] 10; + let two = [@exprAttr twenty] 20 + and three = [@exprAttr thirty] 30; + [@pr prMember] pub pr = one + two + three; + }; + + [@structureItem] + class type addablePointClassType = { + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; + } + [@structureItem] + and anotherClassType = { + pub foo: int; + pub bar: int; + }; + + class type _x = + [@bs] + { + pub height: int; + }; + + class type _y = { + [@bs.set] + pub height: int; + }; + + [@attr] + class type _z = { + pub height: int; + }; + + module NestedModule = { + [@floatingNestedStructureItem hello]; + }; + [@structureItem] + module type HasAttrs = { + [@onTypeDef] + type t = int; + [@floatingNestedSigItem hello]; + [@sigItem] + class type foo = { + pub foo: int; + pub bar: int; + }; + [@sigItem] + class fooBar: (int) => foo; + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + }; + + type s = + | S(string); + + let S([@onStr] str) = S([@onHello] "hello"); + let [@onConstruction] S(str) = + [@onConstruction] S("hello"); + + type xy = + | X(string) + | Y(string); + + let myFun = + ( + [@onConstruction] X(hello) | + [@onConstruction] Y(hello), + ) => hello; + let myFun = + ( + X([@onHello] hello) | Y([@onHello] hello), + ) => hello; + + /* Another bug: Cannot have an attribute on or pattern + let myFun = fun ((X(hello) | Y(hello)) [@onOrPattern]) => hello; + */ + + /* Bucklescript FFI item attributes */ + + [@bs.val] + external imul: (int, int) => int = "Math.imul"; + + module Js = { + type t('a); + }; + + type classAttributesOnKeys = { + . + [@bs.set] key1: string, + /* The follow two are the same */ + [@bs.get + { + null; + } + ] + key2: [@onType2] Js.t(int), + [@bs.get + { + null; + } + ] + key3: [@onType2] Js.t(int), + key4: Js.t([@justOnInt] int), + }; + + /* extensible variants */ + type attr = ..; + + [@block] + type attr += + | [@tag1] [@tag2] Str + | [@tag3] Float; + + type reconciler('props) = ..; + + [@onVariantType] + type reconciler('props) += + | Foo(int): [@onFirstRow] reconciler(int) + | Bar([@onInt] int): [@onSecondRow] + reconciler(unit) + | [@baz] + Baz: [@onThirdRow] + reconciler([@onUnit] unit); + + type water = ..; + + type water += + pri + | [@foo] [@foo2] MineralWater + | SpringWater; + + type cloud = string; + + type water += + pri + | [@h2o] PreparedWater + | [@nature] RainWater(cloud) + | [@toxic] + MeltedSnowWaterFromNuclearWastelandWithALineBreakBecauseTheNameIsSoLong; + + /* reasonreact */ + type element; + + type reactElement; + + type reactClass; + + /* "react-dom" shouldn't spread the attribute over multiple lines */ + [@bs.val] [@bs.module "react-dom"] + external render: (reactElement, element) => unit = + "render"; + + [@bs.module "f"] external f: int => int = "f"; + + [@bs.val] [@bs.module "react"] [@bs.splice] + external createCompositeElementInternalHack: + ( + reactClass, + {.. "reasonProps": 'props}, + array(reactElement) + ) => + reactElement = + "createElement"; + + external add_nat: (int, int) => int = + "add_nat_bytecode" "add_nat_native"; + + [@bs.module "Bar"] + [@ocaml.deprecated + "Use bar instead. It's a much cooler function. This string needs to be a little long" + ] + external foo: bool => bool; + + /* Attributes on an entire polymorphic variant leaf */ + [@bs.module "fs"] + external readFileSync: + ( + ~name: string, + [@bs.string] [ + | `utf8 + | [@bs.as "ascii"] `my_name + ] + ) => + string; + + [@bs.module "fs"] + external readFileSync2: + ( + ~name: string, + [@bs.string] [ + | [@bs.as "ascii"] `utf8 + | [@bs.as "ascii"] `my_name + ] + ) => + string; + + /* Ensure that attributes on extensions are printed */ + [@test [@attr] [%%extension]]; + + external debounce: + (int, [@bs.meth] unit) => unit; + + external debounce: (int, [@bs.meth] unit) => unit = + "debounce"; + + external debounce: + (int, [@bs.meth] unit) => unit; + + external debounce: + int => [@bs.meth] (unit => unit); + + external debounce: + (int, [@bs.meth] (unit => unit)) => + [@bs.meth] (unit => unit); + + external debounce: + ( + int, + [@bs.meth] (unit => unit), + [@bs.meth] (unit => unit) + ) => + [@bs.meth] (unit => unit); + + external debounce: + ( + int, + [@bs.meth] (unit => unit), + [@bs.meth] ( + unit => [@bs.meth] (unit => unit) + ) + ) => + [@bs.meth] (unit => unit); + + let x = "hi"; + + let res = + switch (x) { + | _ => + [@attr] + open String; + open Array; + concat; + index_from; + }; + + let res = + switch (x) { + | _ => [@attr] String.(Array.(concat)) + }; + + /* GADT */ + type value = + | [@foo] VBool'(bool): [@bar] value + | VInt'(int): value; + + /** Different payloads **/ + + /* Empty structure */ + [@haha] + let x = 5; + + /* Expression structure */ + [@haha "hello world"] + let x = 5; + + /* structure_item */ + [@haha let x = 5] + let x = 5; + + /* structure */ + [@haha + let x = 5; + module X = {} + ] + let x = 5; + + /* Pattern */ + [@haha? Some(_)] + let x = 5; + + /* Type */ + [@haha: option(int)] + let x = 5; + + /* Record item attributes */ + + type t_ = { + /** Comment attribute on record item */ + x: int, + }; + + type tt = { + [@attr "on record field"] + x: int, + }; + + type ttt = { + [@attr "on record field"] + x: [@attr "on type itself"] int, + }; + + type tttt = { + /** Comment attribute on record item */ + x: int, + [@regularAttribute "on next item"] + y: int, + }; + + type ttttt = { + [@attr "moved to first row"] [@attr] + x: int, + }; + + type tttttt = { + [@attr "testing with mutable field"] + mutable x: int, + }; + + let tmp = + /** On if statement */ + (if (true) {true} else {false}); + + type foo = + option( + [@foo + [ + "how does this break", + "when long enough", + ] + ] ( + [@bar] (int => int), + [@baz] (int => int), + ), + ); + + module Callbacks = { + let cb = () => 1 + 1; + }; + + let test = { + let _x = 1; + [@attr1] + open Callbacks; + let _s = "hello" ++ "!"; + [@attr2] Callbacks.("hello" ++ "!"); + }; + + [@test.call string => string] + let processCommandItem = 12; + + module type Foo = { + [@someattr] + let foo: int => int; + }; + + [@bs.deriving abstract] + type t = { + /** Position (in the pre-change coordinate system) where the change ended. */ + [@bs.as "to"] [@bar] + to_: string, + }; + + [@bs.deriving abstract] + type editorConfiguration = { + /** Determines whether horizontal cursor movement through right-to-left (Arabic, Hebrew) text + is visual (pressing the left arrow moves the cursor left) + or logical (pressing the left arrow moves to the next lower index in the string, which is visually right in right-to-left text). + The default is false on Windows, and true on other platforms. */ + [@bs.optional] + rtlMoveVisually: bool, + }; + + module Fmt = { + let barBaz = () => (); + + type record = {x: int}; + }; + + Fmt.([@foo] barBaz()); + Fmt.([@foo] {x: 1}); + Fmt.([@foo] [1, 2, 3]); + Fmt.([@foo] (1, 2, 3)); + Fmt.([@foo] {val x = 10}); + + /** + * Attributes are associate with the identifier, function call, constructor + * appcation or constructor application pattern in front of it - up until a + * type constraint, an | (or) or an 'as'. + */ + + let punnned_lbl_a = (~lbl as [@ATTR] lbl) => lbl; + let punnned_lbl_b = (~lbl as [@ATTR] (lbl: int)) => lbl; + let punnned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lbl) => lbl; + let punnned_lbl_d = + (~lbl as [@ATTR] ([@ATTR2] lbl: int)) => lbl; + let punnned_lbl_e = + (~lbl as [@ATTR] [@ATTR2] (lbl: int)) => lbl; + + let punnned_lbl_f = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_g = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_h = (~lbl as [@ATTR] (lbl: int)) => lbl; + /** Attributes have lower precedence than type constraint. The following should + * be printed identically. */ + let punnned_lbl_i = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_i' = + (~lbl as [@ATTR] (lbl: int)) => lbl; + + let nonpunned_lbla = + (~lbl as [@ATTR] lblNonpunned) => lblNonpunned; + let nonpunned_lbl_b = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + let nonpunned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lblNonpunned) => lblNonpunned; + let nonpunned_lbl_d = + ( + ~lbl as + [@ATTR] ([@ATTR2] lblNonpunned: int), + ) => lblNonpunned; + let nonpunned_lbl_e = + ( + ~lbl as + [@ATTR] [@ATTR2] (lblNonpunned: int), + ) => lblNonpunned; + + let nonpunned_lbl_f = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_g = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_h = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + + let nonpunned_lbl_i = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_i' = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + + let defaulted_punnned_lbl_a = + (~lbl as [@ATTR] lbl=0, ()) => lbl; + let defaulted_punnned_lbl_b = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + let defaulted_punnned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lbl=0, ()) => lbl; + let defaulted_punnned_lbl_d = + (~lbl as [@ATTR] ([@ATTR2] lbl: int)=0, ()) => lbl; + let defaulted_punnned_lbl_e = + (~lbl as [@ATTR] [@ATTR2] (lbl: int)=0, ()) => lbl; + + let defaulted_punnned_lbl_f = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_g = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_h = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + /** Attributes have lower precedence than type constraint. The following should + * be printed identically. */ + let defaulted_punnned_lbl_i = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_i' = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + + let defaulted_nonpunned_lbla = + (~lbl as [@ATTR] lblNonpunned=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_b = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_c = + ( + ~lbl as [@ATTR] [@ATTR2] lblNonpunned=0, + (), + ) => lblNonpunned; + let defaulted_nonpunned_lbl_d = + ( + ~lbl as [@ATTR] ([@ATTR2] lblNonpunned: int)=0, + (), + ) => lblNonpunned; + let defaulted_nonpunned_lbl_e = + ( + ~lbl as [@ATTR] [@ATTR2] (lblNonpunned: int)=0, + (), + ) => lblNonpunned; + + let defaulted_nonpunned_lbl_f = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_g = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_h = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + + let defaulted_nonpunned_lbl_i = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_i' = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + + /* Won't parse: let [@attr] x1 : int = xInt; */ + let xInt = 0; + + /** + Attribute on the pattern node inside of constraint + pattern ( + Ppat_constraint( + pattern(@xxx, Ppat_var "x"), + coretype + ) + ) + This will get sugared to `let ([@attr] x2) : int = xInt` + */ + let ([@attr] x2): int = xInt; + /** + Attribute on the pattern holding the constraint: + pattern( + @xxx + Ppat_constraint( + pattern(Pexpident "x"), + coretype + ) + ) + */ + let [@attr] (x3: int) = xInt; + let [@attr] ([@attr0] x4: int) = xInt; + let [@attr] ([@attr0] x5: int) = xInt; + + type eitherOr('a, 'b) = + | Either('a) + | Or('b); + let [@attr] Either(a) | Or(a) = Either("hi"); + // Can drop the the parens around Either. + let [@attr] Either(a) | Or(a) = Either("hi"); + // Can drop the parens around Or. + let Either(b) | [@attr] Or(b) = Either("hi"); + // Should keep the parens around both + let [@attr] (Either(a) | Or(a)) = Either("hi"); + + // Should keep the parens + let [@attr] (_x as xAlias) = 10; + // Should drop the parens + let [@attr] _x as xAlias' = 10; + + /** + Attribute on the expression node inside of constraint + expression( + Pexp_constraint( + expression(@xxx, Pexpident "x"), + coretype + ) + ) + */ + let _ = ([@xxx] xInt: int); // This should format the same + let _ = ([@xxx] xInt: int); // This should format the same + + /** + Attribute on the expression holding the constraint: + expression( + @xxx + Pexp_constraint( + expression(Pexpident "x"), + coretype + ) + ) + */ + let _ = [@xxx] (xInt: int); // This should format the same + + [@foo? [@attr] (x: int)]; + [@foo? [@attr] ([@bar] x: int)]; + [@foo? [@attr] (Either("hi") | Or("hi"))]; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", line 503, characters 4-10: diff --git a/test/4.10/dune b/test/4.10/dune index 386c8f23b..fe57af87b 100644 --- a/test/4.10/dune +++ b/test/4.10/dune @@ -5,7 +5,7 @@ (enabled_if (and (or - (= %{system} "mac") + (= %{system} "macosx") (= %{system} "linux")) (or (= %{ocaml_version} 4.10.0) diff --git a/test/4.10/reasonComments-re.t/run.t b/test/4.10/reasonComments-re.t/run.t index 8135a23b7..46319a97e 100644 --- a/test/4.10/reasonComments-re.t/run.t +++ b/test/4.10/reasonComments-re.t/run.t @@ -1,6 +1,765 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + 3; /* - */ + 3; /*-*/ + + 3; /*-*/ + + 3 /*-*/; + /* **** comment */ + /*** comment */ + /** docstring */ + /* comment */ + /** docstring */ + /*** comment */ + /**** comment */ + /***** comment */ + /** */ + /*** */ + /**** */ + /**/ + /***/ + /****/ + /** (** comment *) */ + /** (*** comment *) */ + /* (** comment *) */ + /* (*** comment *) */ + /* *(*** comment *) */ + /* comment **/ + /* comment ***/ + /* comment ****/ + /* comment *****/ + /** + * Multiline + */ + /** Multiline + * + */ + /** + ** + */ + module JustString = { + include Map.Make(Int32); /* Comment eol include */ + }; + + let testingEndOfLineComments = [ + "Item 1" /* Comment For First Item */, + "Item 2" /* Comment For Second Item */, + "Item 3" /* Comment For Third Item */, + "Item 4" /* Comment For Fourth Item - but before trailing comma */, + /* Comment after last item in list. */ + ] /* Comment after rbracket */; + + /* But if you place them after the comma at eol, they're preserved as such */ + let testingEndOfLineComments = [ + "Item 1", /* Comment For First Item */ + "Item 2", /* Comment For Second Item */ + "Item 3", /* Comment For Third Item */ + "Item 4" /* Comment For Fourth Item - but before trailing comma */, + /* Comment after last item in list. */ + ] /* Comment after rbracket */; + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + /* Try again but without other things in the list */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + ]; /* Comment after semi */ + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + let testingEndOfLineComments = []; /* Comment after entire let binding */ + + /* The following is not yet idempotent */ + /* let myFunction */ + /* withFirstArg /* First arg */ */ + /* andSecondArg => { /* Second Arg */ */ + /* withFirstArg + andSecondArg /* before semi */ ; */ + /* }; */ + + let myFunction = /* First arg */ + ( + withFirstArg, + /* Second Arg */ + andSecondArg, + ) => { + withFirstArg + andSecondArg; + }; /* After Semi */ + + type point = { + x: string, /* x field */ + y: string /* y field */ + }; + + type pointWithManyKindsOfComments = { + /* Line before x */ + x: string, /* x field */ + /* Line before y */ + y: string /* y field */ + /* Final row of record */ + }; + + type typeParamPointWithComments('a) = { + /* Line before x */ + x: 'a, /* x field */ + /* Line before y */ + y: 'a /* y field */ + /* Final row of record */ + }; + + /* Now, interleaving comments in type params */ + /* Type name */ + type typeParamPointWithComments2 + /* The a type param */ + ( + 'a, + /* The b type apram */ + 'b, + ) = { + /* Line before x */ + x: 'a, /* x field */ + /* Line before y */ + y: 'a /* y field */ + /* Final row of record */ + }; + + /* The way the last row comment is formatted is suboptimal becuase + * record type definitions do not include enough location information */ + type anotherpoint = { + x: string, /* x field */ + y: string /* y field */ + /* comment as last row of record */ + }; + + type t = (int, int); /* End of line on t */ + type t2 = (int, int); /* End of line on (int, int) */ + + type t3 = (int, int); /* End of line on (int, int) */ + + type variant = + | X(int, int) /* End of line on X */ + | Y(int, int); /* End of line on Y */ /* Comment on entire type def for variant */ + + /* Before let */ + let res = + /* Before switch */ + switch (X(2, 3)) { + /* Above X line */ + | X(_) => "result of X" /* End of arrow and X line */ + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; /* After final semi in switch */ + + let res = + switch (X(2, 3)) { + | X(0, 0) => + /* After X arrow */ + "result of X" /* End of X body line */ + | X(1, 0) /* Before X's arrow */ => "result of X" /* End of X body line */ + | X(_) => + /* After X _ arrow */ + "result of X" /* End of X body line */ + /* Above Y line */ + | Y(_) => + /* Comment above Y body */ + "result of Y" + }; + + type variant2 = + /* Comment above X */ + | X(int, int) /* End of line on X */ + /* Comment above Y */ + | Y(int, int); + + type variant3 = + /* Comment above X */ + | X(int, int) /* End of line on X */ + /* Comment above Y */ + | Y(int, int); /* End of line on Y */ + + type x = { + /* not attached *above* x */ + fieldOne: int, + fieldA: int, + } /* Attached end of line after x */ + and y = { + /* not attached *above* y */ + fieldTwo: int, + }; /* Attached end of line after y */ + + type x2 = { + /* not attached *above* x2 */ + fieldOne: int, + fieldA: int, + } /* Attached end of line after x2 */ + and y2 = { + /* not attached *above* y2 */ + fieldTwo: int, + }; + + let result = + switch (None) { + | Some({fieldOne: 20, fieldA: a}) => + /* Where does this comment go? */ + let tmp = 0; + 2 + tmp; + | Some({fieldOne: n, fieldA: a}) => + /* How about this one */ + let tmp = n; + n + tmp; + | None => 20 + }; + + let res = + /* Before switch */ + switch (X(2, 3)) { + /* Above X line */ + | X(_) => "result of X" /* End of arrow and X line */ + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; + + /* + * Now these end of line comments *should* be retained. + */ + let result = + switch (None) { + | Some({ + fieldOne: 20, /* end of line */ + fieldA: a /* end of line */ + }) => + let tmp = 0; + 2 + tmp; + | Some({ + fieldOne: n, /* end of line */ + fieldA: a /* end of line */ + }) => + let tmp = n; + n + tmp; + | None => 20 + }; + + /* + * These end of line comments *should* be retained. + * To get the simple expression eol comment to be retained, we just need to + * implement label breaking eol behavior much like we did with sequences. + * Otherwise, right now they are not idempotent. + */ + let res = + switch ( + /* Retain this */ + X(2, 3) + ) { + /* Above X line */ + | X( + _, /* retain this */ + _ /* retain this */ + ) => "result of X" + + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; + + type optionalTuple = + | OptTup( + option( + ( + int, /* First int */ + int /* Second int */ + ), + ), + ); + + type optionTuple = + option( + ( + int, /* First int */ + int /* Second int */ + ), + ); + + type intPair = ( + int, /* First int */ + int /* Second int */ + ); + type intPair2 = ( + /* First int */ + int, + /* Second int */ + int, + ); + + let result = + /**/ + { + 2 + 3; + }; + + /* This is not yet idempotent */ + /* { */ + /* /**/ */ + /* (+) 2 3 */ + /* }; */ + + let a = (); + for (i in 0 to 10) { + /* bla */ + a; + }; + + if (true) { + /* hello */ + () + }; + + type color = + | Red(int) /* After red end of line */ + | Black(int) /* After black end of line */ + | Green(int); /* After green end of line */ /* On next line after color type def */ + + let blahCurriedX = x => + fun + | Red(10) + | Black(20) + | Green(10) => 1 /* After or pattern green */ + | Red(x) => 0 /* After red */ + | Black(x) => 0 /* After black */ + | Green(x) => 0; /* After second green */ /* On next line after blahCurriedX def */ + + let name_equal = (x, y) => { + x == y; + }; + + let equal = (i1, i2) => + i1.contents === i2.contents && true; /* most unlikely first */ + + let equal = (i1, i2) => + compare(compare(0, 0), compare(1, 1)); /* END OF LINE HERE */ + + let tuple_equal = ((i1, i2)) => i1 == i2; + + let tuple_equal = ((csu, mgd)) => + /* Some really long comments, see https://github.com/facebook/reason/issues/811 */ + tuple_equal((csu, mgd)); + + /** Comments inside empty function bodies + * See https://github.com/facebook/reason/issues/860 + */ + let fun_def_comment_inline = () => {/* */}; + + let fun_def_comment_newline = () => {/* */}; + + let fun_def_comment_long = () => { + /* longer comment inside empty function body */ + }; + + let trueThing = true; + + for (i in 0 to 1) { + /* comment */ + print_newline(); + }; + + while (trueThing) { + /* comment */ + print_newline(); + }; + + if (trueThing) { + /* comment */ + print_newline(); + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + } else { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + } else { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + } else { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + } else { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + let f = (a, b, c, d) => a + b + c + d; + + while (trueThing) { + f( + /* a */ + 1, + /* b */ + 2, + /* c */ + 3, + /* d */ + 4, + /* does work */ + ); + }; + while (trueThing) { + f( + /* a */ + 1, + /* b */ + 2, + /* c */ + 3, + /* d */ + 4 /* does work */ + ); + }; + + ignore( + ( + _really, + _long, + _printWidth, + _exceeded, + _here, + ) => { + /* First comment */ + let x = 0; + x + x; + /* Closing comment */ + }); + + ignore((_xxx, _yyy) => { + /* First comment */ + let x = 0; + x + x; + /* Closing comment */ + }); + + type tester('a, 'b) = + | TwoArgsConstructor('a, 'b) + | OneTupleArgConstructor(('a, 'b)); + let callFunctionTwoArgs = (a, b) => (); + let callFunctionOneTuple = tuple => (); + + let y = + TwoArgsConstructor( + 1, /*eol1*/ + 2 /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + 1, /*eol1*/ + 2 /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + 1, /*eol1*/ + 2 /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + 1, /*eol1*/ + 2 /* eol2 */ + )); + + type polyRecord('a, 'b) = { + fieldOne: 'a, + fieldTwo: 'b, + }; + + let r = { + fieldOne: 1, /*eol1*/ + fieldTwo: 2 /* eol2 */ + }; + + let r = { + fieldOne: 1, /*eol1*/ + fieldTwo: 2 /* eol2 with trailing comma */ + }; + + let y = + TwoArgsConstructor( + "1", /*eol1*/ + "2" /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + "1", /*eol1*/ + "2" /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + "1", /*eol1*/ + "2" /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + "1", /*eol1*/ + "2" /* eol2 */ + )); + + let r = { + fieldOne: "1", /*eol1*/ + fieldTwo: "2" /* eol2 */ + }; + + let r = { + fieldOne: "1", /*eol1*/ + fieldTwo: "2" /* eol2 with trailing comma */ + }; + + let identifier = "hello"; + + let y = + TwoArgsConstructor( + identifier, /*eol1*/ + identifier /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + identifier, /*eol1*/ + identifier /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + identifier, /*eol1*/ + identifier /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + identifier, /*eol1*/ + identifier /* eol2 */ + )); + + let r = { + fieldOne: identifier, /*eol1*/ + fieldTwo: identifier /* eol2 */ + }; + + let r = { + fieldOne: identifier, /*eol1*/ + fieldTwo: identifier /* eol2 with trailing comma */ + }; + + let y = + TwoArgsConstructor( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + )); + + let r = { + fieldOne: (identifier: string), /*eol1*/ + fieldTwo: (identifier: string) /* eol2 */ + }; + + let r = { + fieldOne: (identifier: string), /*eol1*/ + fieldTwo: (identifier: string) /* eol2 with trailing comma */ + }; + + /** doc comment */ + [@bs.send] + external url: t => string; + + /** + * Short multiline doc comment + */ + [@bs.send] + external url: t => string; + + /** Longer doc comment before an attribute on an external. */ + [@bs.send] + external url: t => string; + + /* normal comment */ + [@bs.send] external url: t => string; + + /** doc type */ + type q = { + a: int, + b: string, + }; + + /** doc let */ + let letter: q = {a: 42, b: "answer"}; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", lines 536-548, characters 18-1: diff --git a/test/4.10/type-jsx.t/run.t b/test/4.10/type-jsx.t/run.t index 58b5a34fe..51295c781 100644 --- a/test/4.10/type-jsx.t/run.t +++ b/test/4.10/type-jsx.t/run.t @@ -1,6 +1,593 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + type component = {displayName: string}; + + module Bar = { + let createElement = (~c=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Nesting = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Much = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo = { + let createElement = + (~a=?, ~b=?, ~children, ()) => { + displayName: "test", + }; + }; + + module One = { + let createElement = + (~test=?, ~foo=?, ~children, ()) => { + displayName: "test", + }; + + let createElementobvioustypo = + (~test, ~children, ()) => { + displayName: "test", + }; + }; + + module Two = { + let createElement = (~foo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Sibling = { + let createElement = + (~foo=?, ~children: list(component), ()) => { + displayName: "test", + }; + }; + + module Test = { + let createElement = (~yo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module So = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Text = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Exp = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Pun = { + let createElement = + (~intended=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Namespace = { + module Foo = { + let createElement = + ( + ~intended=?, + ~anotherOptional as x=100, + ~children, + (), + ) => { + displayName: "test", + }; + }; + }; + + module Optional1 = { + let createElement = (~required, ~children, ()) => { + switch (required) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module Optional2 = { + let createElement = + (~optional=?, ~children, ()) => { + switch (optional) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module DefaultArg = { + let createElement = + (~default=Some("foo"), ~children, ()) => { + switch (default) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module LotsOfArguments = { + let createElement = + ( + ~argument1=?, + ~argument2=?, + ~argument3=?, + ~argument4=?, + ~argument5=?, + ~argument6=?, + ~children, + (), + ) => { + displayName: "test", + }; + }; + + let div = (~argument1=?, ~children, ()) => { + displayName: "test", + }; + + module List1 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List3 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module NotReallyJSX = { + let createElement = (~foo, ~bar, children) => { + displayName: "test", + }; + }; + + let notReallyJSX = (~foo, ~bar, children) => { + displayName: "test", + }; + + let fakeRender = (el: component) => { + el.displayName; + }; + + /* end of setup */ + + let (/><) = (a, b) => a + b; + let (><) = (a, b) => a + b; + let (/>) = (a, b) => a + b; + let (> a + b; + + let tag1 = 5 />< 6; + let tag2 = 5 >< 7; + let tag3 = 5 /> 7; + let tag4 = 5 >; + let selfClosing2 = ; + let selfClosing3 = + ; + let a = a + 2} /> ; + let a3 = ; + let a4 = + + + + ; + let a5 = "testing a string here" ; + let a6 = + + "testing a string here" + + "another string" + + {2 + 4} + ; + let intended = true; + let punning = ; + let namespace = ; + let c = ; + let d = ; + + let spaceBefore = + ; + let spaceBefore2 = ; + let siblingNotSpaced = + ; + let jsxInList = []; + let jsxInList2 = []; + let jsxInListA = []; + let jsxInListB = []; + let jsxInListC = []; + let jsxInListD = []; + let jsxInList3 = [, , ]; + let jsxInList4 = [, , ]; + let jsxInList5 = [, ]; + let jsxInList6 = [, ]; + let jsxInList7 = [, ]; + let jsxInList8 = [, ]; + let testFunc = b => b; + let jsxInFnCall = testFunc(); + let lotsOfArguments = + + + ; + let lowerCase =
; + + let b = 0; + let d = 0; + /* + * Should pun the first example: + */ + let a = 5 ; + let a = 5 ; + let a = 5 ; + let a = 0.55 ; + let a = ; + let ident = a ; + let fragment1 = <> ; + let fragment2 = <> ; + let fragment3 = <> ; + let fragment4 = <> ; + let fragment5 = <> ; + let fragment6 = <> ; + let fragment7 = <> ; + let fragment8 = <> ; + let fragment9 = <> 2 2 2 2 ; + let fragment10 = <> 2.2 3.2 4.6 1.2 ; + let fragment11 = <> "str" ; + let fragment12 = <> {6 + 2} {6 + 2} {6 + 2} ; + let fragment13 = <> fragment11 fragment11 ; + let listOfItems1 = 1 2 3 4 5 ; + let listOfItems2 = + 1.0 2.8 3.8 4.0 5.1 ; + let listOfItems3 = + fragment11 fragment11 ; + + /* + * Several sequential simple jsx expressions must be separated with a space. + */ + let thisIsRight = (a, b) => (); + let tagOne = (~children, ()) => (); + let tagTwo = (~children, ()) => (); + /* thisIsWrong ; */ + thisIsRight(, ); + + /* thisIsWrong ; */ + thisIsRight(, ); + + let a = (~children, ()) => (); + let b = (~children, ()) => (); + + let thisIsOkay = + ; + + let thisIsAlsoOkay = + ; + + /* Doesn't make any sense, but suppose you defined an + infix operator to compare jsx */ + < ; + > ; + + < ; + > ; + + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [ + <> , + <> , + ]; + let listOfListOfJsx = [ + <> , + <> , + ...listOfListOfJsx, + ]; + + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [ + <> , + <> , + ]; + let sameButWithSpaces = [ + <> , + <> , + ...sameButWithSpaces, + ]; + + /* + * Test named tag right next to an open bracket. + */ + + let listOfJsx = []; + let listOfJsx = []; + let listOfJsx = [, ]; + let listOfJsx = [ + , + , + ...listOfJsx, + ]; + + let sameButWithSpaces = []; + let sameButWithSpaces = []; + let sameButWithSpaces = [, ]; + let sameButWithSpaces = [ + , + , + ...sameButWithSpaces, + ]; + + /** + * Test no conflict with polymorphic variant types. + */ + type thisType = [ | `Foo | `Bar]; + type t('a) = [< thisType] as 'a; + + let asd = + [@foo] "a" "b" ; + let asd2 = + [@foo] + + "a" + "b" + ; + + let span = + (~test: bool, ~foo: int, ~children, ()) => 1; + let asd = + [@foo] "a" "b" ; + /* "video" call doesn't end with a list, so the expression isn't converted to JSX */ + let video = (~test: bool, children) => children; + let asd2 = [@foo] [@JSX] video(~test=false, 10); + + let div = (~children) => 1; + [@JSX] ((() => div)())(~children=[]); + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + let myFun = () => { + <> ; + }; + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + /** + * Children should wrap without forcing attributes to. + */ + + + + + + ; + + /** + * Failing test cases: + */ + /* let res = ) > */ + /* */ + /* ; */ + + /* let res = ) />; */ + let zzz = Some("oh hai"); + /* this should be the only test that generates a warning. We're explicitly testing for this */ + let optionalCallSite = + ; + fakeRender(optionalCallSite); + let optionalArgument = ; + fakeRender(optionalArgument); + let optionalArgument = + ; + fakeRender(optionalArgument); + let defaultArg = ; + fakeRender(defaultArg); + let defaultArg = ; + fakeRender(defaultArg); + + ([@bla] + [@JSX] + NotReallyJSX.createElement([], ~foo=1, ~bar=2)); + ([@bla] + [@JSX] + NotReallyJSX.createElement(~foo=1, [], ~bar=2)); + ([@bla] [@JSX] notReallyJSX([], ~foo=1)); + ([@bla] [@JSX] notReallyJSX(~foo=1, [], ~bar=2)); + + /* children can be at any position */ + ; + + ; + + /* preserve some other attributes too! */ + ([@bla] ); + ([@bla] ); + + ([@bla] ); + ([@bla] ); + + /* Overeager JSX punning #1099 */ + module Metal = { + let fiber = "fiber"; + }; + + module OverEager = { + let createElement = (~fiber, ~children, ()) => { + displayName: "test", + }; + }; + + let element = ; + + type style = { + width: int, + height: int, + paddingTop: int, + paddingLeft: int, + paddingRight: int, + paddingBottom: int, + }; + + module Window = { + let createElement = (~style, ~children, ()) => { + displayName: "window", + }; + }; + + let w = + ; + + let foo = None; + + let g = ; + + /* https://github.com/facebook/reason/issues/1428 */ + ...element ; + + ...{a => 1} ; + + ... ; + + ...[|a|] ; + + ...(1, 2) ; + + module Foo3 = { + let createElement = (~bar, ~children, ()) => + (); + }; + + } />; + + let onClickHandler = () => (); + + let div = (~onClick, ~children, ()) => (); + +
+ <> "foobar" +
; + + /* + * This is identical to just having "foobar" as a single JSX child (which means + * it's in a list). + */ + let yetAnotherDiv = +
"foobar"
; + + let tl = []; + + /* + * Spreading a list that has an identifier/expression as its tail. This should + * preserve the spread and preserve the braces. [list] is not considered + * simple for the purposes of spreading into JSX, or as a child. + */ +
+ ...{[yetAnotherDiv, ...tl]} +
; + + /* + * This is equivalent to having no children. + */ +
; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", line 460, characters 23-26: diff --git a/test/4.12/attributes-re.t/run.t b/test/4.12/attributes-re.t/run.t index 7e1748897..ac4687d77 100644 --- a/test/4.12/attributes-re.t/run.t +++ b/test/4.12/attributes-re.t/run.t @@ -1,6 +1,834 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + /** + * Generally, dangling attributes [@..] apply to everything to the left of it, + * up until a comma, equals asignment, arrow, bar, or infix symbol (+/-) or + * prefix. + * + * This has a nice side effect when printing the terms: + * If a node has attributes attached to it, + */; + + /**Floating comment text should be removed*/; + + /** + * Core language features: + * ---------------------- + */; + + /**Floating doc text should be removed*/; + + /**removed text on type def*/ + [@itemAttributeOnTypeDef] + type itemText = int; + type nodeText = /**removed text on item*/ int; + /**removed text on type def*/ + [@itemAttributeOnTypeDef] + type nodeAndItemText = + /**removed text on item*/ int; + + /**removed doc on type def*/ + [@itemAttributeOnTypeDef] + type itemDoc = int; + [@itemAttributeOnTypeDef] + type nodeDoc = /**removed text on item*/ int; + /**removed doc on type def*/ + [@itemAttributeOnTypeDef] + type nodeAndItemDoc = + /**removed text on item*/ int; + + [@itemAttributeOnTypeDef] + type x = int; + type attributedInt = [@onTopLevelTypeDef] int; + + [@itemAttributeOnTypeDef] + type attributedIntsInTuple = ( + [@onInt] int, + [@onFloat] float, + ); + + type myDataType('x, 'y) = + | MyDataType('x, 'y); + + type myType = + [@onEntireType] + myDataType( + [@onOptionInt] option(int), + [@onOption] option(float), + ); + + let thisInst: myType = + [@attOnEntireDatatype] + MyDataType(Some(10), Some(10.0)); + + let thisInst: myType = + [@attOnEntireDatatype] + MyDataType( + [@onFirstParam] Some(10), + Some(10.0), + ); + + let x = [@onHello] "hello"; + let x = [@onHello] "hello"; + + let x = "hello" ++ [@onGoodbye] "goodbye"; + let x = [@onHello] "hello" ++ "goodbye"; + let x = [@onHello] "hello" ++ "goodbye"; + let x = "hello" ++ [@onGoodbye] "goodbye"; + let x = [@onEverything] ("hello" ++ "goodbye"); + + let x = 10 + [@on20] 20; + let x = 10 + [@on20] 20; + let x = [@on10] 10 + 20; + let x = [@on10] 10 + 20; + let x = [@attrEverything] (10 + 20); + + let x = 10 - [@on20] 20; + let x = 10 - [@on20] 20; + let x = [@on10] 10 - 20; + let x = [@on10] 10 - 20; + let x = [@attrEntireEverything] (10 - 20); + + let x = true && [@onFalse] false; + let x = true && [@onFalse] false; + let x = [@onTrue] true && false; + let x = [@onTrue] true && false; + let x = [@attrEverything] (true && false); + + /* now make sure to try with variants (tagged and `) */ + + /** + * How attribute parsings respond to other syntactic constructs. + */ + let add = a => + [@onRet] + { + a; + }; + let add = a => [@onRet] a; + let add = [@onEntireFunction] (a => a); + + let res = + if (true) {false} else {[@onFalse] false}; + let res = + [@onEntireIf] (if (true) {false} else {false}); + + let add = (a, b) => + [@onEverything] ([@onA] a + b); + let add = (a, b) => + [@onEverything] ([@onA] a + [@onB] b); + let add = (a, b) => a + [@onB] b; + + let both = [@onEntireFunction] (a => a); + let both = (a, b) => + [@onEverything] ([@onA] a && b); + let both = (a, b) => + [@onA] a && [@onB] [@onB] b; + let both = (a, b) => [@onEverything] (a && b); + + let thisVal = 10; + let x = + 20 + + (- [@onFunctionCall] add(thisVal, thisVal)); + let x = + [@onEverything] + (20 + (- add(thisVal, thisVal))); + let x = + - [@onFunctionCall] add(thisVal, thisVal); + let x = + [@onEverything] (- add(thisVal, thisVal)); + + let bothTrue = (x, y) => {contents: x && y}; + let something = + [@onEverythingToRightOfEquals] + (bothTrue(true, true))^; + let something = + ([@onlyOnArgumentToBang] bothTrue(true, true)) + ^; + + let res = + [@appliesToEntireFunctionApplication] + add(2, 4); + [@appliesToEntireFunctionApplication] + add(2, 4); + + let myObj = {pub p = () => {pub z = () => 10}}; + + let result = + [@onSecondSend] + ([@attOnFirstSend] myObj#p())#z(); + + [@onRecordFunctions] + type recordFunctions = { + p: unit => [@onUnit] recordFunctions, + q: [@onArrow] (unit => unit), + } + [@onUnusedType] + and unusedType = unit; + [@onMyRecord] + let rec myRecord = { + p: () => myRecord, + q: () => (), + } + [@onUnused] + and unused = (); + let result = + [@onSecondSend] + ([@attOnFirstSend] myRecord.p()).q(); + + [@onVariantType] + type variantType = + | [@onInt] Foo(int) + | Bar([@onInt] int) + | Baz; + + [@onVariantType] + type gadtType('x) = + | Foo(int): [@onFirstRow] gadtType(int) + | Bar([@onInt] int) + : [@onSecondRow] gadtType(unit) + | Baz: [@onThirdRow] gadtType([@onUnit] unit); + + [@floatingTopLevelStructureItem hello]; + [@itemAttributeOnEval] + print_string("hello"); + + [@itemAttrOnFirst] + let firstBinding = "first" + [@itemAttrOnSecond] + and secondBinding = "second"; + + /** + * Let bindings. + * ---------------------- + */ + let showLets = () => + [@onOuterLet] + { + let tmp = 20; + [@onFinalLet] + { + let tmpTmp = tmp + tmp; + tmpTmp + tmpTmp; + }; + }; + + /** + * Classes: + * ------------ + */ + /** + * In curried sugar, the class_expr attribute will apply to the return. + */ + [@moduleItemAttribute] + class boxA ('a) (init: 'a) = + [@onReturnClassExpr] { + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + pub pr = init + init + init; + }; + + /** + * In non-curried sugar, the class_expr still sticks to "the simple thing". + */ + class boxB ('a) (init: 'a) = + [@stillOnTheReturnBecauseItsSimple] { + pub pr = init + init + init; + }; + + /* To be able to put an attribute on just the return in that case, use + * parens. */ + [@onBoxC + x; + y + ] + class boxC ('a) = + [@onEntireFunction] ( + fun (init: 'a) => + [@onReturnClassExpr] { + pub pr = init + init + init; + } + ); + + [@moduleItemAttribute onTheTupleClassItem] + class tupleClass ('a, 'b) (init: ('a, 'b)) = { + let one = [@exprAttr ten] 10; + let two = [@exprAttr twenty] 20 + and three = [@exprAttr thirty] 30; + [@pr prMember] pub pr = one + two + three; + }; + + [@structureItem] + class type addablePointClassType = { + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; + } + [@structureItem] + and anotherClassType = { + pub foo: int; + pub bar: int; + }; + + class type _x = + [@bs] + { + pub height: int; + }; + + class type _y = { + [@bs.set] + pub height: int; + }; + + [@attr] + class type _z = { + pub height: int; + }; + + module NestedModule = { + [@floatingNestedStructureItem hello]; + }; + [@structureItem] + module type HasAttrs = { + [@onTypeDef] + type t = int; + [@floatingNestedSigItem hello]; + [@sigItem] + class type foo = { + pub foo: int; + pub bar: int; + }; + [@sigItem] + class fooBar: (int) => foo; + /**Floating comment text should be removed*/; + /**Floating comment text should be removed*/; + }; + + type s = + | S(string); + + let S([@onStr] str) = S([@onHello] "hello"); + let [@onConstruction] S(str) = + [@onConstruction] S("hello"); + + type xy = + | X(string) + | Y(string); + + let myFun = + ( + [@onConstruction] X(hello) | + [@onConstruction] Y(hello), + ) => hello; + let myFun = + ( + X([@onHello] hello) | Y([@onHello] hello), + ) => hello; + + /* Another bug: Cannot have an attribute on or pattern + let myFun = fun ((X(hello) | Y(hello)) [@onOrPattern]) => hello; + */ + + /* Bucklescript FFI item attributes */ + + [@bs.val] + external imul: (int, int) => int = "Math.imul"; + + module Js = { + type t('a); + }; + + type classAttributesOnKeys = { + . + [@bs.set] key1: string, + /* The follow two are the same */ + [@bs.get + { + null; + } + ] + key2: [@onType2] Js.t(int), + [@bs.get + { + null; + } + ] + key3: [@onType2] Js.t(int), + key4: Js.t([@justOnInt] int), + }; + + /* extensible variants */ + type attr = ..; + + [@block] + type attr += + | [@tag1] [@tag2] Str + | [@tag3] Float; + + type reconciler('props) = ..; + + [@onVariantType] + type reconciler('props) += + | Foo(int): [@onFirstRow] reconciler(int) + | Bar([@onInt] int): [@onSecondRow] + reconciler(unit) + | [@baz] + Baz: [@onThirdRow] + reconciler([@onUnit] unit); + + type water = ..; + + type water += + pri + | [@foo] [@foo2] MineralWater + | SpringWater; + + type cloud = string; + + type water += + pri + | [@h2o] PreparedWater + | [@nature] RainWater(cloud) + | [@toxic] + MeltedSnowWaterFromNuclearWastelandWithALineBreakBecauseTheNameIsSoLong; + + /* reasonreact */ + type element; + + type reactElement; + + type reactClass; + + /* "react-dom" shouldn't spread the attribute over multiple lines */ + [@bs.val] [@bs.module "react-dom"] + external render: (reactElement, element) => unit = + "render"; + + [@bs.module "f"] external f: int => int = "f"; + + [@bs.val] [@bs.module "react"] [@bs.splice] + external createCompositeElementInternalHack: + ( + reactClass, + {.. "reasonProps": 'props}, + array(reactElement) + ) => + reactElement = + "createElement"; + + external add_nat: (int, int) => int = + "add_nat_bytecode" "add_nat_native"; + + [@bs.module "Bar"] + [@ocaml.deprecated + "Use bar instead. It's a much cooler function. This string needs to be a little long" + ] + external foo: bool => bool; + + /* Attributes on an entire polymorphic variant leaf */ + [@bs.module "fs"] + external readFileSync: + ( + ~name: string, + [@bs.string] [ + | `utf8 + | [@bs.as "ascii"] `my_name + ] + ) => + string; + + [@bs.module "fs"] + external readFileSync2: + ( + ~name: string, + [@bs.string] [ + | [@bs.as "ascii"] `utf8 + | [@bs.as "ascii"] `my_name + ] + ) => + string; + + /* Ensure that attributes on extensions are printed */ + [@test [@attr] [%%extension]]; + + external debounce: + (int, [@bs.meth] unit) => unit; + + external debounce: (int, [@bs.meth] unit) => unit = + "debounce"; + + external debounce: + (int, [@bs.meth] unit) => unit; + + external debounce: + int => [@bs.meth] (unit => unit); + + external debounce: + (int, [@bs.meth] (unit => unit)) => + [@bs.meth] (unit => unit); + + external debounce: + ( + int, + [@bs.meth] (unit => unit), + [@bs.meth] (unit => unit) + ) => + [@bs.meth] (unit => unit); + + external debounce: + ( + int, + [@bs.meth] (unit => unit), + [@bs.meth] ( + unit => [@bs.meth] (unit => unit) + ) + ) => + [@bs.meth] (unit => unit); + + let x = "hi"; + + let res = + switch (x) { + | _ => + [@attr] + open String; + open Array; + concat; + index_from; + }; + + let res = + switch (x) { + | _ => [@attr] String.(Array.(concat)) + }; + + /* GADT */ + type value = + | [@foo] VBool'(bool): [@bar] value + | VInt'(int): value; + + /** Different payloads **/ + + /* Empty structure */ + [@haha] + let x = 5; + + /* Expression structure */ + [@haha "hello world"] + let x = 5; + + /* structure_item */ + [@haha let x = 5] + let x = 5; + + /* structure */ + [@haha + let x = 5; + module X = {} + ] + let x = 5; + + /* Pattern */ + [@haha? Some(_)] + let x = 5; + + /* Type */ + [@haha: option(int)] + let x = 5; + + /* Record item attributes */ + + type t_ = { + /** Comment attribute on record item */ + x: int, + }; + + type tt = { + [@attr "on record field"] + x: int, + }; + + type ttt = { + [@attr "on record field"] + x: [@attr "on type itself"] int, + }; + + type tttt = { + /** Comment attribute on record item */ + x: int, + [@regularAttribute "on next item"] + y: int, + }; + + type ttttt = { + [@attr "moved to first row"] [@attr] + x: int, + }; + + type tttttt = { + [@attr "testing with mutable field"] + mutable x: int, + }; + + let tmp = + /** On if statement */ + (if (true) {true} else {false}); + + type foo = + option( + [@foo + [ + "how does this break", + "when long enough", + ] + ] ( + [@bar] (int => int), + [@baz] (int => int), + ), + ); + + module Callbacks = { + let cb = () => 1 + 1; + }; + + let test = { + let _x = 1; + [@attr1] + open Callbacks; + let _s = "hello" ++ "!"; + [@attr2] Callbacks.("hello" ++ "!"); + }; + + [@test.call string => string] + let processCommandItem = 12; + + module type Foo = { + [@someattr] + let foo: int => int; + }; + + [@bs.deriving abstract] + type t = { + /** Position (in the pre-change coordinate system) where the change ended. */ + [@bs.as "to"] [@bar] + to_: string, + }; + + [@bs.deriving abstract] + type editorConfiguration = { + /** Determines whether horizontal cursor movement through right-to-left (Arabic, Hebrew) text + is visual (pressing the left arrow moves the cursor left) + or logical (pressing the left arrow moves to the next lower index in the string, which is visually right in right-to-left text). + The default is false on Windows, and true on other platforms. */ + [@bs.optional] + rtlMoveVisually: bool, + }; + + module Fmt = { + let barBaz = () => (); + + type record = {x: int}; + }; + + Fmt.([@foo] barBaz()); + Fmt.([@foo] {x: 1}); + Fmt.([@foo] [1, 2, 3]); + Fmt.([@foo] (1, 2, 3)); + Fmt.([@foo] {val x = 10}); + + /** + * Attributes are associate with the identifier, function call, constructor + * appcation or constructor application pattern in front of it - up until a + * type constraint, an | (or) or an 'as'. + */ + + let punnned_lbl_a = (~lbl as [@ATTR] lbl) => lbl; + let punnned_lbl_b = (~lbl as [@ATTR] (lbl: int)) => lbl; + let punnned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lbl) => lbl; + let punnned_lbl_d = + (~lbl as [@ATTR] ([@ATTR2] lbl: int)) => lbl; + let punnned_lbl_e = + (~lbl as [@ATTR] [@ATTR2] (lbl: int)) => lbl; + + let punnned_lbl_f = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_g = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_h = (~lbl as [@ATTR] (lbl: int)) => lbl; + /** Attributes have lower precedence than type constraint. The following should + * be printed identically. */ + let punnned_lbl_i = (~lbl as [@ATTR] lbl: int) => lbl; + let punnned_lbl_i' = + (~lbl as [@ATTR] (lbl: int)) => lbl; + + let nonpunned_lbla = + (~lbl as [@ATTR] lblNonpunned) => lblNonpunned; + let nonpunned_lbl_b = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + let nonpunned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lblNonpunned) => lblNonpunned; + let nonpunned_lbl_d = + ( + ~lbl as + [@ATTR] ([@ATTR2] lblNonpunned: int), + ) => lblNonpunned; + let nonpunned_lbl_e = + ( + ~lbl as + [@ATTR] [@ATTR2] (lblNonpunned: int), + ) => lblNonpunned; + + let nonpunned_lbl_f = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_g = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_h = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + + let nonpunned_lbl_i = + (~lbl as [@ATTR] lblNonpunned: int) => lblNonpunned; + let nonpunned_lbl_i' = + (~lbl as [@ATTR] (lblNonpunned: int)) => lblNonpunned; + + let defaulted_punnned_lbl_a = + (~lbl as [@ATTR] lbl=0, ()) => lbl; + let defaulted_punnned_lbl_b = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + let defaulted_punnned_lbl_c = + (~lbl as [@ATTR] [@ATTR2] lbl=0, ()) => lbl; + let defaulted_punnned_lbl_d = + (~lbl as [@ATTR] ([@ATTR2] lbl: int)=0, ()) => lbl; + let defaulted_punnned_lbl_e = + (~lbl as [@ATTR] [@ATTR2] (lbl: int)=0, ()) => lbl; + + let defaulted_punnned_lbl_f = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_g = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_h = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + /** Attributes have lower precedence than type constraint. The following should + * be printed identically. */ + let defaulted_punnned_lbl_i = + (~lbl as [@ATTR] lbl: int=0, ()) => lbl; + let defaulted_punnned_lbl_i' = + (~lbl as [@ATTR] (lbl: int)=0, ()) => lbl; + + let defaulted_nonpunned_lbla = + (~lbl as [@ATTR] lblNonpunned=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_b = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_c = + ( + ~lbl as [@ATTR] [@ATTR2] lblNonpunned=0, + (), + ) => lblNonpunned; + let defaulted_nonpunned_lbl_d = + ( + ~lbl as [@ATTR] ([@ATTR2] lblNonpunned: int)=0, + (), + ) => lblNonpunned; + let defaulted_nonpunned_lbl_e = + ( + ~lbl as [@ATTR] [@ATTR2] (lblNonpunned: int)=0, + (), + ) => lblNonpunned; + + let defaulted_nonpunned_lbl_f = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_g = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_h = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + + let defaulted_nonpunned_lbl_i = + (~lbl as [@ATTR] lblNonpunned: int=0, ()) => lblNonpunned; + let defaulted_nonpunned_lbl_i' = + (~lbl as [@ATTR] (lblNonpunned: int)=0, ()) => lblNonpunned; + + /* Won't parse: let [@attr] x1 : int = xInt; */ + let xInt = 0; + + /** + Attribute on the pattern node inside of constraint + pattern ( + Ppat_constraint( + pattern(@xxx, Ppat_var "x"), + coretype + ) + ) + This will get sugared to `let ([@attr] x2) : int = xInt` + */ + let ([@attr] x2): int = xInt; + /** + Attribute on the pattern holding the constraint: + pattern( + @xxx + Ppat_constraint( + pattern(Pexpident "x"), + coretype + ) + ) + */ + let [@attr] (x3: int) = xInt; + let [@attr] ([@attr0] x4: int) = xInt; + let [@attr] ([@attr0] x5: int) = xInt; + + type eitherOr('a, 'b) = + | Either('a) + | Or('b); + let [@attr] Either(a) | Or(a) = Either("hi"); + // Can drop the the parens around Either. + let [@attr] Either(a) | Or(a) = Either("hi"); + // Can drop the parens around Or. + let Either(b) | [@attr] Or(b) = Either("hi"); + // Should keep the parens around both + let [@attr] (Either(a) | Or(a)) = Either("hi"); + + // Should keep the parens + let [@attr] (_x as xAlias) = 10; + // Should drop the parens + let [@attr] _x as xAlias' = 10; + + /** + Attribute on the expression node inside of constraint + expression( + Pexp_constraint( + expression(@xxx, Pexpident "x"), + coretype + ) + ) + */ + let _ = ([@xxx] xInt: int); // This should format the same + let _ = ([@xxx] xInt: int); // This should format the same + + /** + Attribute on the expression holding the constraint: + expression( + @xxx + Pexp_constraint( + expression(Pexpident "x"), + coretype + ) + ) + */ + let _ = [@xxx] (xInt: int); // This should format the same + + [@foo? [@attr] (x: int)]; + [@foo? [@attr] ([@bar] x: int)]; + [@foo? [@attr] (Either("hi") | Or("hi"))]; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", line 503, characters 4-10: diff --git a/test/4.12/dune b/test/4.12/dune index a978469fc..e97d060f7 100644 --- a/test/4.12/dune +++ b/test/4.12/dune @@ -5,7 +5,7 @@ (enabled_if (and (or - (= %{system} "mac") + (= %{system} "macosx") (= %{system} "linux")) (or (= %{ocaml_version} 4.12.0) diff --git a/test/4.12/reasonComments-re.t/run.t b/test/4.12/reasonComments-re.t/run.t index 6e82e63bc..248fa9a5d 100644 --- a/test/4.12/reasonComments-re.t/run.t +++ b/test/4.12/reasonComments-re.t/run.t @@ -1,6 +1,765 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + 3; /* - */ + 3; /*-*/ + + 3; /*-*/ + + 3 /*-*/; + /* **** comment */ + /*** comment */ + /** docstring */ + /* comment */ + /** docstring */ + /*** comment */ + /**** comment */ + /***** comment */ + /** */ + /*** */ + /**** */ + /**/ + /***/ + /****/ + /** (** comment *) */ + /** (*** comment *) */ + /* (** comment *) */ + /* (*** comment *) */ + /* *(*** comment *) */ + /* comment **/ + /* comment ***/ + /* comment ****/ + /* comment *****/ + /** + * Multiline + */ + /** Multiline + * + */ + /** + ** + */ + module JustString = { + include Map.Make(Int32); /* Comment eol include */ + }; + + let testingEndOfLineComments = [ + "Item 1" /* Comment For First Item */, + "Item 2" /* Comment For Second Item */, + "Item 3" /* Comment For Third Item */, + "Item 4" /* Comment For Fourth Item - but before trailing comma */, + /* Comment after last item in list. */ + ] /* Comment after rbracket */; + + /* But if you place them after the comma at eol, they're preserved as such */ + let testingEndOfLineComments = [ + "Item 1", /* Comment For First Item */ + "Item 2", /* Comment For Second Item */ + "Item 3", /* Comment For Third Item */ + "Item 4" /* Comment For Fourth Item - but before trailing comma */, + /* Comment after last item in list. */ + ] /* Comment after rbracket */; + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + /* Try again but without other things in the list */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + ]; /* Comment after semi */ + + /* The space between ; and comment shoudn't matter */ + let testPlacementOfTrailingComment = [ + "Item 0" /* */ + /* Comment after last item in list. */ + ]; /* Comment after semi */ + + let testingEndOfLineComments = []; /* Comment after entire let binding */ + + /* The following is not yet idempotent */ + /* let myFunction */ + /* withFirstArg /* First arg */ */ + /* andSecondArg => { /* Second Arg */ */ + /* withFirstArg + andSecondArg /* before semi */ ; */ + /* }; */ + + let myFunction = /* First arg */ + ( + withFirstArg, + /* Second Arg */ + andSecondArg, + ) => { + withFirstArg + andSecondArg; + }; /* After Semi */ + + type point = { + x: string, /* x field */ + y: string /* y field */ + }; + + type pointWithManyKindsOfComments = { + /* Line before x */ + x: string, /* x field */ + /* Line before y */ + y: string /* y field */ + /* Final row of record */ + }; + + type typeParamPointWithComments('a) = { + /* Line before x */ + x: 'a, /* x field */ + /* Line before y */ + y: 'a /* y field */ + /* Final row of record */ + }; + + /* Now, interleaving comments in type params */ + /* Type name */ + type typeParamPointWithComments2 + /* The a type param */ + ( + 'a, + /* The b type apram */ + 'b, + ) = { + /* Line before x */ + x: 'a, /* x field */ + /* Line before y */ + y: 'a /* y field */ + /* Final row of record */ + }; + + /* The way the last row comment is formatted is suboptimal becuase + * record type definitions do not include enough location information */ + type anotherpoint = { + x: string, /* x field */ + y: string /* y field */ + /* comment as last row of record */ + }; + + type t = (int, int); /* End of line on t */ + type t2 = (int, int); /* End of line on (int, int) */ + + type t3 = (int, int); /* End of line on (int, int) */ + + type variant = + | X(int, int) /* End of line on X */ + | Y(int, int); /* End of line on Y */ /* Comment on entire type def for variant */ + + /* Before let */ + let res = + /* Before switch */ + switch (X(2, 3)) { + /* Above X line */ + | X(_) => "result of X" /* End of arrow and X line */ + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; /* After final semi in switch */ + + let res = + switch (X(2, 3)) { + | X(0, 0) => + /* After X arrow */ + "result of X" /* End of X body line */ + | X(1, 0) /* Before X's arrow */ => "result of X" /* End of X body line */ + | X(_) => + /* After X _ arrow */ + "result of X" /* End of X body line */ + /* Above Y line */ + | Y(_) => + /* Comment above Y body */ + "result of Y" + }; + + type variant2 = + /* Comment above X */ + | X(int, int) /* End of line on X */ + /* Comment above Y */ + | Y(int, int); + + type variant3 = + /* Comment above X */ + | X(int, int) /* End of line on X */ + /* Comment above Y */ + | Y(int, int); /* End of line on Y */ + + type x = { + /* not attached *above* x */ + fieldOne: int, + fieldA: int, + } /* Attached end of line after x */ + and y = { + /* not attached *above* y */ + fieldTwo: int, + }; /* Attached end of line after y */ + + type x2 = { + /* not attached *above* x2 */ + fieldOne: int, + fieldA: int, + } /* Attached end of line after x2 */ + and y2 = { + /* not attached *above* y2 */ + fieldTwo: int, + }; + + let result = + switch (None) { + | Some({fieldOne: 20, fieldA: a}) => + /* Where does this comment go? */ + let tmp = 0; + 2 + tmp; + | Some({fieldOne: n, fieldA: a}) => + /* How about this one */ + let tmp = n; + n + tmp; + | None => 20 + }; + + let res = + /* Before switch */ + switch (X(2, 3)) { + /* Above X line */ + | X(_) => "result of X" /* End of arrow and X line */ + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; + + /* + * Now these end of line comments *should* be retained. + */ + let result = + switch (None) { + | Some({ + fieldOne: 20, /* end of line */ + fieldA: a /* end of line */ + }) => + let tmp = 0; + 2 + tmp; + | Some({ + fieldOne: n, /* end of line */ + fieldA: a /* end of line */ + }) => + let tmp = n; + n + tmp; + | None => 20 + }; + + /* + * These end of line comments *should* be retained. + * To get the simple expression eol comment to be retained, we just need to + * implement label breaking eol behavior much like we did with sequences. + * Otherwise, right now they are not idempotent. + */ + let res = + switch ( + /* Retain this */ + X(2, 3) + ) { + /* Above X line */ + | X( + _, /* retain this */ + _ /* retain this */ + ) => "result of X" + + /* Above Y line */ + | Y(_) => "result of Y" /* End of arrow and Y line */ + }; + + type optionalTuple = + | OptTup( + option( + ( + int, /* First int */ + int /* Second int */ + ), + ), + ); + + type optionTuple = + option( + ( + int, /* First int */ + int /* Second int */ + ), + ); + + type intPair = ( + int, /* First int */ + int /* Second int */ + ); + type intPair2 = ( + /* First int */ + int, + /* Second int */ + int, + ); + + let result = + /**/ + { + 2 + 3; + }; + + /* This is not yet idempotent */ + /* { */ + /* /**/ */ + /* (+) 2 3 */ + /* }; */ + + let a = (); + for (i in 0 to 10) { + /* bla */ + a; + }; + + if (true) { + /* hello */ + () + }; + + type color = + | Red(int) /* After red end of line */ + | Black(int) /* After black end of line */ + | Green(int); /* After green end of line */ /* On next line after color type def */ + + let blahCurriedX = x => + fun + | Red(10) + | Black(20) + | Green(10) => 1 /* After or pattern green */ + | Red(x) => 0 /* After red */ + | Black(x) => 0 /* After black */ + | Green(x) => 0; /* After second green */ /* On next line after blahCurriedX def */ + + let name_equal = (x, y) => { + x == y; + }; + + let equal = (i1, i2) => + i1.contents === i2.contents && true; /* most unlikely first */ + + let equal = (i1, i2) => + compare(compare(0, 0), compare(1, 1)); /* END OF LINE HERE */ + + let tuple_equal = ((i1, i2)) => i1 == i2; + + let tuple_equal = ((csu, mgd)) => + /* Some really long comments, see https://github.com/facebook/reason/issues/811 */ + tuple_equal((csu, mgd)); + + /** Comments inside empty function bodies + * See https://github.com/facebook/reason/issues/860 + */ + let fun_def_comment_inline = () => {/* */}; + + let fun_def_comment_newline = () => {/* */}; + + let fun_def_comment_long = () => { + /* longer comment inside empty function body */ + }; + + let trueThing = true; + + for (i in 0 to 1) { + /* comment */ + print_newline(); + }; + + while (trueThing) { + /* comment */ + print_newline(); + }; + + if (trueThing) { + /* comment */ + print_newline(); + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + } else { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + } else { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); + /* Comment after final print */ + }; + + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + } else { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before if test */ + if (trueThing) { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + } else { + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment before print */ + print_newline(); /* eol print */ + /* Comment after print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before while test */ + while (trueThing) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + /* Comment before for test */ + for (i in 0 to 100) { + /* Comment before print */ + print_newline(); /* eol */ + /* Comment after final print */ + }; + + let f = (a, b, c, d) => a + b + c + d; + + while (trueThing) { + f( + /* a */ + 1, + /* b */ + 2, + /* c */ + 3, + /* d */ + 4, + /* does work */ + ); + }; + while (trueThing) { + f( + /* a */ + 1, + /* b */ + 2, + /* c */ + 3, + /* d */ + 4 /* does work */ + ); + }; + + ignore( + ( + _really, + _long, + _printWidth, + _exceeded, + _here, + ) => { + /* First comment */ + let x = 0; + x + x; + /* Closing comment */ + }); + + ignore((_xxx, _yyy) => { + /* First comment */ + let x = 0; + x + x; + /* Closing comment */ + }); + + type tester('a, 'b) = + | TwoArgsConstructor('a, 'b) + | OneTupleArgConstructor(('a, 'b)); + let callFunctionTwoArgs = (a, b) => (); + let callFunctionOneTuple = tuple => (); + + let y = + TwoArgsConstructor( + 1, /*eol1*/ + 2 /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + 1, /*eol1*/ + 2 /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + 1, /*eol1*/ + 2 /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + 1, /*eol1*/ + 2 /* eol2 */ + )); + + type polyRecord('a, 'b) = { + fieldOne: 'a, + fieldTwo: 'b, + }; + + let r = { + fieldOne: 1, /*eol1*/ + fieldTwo: 2 /* eol2 */ + }; + + let r = { + fieldOne: 1, /*eol1*/ + fieldTwo: 2 /* eol2 with trailing comma */ + }; + + let y = + TwoArgsConstructor( + "1", /*eol1*/ + "2" /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + "1", /*eol1*/ + "2" /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + "1", /*eol1*/ + "2" /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + "1", /*eol1*/ + "2" /* eol2 */ + )); + + let r = { + fieldOne: "1", /*eol1*/ + fieldTwo: "2" /* eol2 */ + }; + + let r = { + fieldOne: "1", /*eol1*/ + fieldTwo: "2" /* eol2 with trailing comma */ + }; + + let identifier = "hello"; + + let y = + TwoArgsConstructor( + identifier, /*eol1*/ + identifier /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + identifier, /*eol1*/ + identifier /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + identifier, /*eol1*/ + identifier /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + identifier, /*eol1*/ + identifier /* eol2 */ + )); + + let r = { + fieldOne: identifier, /*eol1*/ + fieldTwo: identifier /* eol2 */ + }; + + let r = { + fieldOne: identifier, /*eol1*/ + fieldTwo: identifier /* eol2 with trailing comma */ + }; + + let y = + TwoArgsConstructor( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + ); + + let y = + callFunctionTwoArgs( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + ); + + let y = + OneTupleArgConstructor(( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + )); + + let y = + callFunctionOneTuple(( + identifier: string, /*eol1*/ + identifier: string /* eol2 */ + )); + + let r = { + fieldOne: (identifier: string), /*eol1*/ + fieldTwo: (identifier: string) /* eol2 */ + }; + + let r = { + fieldOne: (identifier: string), /*eol1*/ + fieldTwo: (identifier: string) /* eol2 with trailing comma */ + }; + + /** doc comment */ + [@bs.send] + external url: t => string; + + /** + * Short multiline doc comment + */ + [@bs.send] + external url: t => string; + + /** Longer doc comment before an attribute on an external. */ + [@bs.send] + external url: t => string; + + /* normal comment */ + [@bs.send] external url: t => string; + + /** doc type */ + type q = { + a: int, + b: string, + }; + + /** doc let */ + let letter: q = {a: 42, b: "answer"}; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", lines 536-548, characters 18-1: diff --git a/test/4.12/type-jsx.t/run.t b/test/4.12/type-jsx.t/run.t index 97605e669..1b9fe642a 100644 --- a/test/4.12/type-jsx.t/run.t +++ b/test/4.12/type-jsx.t/run.t @@ -1,6 +1,593 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + type component = {displayName: string}; + + module Bar = { + let createElement = (~c=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Nesting = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Much = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo = { + let createElement = + (~a=?, ~b=?, ~children, ()) => { + displayName: "test", + }; + }; + + module One = { + let createElement = + (~test=?, ~foo=?, ~children, ()) => { + displayName: "test", + }; + + let createElementobvioustypo = + (~test, ~children, ()) => { + displayName: "test", + }; + }; + + module Two = { + let createElement = (~foo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Sibling = { + let createElement = + (~foo=?, ~children: list(component), ()) => { + displayName: "test", + }; + }; + + module Test = { + let createElement = (~yo=?, ~children, ()) => { + displayName: "test", + }; + }; + + module So = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Foo2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Text = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Exp = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module Pun = { + let createElement = + (~intended=?, ~children, ()) => { + displayName: "test", + }; + }; + + module Namespace = { + module Foo = { + let createElement = + ( + ~intended=?, + ~anotherOptional as x=100, + ~children, + (), + ) => { + displayName: "test", + }; + }; + }; + + module Optional1 = { + let createElement = (~required, ~children, ()) => { + switch (required) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module Optional2 = { + let createElement = + (~optional=?, ~children, ()) => { + switch (optional) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module DefaultArg = { + let createElement = + (~default=Some("foo"), ~children, ()) => { + switch (default) { + | Some(a) => {displayName: a} + | None => {displayName: "nope"} + }; + }; + }; + + module LotsOfArguments = { + let createElement = + ( + ~argument1=?, + ~argument2=?, + ~argument3=?, + ~argument4=?, + ~argument5=?, + ~argument6=?, + ~children, + (), + ) => { + displayName: "test", + }; + }; + + let div = (~argument1=?, ~children, ()) => { + displayName: "test", + }; + + module List1 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List2 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module List3 = { + let createElement = (~children, ()) => { + displayName: "test", + }; + }; + + module NotReallyJSX = { + let createElement = (~foo, ~bar, children) => { + displayName: "test", + }; + }; + + let notReallyJSX = (~foo, ~bar, children) => { + displayName: "test", + }; + + let fakeRender = (el: component) => { + el.displayName; + }; + + /* end of setup */ + + let (/><) = (a, b) => a + b; + let (><) = (a, b) => a + b; + let (/>) = (a, b) => a + b; + let (> a + b; + + let tag1 = 5 />< 6; + let tag2 = 5 >< 7; + let tag3 = 5 /> 7; + let tag4 = 5 >; + let selfClosing2 = ; + let selfClosing3 = + ; + let a = a + 2} /> ; + let a3 = ; + let a4 = + + + + ; + let a5 = "testing a string here" ; + let a6 = + + "testing a string here" + + "another string" + + {2 + 4} + ; + let intended = true; + let punning = ; + let namespace = ; + let c = ; + let d = ; + + let spaceBefore = + ; + let spaceBefore2 = ; + let siblingNotSpaced = + ; + let jsxInList = []; + let jsxInList2 = []; + let jsxInListA = []; + let jsxInListB = []; + let jsxInListC = []; + let jsxInListD = []; + let jsxInList3 = [, , ]; + let jsxInList4 = [, , ]; + let jsxInList5 = [, ]; + let jsxInList6 = [, ]; + let jsxInList7 = [, ]; + let jsxInList8 = [, ]; + let testFunc = b => b; + let jsxInFnCall = testFunc(); + let lotsOfArguments = + + + ; + let lowerCase =
; + + let b = 0; + let d = 0; + /* + * Should pun the first example: + */ + let a = 5 ; + let a = 5 ; + let a = 5 ; + let a = 0.55 ; + let a = ; + let ident = a ; + let fragment1 = <> ; + let fragment2 = <> ; + let fragment3 = <> ; + let fragment4 = <> ; + let fragment5 = <> ; + let fragment6 = <> ; + let fragment7 = <> ; + let fragment8 = <> ; + let fragment9 = <> 2 2 2 2 ; + let fragment10 = <> 2.2 3.2 4.6 1.2 ; + let fragment11 = <> "str" ; + let fragment12 = <> {6 + 2} {6 + 2} {6 + 2} ; + let fragment13 = <> fragment11 fragment11 ; + let listOfItems1 = 1 2 3 4 5 ; + let listOfItems2 = + 1.0 2.8 3.8 4.0 5.1 ; + let listOfItems3 = + fragment11 fragment11 ; + + /* + * Several sequential simple jsx expressions must be separated with a space. + */ + let thisIsRight = (a, b) => (); + let tagOne = (~children, ()) => (); + let tagTwo = (~children, ()) => (); + /* thisIsWrong ; */ + thisIsRight(, ); + + /* thisIsWrong ; */ + thisIsRight(, ); + + let a = (~children, ()) => (); + let b = (~children, ()) => (); + + let thisIsOkay = + ; + + let thisIsAlsoOkay = + ; + + /* Doesn't make any sense, but suppose you defined an + infix operator to compare jsx */ + < ; + > ; + + < ; + > ; + + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [<> ]; + let listOfListOfJsx = [ + <> , + <> , + ]; + let listOfListOfJsx = [ + <> , + <> , + ...listOfListOfJsx, + ]; + + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [<> ]; + let sameButWithSpaces = [ + <> , + <> , + ]; + let sameButWithSpaces = [ + <> , + <> , + ...sameButWithSpaces, + ]; + + /* + * Test named tag right next to an open bracket. + */ + + let listOfJsx = []; + let listOfJsx = []; + let listOfJsx = [, ]; + let listOfJsx = [ + , + , + ...listOfJsx, + ]; + + let sameButWithSpaces = []; + let sameButWithSpaces = []; + let sameButWithSpaces = [, ]; + let sameButWithSpaces = [ + , + , + ...sameButWithSpaces, + ]; + + /** + * Test no conflict with polymorphic variant types. + */ + type thisType = [ | `Foo | `Bar]; + type t('a) = [< thisType] as 'a; + + let asd = + [@foo] "a" "b" ; + let asd2 = + [@foo] + + "a" + "b" + ; + + let span = + (~test: bool, ~foo: int, ~children, ()) => 1; + let asd = + [@foo] "a" "b" ; + /* "video" call doesn't end with a list, so the expression isn't converted to JSX */ + let video = (~test: bool, children) => children; + let asd2 = [@foo] [@JSX] video(~test=false, 10); + + let div = (~children) => 1; + [@JSX] ((() => div)())(~children=[]); + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + let myFun = () => { + <> ; + }; + + let myFun = () => { + <> + + + + + + + + + + + + ; + }; + + /** + * Children should wrap without forcing attributes to. + */ + + + + + + ; + + /** + * Failing test cases: + */ + /* let res = ) > */ + /* */ + /* ; */ + + /* let res = ) />; */ + let zzz = Some("oh hai"); + /* this should be the only test that generates a warning. We're explicitly testing for this */ + let optionalCallSite = + ; + fakeRender(optionalCallSite); + let optionalArgument = ; + fakeRender(optionalArgument); + let optionalArgument = + ; + fakeRender(optionalArgument); + let defaultArg = ; + fakeRender(defaultArg); + let defaultArg = ; + fakeRender(defaultArg); + + ([@bla] + [@JSX] + NotReallyJSX.createElement([], ~foo=1, ~bar=2)); + ([@bla] + [@JSX] + NotReallyJSX.createElement(~foo=1, [], ~bar=2)); + ([@bla] [@JSX] notReallyJSX([], ~foo=1)); + ([@bla] [@JSX] notReallyJSX(~foo=1, [], ~bar=2)); + + /* children can be at any position */ + ; + + ; + + /* preserve some other attributes too! */ + ([@bla] ); + ([@bla] ); + + ([@bla] ); + ([@bla] ); + + /* Overeager JSX punning #1099 */ + module Metal = { + let fiber = "fiber"; + }; + + module OverEager = { + let createElement = (~fiber, ~children, ()) => { + displayName: "test", + }; + }; + + let element = ; + + type style = { + width: int, + height: int, + paddingTop: int, + paddingLeft: int, + paddingRight: int, + paddingBottom: int, + }; + + module Window = { + let createElement = (~style, ~children, ()) => { + displayName: "window", + }; + }; + + let w = + ; + + let foo = None; + + let g = ; + + /* https://github.com/facebook/reason/issues/1428 */ + ...element ; + + ...{a => 1} ; + + ... ; + + ...[|a|] ; + + ...(1, 2) ; + + module Foo3 = { + let createElement = (~bar, ~children, ()) => + (); + }; + + } />; + + let onClickHandler = () => (); + + let div = (~onClick, ~children, ()) => (); + +
+ <> "foobar" +
; + + /* + * This is identical to just having "foobar" as a single JSX child (which means + * it's in a list). + */ + let yetAnotherDiv = +
"foobar"
; + + let tl = []; + + /* + * Spreading a list that has an identifier/expression as its tail. This should + * preserve the spread and preserve the braces. [list] is not considered + * simple for the purposes of spreading into JSX, or as a child. + */ +
+ ...{[yetAnotherDiv, ...tl]} +
; + + /* + * This is equivalent to having no children. + */ +
; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re File "formatted.re", line 460, characters 23-26: diff --git a/test/basic.t/run.t b/test/basic.t/run.t index 1ba7f761e..e9e1db7c1 100644 --- a/test/basic.t/run.t +++ b/test/basic.t/run.t @@ -1,5 +1,5 @@ See the typed tree from ./input.re - $ cat ./input.re | typedtree_printer + $ cat ./input.re | outcome_printer let x1: unit => int; let x2: 'a => int; let x3: (int, 'a) => int; diff --git a/test/basics.t/run.t b/test/basics.t/run.t index 14913bf7e..48e30419a 100644 --- a/test/basics.t/run.t +++ b/test/basics.t/run.t @@ -1,6 +1,147 @@ Format basic $ refmt --print re ./input.re > ./formatted.re -$ cat formatted.re + +Print formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + let l = + [1, 2, 3] + |> List.map(i => i + 1, _) + |> List.filter(i => i > 0, _); + + let l = (i => i + 1) |> List.map(_, [1, 2, 3]); + + let x = List.length(_); + + let nested = x => List.length(_); + + let incr = (~v) => v + 1; + + let l1 = + [1, 2, 3] + |> List.map(incr(~v=_)) + |> List.length; + + let l2 = + [1, 2, 3] + |> List.map(incr(~v=_)) + |> List.length; + + let a1 = [|1, 2, 3|] |> Array.get(_, 1); + + let s1 = "roses are red" |> String.get(_, 4); + + let optParam = (~v=?, ()) => v == None ? 0 : 1; + + let l1 = + [Some(1), None, Some(2)] + |> List.map(optParam(~v=?_, ())) + |> List.length; + + let l2 = + [Some(1), None, Some(2)] + |> List.map(optParam(~v=?_, ())) + |> List.length; + + let argIsUnderscore1 = _ => 34; + + let argIsUnderscore2 = _ => 34; + + let argIsUnderscore3 = _: int => 34; + + let argIsUnderscore4 = _: int => 34; + + let argIsUnderscore5 = (_: int) => 34; + + let argIsUnderscore6 = (_: int) => 34; + + type reasonXyz = + | X + | Y(int, int, int) + | Z(int, int) + | Q + | R; + + type reasonXyzWithOf = + | X + | Y(int, int, int) + | Z(int, int) + | Q + | R; + + let reasonBarAs = + fun + | ((Y(_) | Z(_)) as t, _) => { + let _ = t; + true; + } + | _ => false; + + let reasonDoubleBar = + fun + | X + | Y(_, _, _) + | Z(_, _) + | Q => true + | _ => false; + + let reasonDoubleBarNested = + fun + | X + | Y(_, _, _) + | Z(_, _) + | Q => true + | _ => false; + + /* Liberal use of the Any pattern being compatible with multiple + arguments */ + let reasonDoubleBarAnyPatterns = + fun + | X + | Y(_) + | Z(_) + | Q => true + | _ => false; + + let reasonDoubleBarNestedAnyPatterns = + fun + | X + | Y(_) + | Z(_) + | Q => true + | _ => false; + + let (\+) = (+); + + let a = 2.0 ** 4.0; + + let (\===) = (===); + + let expectedPrecendence = + 1 + 1 \=== 1 + 1 && 1 + 1 !== 1 + 1; + + let expectedPrecendence = + 1 \+ 1 \=== 1 \+ 1 && 1 \+ 1 !== 1 \+ 1; + + module X: { + let x: (~x: unit=?, unit) => unit; + } = { + let x = (~x=(), ()) => (); + }; + + let display = + ( + ~message=("hello": string), + ~person: string="Reason", + time: float, + ) => 1; + + let not = (x, y) => x + y; + + let added: int = not(1, 2); + + let better = foo => !foo ? 42 : not(41, 2); Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/basics_no_semi.t/input.re b/test/basics_no_semi.t/input.re index c84c95812..c528d70a1 100644 --- a/test/basics_no_semi.t/input.re +++ b/test/basics_no_semi.t/input.re @@ -14,6 +14,10 @@ let l1 = [1,2,3] |> List.map(incr(~v=_)) |> List.length let l2 = [1,2,3] |> List.map(incr(~v =_)) |> List.length +let a1 = [|1, 2, 3|] |> Array.get(_, 1) + +let s1 = "roses are red" |> String.get(_, 4) + let optParam = (~v=?, ()) => v == None ? 0 : 1 let l1 = @@ -86,3 +90,9 @@ module X: {let x: (~x: unit=?, unit) => unit} = { } let display (~message=("hello": string), ~person: string="Reason", time: float) = 1 + +let not = (x, y) => x + y + +let added: int = not(1, 2) + +let better = foo => !foo ? 42 : not(41, 2) diff --git a/test/basics_no_semi.t/run.t b/test/basics_no_semi.t/run.t index df08f6c0b..8dbe5c5ea 100644 --- a/test/basics_no_semi.t/run.t +++ b/test/basics_no_semi.t/run.t @@ -1,6 +1,147 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + let l = + [1, 2, 3] + |> List.map(i => i + 1, _) + |> List.filter(i => i > 0, _); + + let l = (i => i + 1) |> List.map(_, [1, 2, 3]); + + let x = List.length(_); + + let nested = x => List.length(_); + + let incr = (~v) => v + 1; + + let l1 = + [1, 2, 3] + |> List.map(incr(~v=_)) + |> List.length; + + let l2 = + [1, 2, 3] + |> List.map(incr(~v=_)) + |> List.length; + + let a1 = [|1, 2, 3|] |> Array.get(_, 1); + + let s1 = "roses are red" |> String.get(_, 4); + + let optParam = (~v=?, ()) => v == None ? 0 : 1; + + let l1 = + [Some(1), None, Some(2)] + |> List.map(optParam(~v=?_, ())) + |> List.length; + + let l2 = + [Some(1), None, Some(2)] + |> List.map(optParam(~v=?_, ())) + |> List.length; + + let argIsUnderscore1 = _ => 34; + + let argIsUnderscore2 = _ => 34; + + let argIsUnderscore3 = _: int => 34; + + let argIsUnderscore4 = _: int => 34; + + let argIsUnderscore5 = (_: int) => 34; + + let argIsUnderscore6 = (_: int) => 34; + + type reasonXyz = + | X + | Y(int, int, int) + | Z(int, int) + | Q + | R; + + type reasonXyzWithOf = + | X + | Y(int, int, int) + | Z(int, int) + | Q + | R; + + let reasonBarAs = + fun + | ((Y(_) | Z(_)) as t, _) => { + let _ = t; + true; + } + | _ => false; + + let reasonDoubleBar = + fun + | X + | Y(_, _, _) + | Z(_, _) + | Q => true + | _ => false; + + let reasonDoubleBarNested = + fun + | X + | Y(_, _, _) + | Z(_, _) + | Q => true + | _ => false; + + /* Liberal use of the Any pattern being compatible with multiple + arguments */ + let reasonDoubleBarAnyPatterns = + fun + | X + | Y(_) + | Z(_) + | Q => true + | _ => false; + + let reasonDoubleBarNestedAnyPatterns = + fun + | X + | Y(_) + | Z(_) + | Q => true + | _ => false; + + let (\+) = (+); + + let a = 2.0 ** 4.0; + + let (\===) = (===); + + let expectedPrecendence = + 1 + 1 \=== 1 + 1 && 1 + 1 !== 1 + 1; + + let expectedPrecendence = + 1 \+ 1 \=== 1 \+ 1 && 1 \+ 1 !== 1 \+ 1; + + module X: { + let x: (~x: unit=?, unit) => unit; + } = { + let x = (~x=(), ()) => (); + }; + + let display = + ( + ~message=("hello": string), + ~person: string="Reason", + time: float, + ) => 1; + + let not = (x, y) => x + y; + + let added: int = not(1, 2); + + let better = foo => !foo ? 42 : not(41, 2); Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/bigarraySyntax.t/run.t b/test/bigarraySyntax.t/run.t index df08f6c0b..275e68fbb 100644 --- a/test/bigarraySyntax.t/run.t +++ b/test/bigarraySyntax.t/run.t @@ -1,6 +1,58 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* https://github.com/facebook/reason/issues/2038 */ + let my_big_array1 = + Bigarray.Array1.create( + Bigarray.float32, + Bigarray.c_layout, + 20, + ); + + my_big_array1.{1}; + + my_big_array1.{1} = 1.0; + + let my_big_array2 = + Bigarray.Array2.create( + Bigarray.float32, + Bigarray.c_layout, + 20, + 20, + ); + + my_big_array2.{1, 2}; + + my_big_array2.{1, 2} = 1.0; + + let my_big_array3 = + Bigarray.Array3.create( + Bigarray.float32, + Bigarray.c_layout, + 20, + 20, + 20, + ); + + my_big_array3.{1, 2, 3}; + + my_big_array3.{1, 2, 3} = 1.0; + + let reallyLongStringThatWillDefinitelyBreakLine = 0; + + my_big_array3.{ + reallyLongStringThatWillDefinitelyBreakLine, + reallyLongStringThatWillDefinitelyBreakLine, + reallyLongStringThatWillDefinitelyBreakLine + }; + + my_big_array3.{ + reallyLongStringThatWillDefinitelyBreakLine, + reallyLongStringThatWillDefinitelyBreakLine, + reallyLongStringThatWillDefinitelyBreakLine + } = 3.0; Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/class.t/run.t b/test/class.t/run.t index e303dbb4f..ae8cb8aa7 100644 --- a/test/class.t/run.t +++ b/test/class.t/run.t @@ -1,5 +1,5 @@ See the typed tree from ./input.re - $ cat ./input.re | typedtree_printer + $ cat ./input.re | outcome_printer class aClass1 : ('a) => { diff --git a/test/dune b/test/dune index 186f5a9d5..ce17c8bbe 100644 --- a/test/dune +++ b/test/dune @@ -5,4 +5,4 @@ (cram (applies_to * \ lib) - (deps %{bin:ocamlc} %{bin:refmt} %{bin:typedtree_printer} %{bin:rtop})) + (deps %{bin:ocamlc} %{bin:refmt} %{bin:outcome_printer} %{bin:rtop})) diff --git a/test/imperative.t/run.t b/test/imperative.t/run.t index df08f6c0b..dfa85e0f7 100644 --- a/test/imperative.t/run.t +++ b/test/imperative.t/run.t @@ -1,6 +1,104 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + /* + * Syntax and fallback syntax. + + * vim: set ft=reason: + */ + switch ( + while (true) { + (); + } + ) { + | _ => () + }; + + try( + while (true) { + (); + } + ) { + | _ => () + }; + + switch ( + for (i in 0 to 10) { + (); + } + ) { + | _ => () + }; + + try( + for (i in 0 to 10) { + (); + } + ) { + | _ => () + }; + + switch ( + if (true) { + print_string("switching on true"); + } else { + print_string("switching on false"); + } + ) { + | _ => () + }; + + try( + for (i in 0 to 10) { + (); + } + ) { + | _ => () + }; + + let result = + ( + while (false) { + (); + } + ) + == () + ? false : true; + + switch ( + try( + try() { + | _ => () + } + ) { + | _ => () + } + ) { + | () => () + }; + + let shouldStillLoop = {contents: false}; + + while (shouldStillLoop.contents) { + print_string("You're in a while loop"); + print_newline(); + }; + + while ({ + shouldStillLoop.contents = false; + shouldStillLoop.contents; + }) { + print_string("Will never loop"); + }; + + while ((shouldStillLoop := false) == ()) { + print_string("Forever in the loop"); + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/inlineRecord.t/run.t b/test/inlineRecord.t/run.t index 69829329a..733eef079 100644 --- a/test/inlineRecord.t/run.t +++ b/test/inlineRecord.t/run.t @@ -1,5 +1,5 @@ See the typed tree from ./input.re - $ cat ./input.re | typedtree_printer + $ cat ./input.re | outcome_printer type t0 = T0({ t0: int, }); type t1 = A({ x: int, }) | B | C({ c1: string, c2: string, }); type t2(_) = diff --git a/test/knownReIssues.t/run.t b/test/knownReIssues.t/run.t index df08f6c0b..886dbbb1d 100644 --- a/test/knownReIssues.t/run.t +++ b/test/knownReIssues.t/run.t @@ -1,6 +1,32 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /** + Issue 940: https://github.com/facebook/reason/issues/940 + The parens in the exception match case with an alias, + are required for correct parsing: + i.e. (Sys_error _ as exc) instead of Sys_error _ as exc + The latter doesn't type-check with Error: Unbound value exc. + Warning 11 (unused match case) is also triggered. + */ + let f = () => raise(Sys_error("error")); + + switch (f()) { + | x => () + | exception (Sys_error(_) as exc) => raise(exc) + }; + + exception Foo(string); + + let g = () => raise(Foo("bar errors")); + + switch (g()) { + | x => () + | exception (Foo(f)) => raise(Foo(f)) + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/lazy.t/run.t b/test/lazy.t/run.t index df08f6c0b..6d0d06492 100644 --- a/test/lazy.t/run.t +++ b/test/lazy.t/run.t @@ -1,6 +1,47 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + let myComputation = + lazy({ + let tmp = 10; + let tmp2 = 20; + tmp + tmp2; + }); + + type myRecord = {myRecordField: int}; + + let operateOnLazyValue = (lazy {myRecordField}) => { + let tmp = myRecordField; + tmp + tmp; + }; + + let result = + operateOnLazyValue( + lazy({myRecordField: 100}), + ); + + type box('a) = + | Box('a); + + let lazy thisIsActuallyAPatternMatch = lazy(200); + let tmp: int = thisIsActuallyAPatternMatch; + let (lazy (Box(i)), x) = ( + lazy(Box(200)), + 100, + ); + let tmp: int = i; + + let myComputation = lazy(200); + + let reallyLoooooooooooooongIdentifierThatSpansMoreThan50Cols = 200; + + let foo = + lazy( + reallyLoooooooooooooongIdentifierThatSpansMoreThan50Cols + ); + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/letop.t/run.t b/test/letop.t/run.t index df08f6c0b..02455934e 100644 --- a/test/letop.t/run.t +++ b/test/letop.t/run.t @@ -1,6 +1,53 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + let (let.opt) = (x, f) => + switch (x) { + | None => None + | Some(x) => f(x) + }; + let (let.&opt) = (x, f) => + switch (x) { + | None => None + | Some(x) => Some(f(x)) + }; + + let z = { + let.opt a = Some(2); + let.&opt b = Some(5); + a + b; + }; + + let (let./\/) = (x, f) => + switch (x) { + | None => None + | Some(x) => f(x) + }; + let ( let.&/\* ) = (x, f) => + switch (x) { + | None => None + | Some(x) => Some(f(x)) + }; + + /* Test syntax that could potentially conflict with comments */ + let z = { + let./\/ a = Some(2); + let.&/\* b = Some(5); + a + b; + }; + + let _ = { + let.opt _ = Some("a"); + + let.opt _ = Some("c"); + + // hello + + None; + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/lib/dune b/test/lib/dune index 8c64d49ef..dbb434a4a 100644 --- a/test/lib/dune +++ b/test/lib/dune @@ -1,11 +1,11 @@ (rule - (targets typedtreePrinter.ml) - (deps typedtreePrinter.cppo.ml) + (targets outcometreePrinter.ml) + (deps outcometreePrinter.cppo.ml) (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{deps} -o %{targets}))) (executable - (public_name typedtree_printer) - (name typedtreePrinter) + (public_name outcome_printer) + (name outcometreePrinter) (package rtop) (libraries reason)) diff --git a/test/lib/typedtreePrinter.cppo.ml b/test/lib/outcometreePrinter.cppo.ml similarity index 100% rename from test/lib/typedtreePrinter.cppo.ml rename to test/lib/outcometreePrinter.cppo.ml diff --git a/test/mutation.t/run.t b/test/mutation.t/run.t index df08f6c0b..8b901f1ce 100644 --- a/test/mutation.t/run.t +++ b/test/mutation.t/run.t @@ -1,6 +1,66 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + /** + * Testing mutations. + */ + let holdsAUnit = ref(); + + let holdsABool = ref(false); + + let holdsAnInt = ref(0); + + let holdsAHoldsABool = ref(ref(true)); + + let () = holdsAUnit := holdsABool := false; + + /* Should be parsed as: */ + /* And so they should both be printed the same */ + let () = holdsAUnit := holdsABool := false; + + /* + * The following: + * + * something = x := e + * + * Should be parsed as: + * + * something = (x := e) + */ + holdsAUnit.contents = holdsAnInt := 0; + + holdsABool.contents = holdsAnInt.contents == 100; + + let numberToSwitchOn = 100; + + switch (numberToSwitchOn) { + | (-3) + | (-2) + | (-1) => () + | 0 => holdsAUnit.contents = () + | 1 => holdsAUnit.contents = holdsAnInt := 0 + | 2 => + true + ? holdsAUnit.contents = () + : holdsABool.contents ? () : () + | 3 => + true + ? holdsAUnit := () + : holdsABool.contents ? () : () + | 4 => true ? holdsAnInt := 40 : () + | 5 => holdsAnInt := 40 + | _ => () + }; + + let mutativeFunction = + fun + | Some(x) => holdsAUnit.contents = () + | None => holdsAUnit := (); + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/oo.t/run.t b/test/oo.t/run.t index df08f6c0b..5b82d5f53 100644 --- a/test/oo.t/run.t +++ b/test/oo.t/run.t @@ -1,6 +1,442 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + class virtual stack ('a) (init) = { + /* + * The "as this" is implicit and will be formatted away. + */ + val virtual dummy: unit; + val mutable v: list('a) = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + pub explicitOverrideTest = a => { + a + 1; + }; + pri explicitOverrideTest2 = a => { + a + 1; + }; + }; + + let tmp = { + /** + * comment here. + */; + val x = 10 + }; + + /** + * Comment on stackWithAttributes. + */ + [@thisShouldntBeFormattedAway] + class virtual stackWithAttributes ('a) (init) = { + /* Before class */ + /* The "as this" should not be formatted away because attributes. */ + as [@thisShouldntBeFormattedAway] this; + /* Before floatting attribute */ + [@floatingAttribute]; + /* Virtual member */ + [@itemAttr1] val virtual dummy: unit; + [@itemAttr2] val mutable v: list('a) = init; + pub virtual implementMe: int => int; + pub pop = + switch (v) { + | [hd, ...tl] => + v = tl; + Some(hd); + | [] => None + }; + pub push = hd => { + v = [hd, ...v]; + }; + initializer { + print_string("initializing object"); + }; + }; + + class extendedStack ('a) (init) = { + inherit (class stack('a))(init); + val dummy = (); + pub implementMe = i => i; + }; + + class extendedStackAcknowledgeOverride + ('a) + (init) = { + inherit (class stack('a))(init); + val dummy = (); + pub implementMe = i => { + i + 1; + }; + pub! explicitOverrideTest = a => { + a + 2; + }; + pri! explicitOverrideTest2 = a => { + a + 2; + }; + }; + + let inst = (new extendedStack)([1, 2]); + + /** + * Recursive classes. + */ + /* + * First recursive class. + */ + class firstRecursiveClass (init) = { + val v = init; + } + /* + * Second recursive class. + */ + and secondRecursiveClass (init) = { + val v = init; + }; + + /** + * For now, mostly for historic reasons, the syntax for type + * definitions/annotations on anonymous objects are different than + * "class_instance_type". That needn't be the case. The only challenge is that + * whatever we do, there is a slight challenge in avoiding conflicts with + * records. Clearly {x:int, y:int} will conflict. However, open object types in + * the form of {.. x:int, y:int} do not conflict. The only thing that must be + * resolved is closed object types and records. you could have a special token + * that means "closed". {. x: int, y:int}. If only closed object types would be + * optimized in the same way that records are, records could just be replaced + * with closed object types. + */ + /** + * Anonymous objects. + */ + + type closedObj = {.}; + + let (<..>) = (a, b) => a + b; + let five = 2 <..> 3; + + type nestedObj = {. bar: {. a: int}}; + + let (>>) = (a, b) => a > b; + + let bigger = 3 >> 2; + + type typeDefForClosedObj = { + . + x: int, + y: int, + }; + type typeDefForOpenObj('a) = + { + .. + x: int, + y: int, + } as 'a; + let anonClosedObject: { + . + x: int, + y: int, + } = { + pub x = { + 0; + }; + pub y = { + 0; + } + }; + + let onlyHasX = {pub x = 0}; + let xs: list({. x: int}) = [ + onlyHasX, + (anonClosedObject :> {. x: int}), + ]; + + let constrainedAndCoerced = ( + [anonClosedObject, anonClosedObject]: + list({ + . + x: int, + y: int, + }) :> + list({. x: int}) + ); + + /* If one day, unparenthesized type constraints are allowed on the RHS of a + * record value, we're going to have to be careful here because >} is parsed as + * a separate kind of token (for now). Any issues would likely be caught in the + * idempotent test case. + */ + let xs: ref({. x: int}) = { + contents: (anonClosedObject :> {. x: int}), + }; + + let coercedReturn = { + let tmp = anonClosedObject; + (tmp :> {. x: int}); + }; + + let acceptsOpenAnonObjAsArg = + ( + o: { + .. + x: int, + y: int, + }, + ) => + o#x + o#y; + let acceptsClosedAnonObjAsArg = + ( + o: { + . + x: int, + y: int, + }, + ) => + o#x + o#y; + let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + + let res = + acceptsOpenAnonObjAsArg({ + pub x = 0; + pub y = 10; + pub z = 10 + }); + + let res = + acceptsClosedAnonObjAsArg({ + pub x = 0; + pub y = 10 + }); + + /* TODO: Unify class constructor return values with function return values */ + class myClassWithAnnotatedReturnType + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; + }; + /** + * May include a trailing semi after type row. + */ + class myClassWithAnnotatedReturnType2 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y = init; + }; + + /** + * May use equals sign, and may include colon if so. + */ + class myClassWithAnnotatedReturnType3 + (init) + : { + pub x: int; + pub y: int; + } = { + pub x: int = init; + pub y: int = init; + }; + + /** + * The one difference between class_constructor_types and expression + * constraints, is that we have to include the prefix word "new" before the + * final component of any arrow. This isn't required when annotating just the + * return value with ": foo ". + * This is only to temporarily work around a parsing conflict. (Can't tell if + * in the final arrow component it should begin parsing a non_arrowed_core_type + * or a class_instance_type). A better solution, would be to include + * class_instance_type as *part* of core_type, but then fail when it is + * observed in the non-last arrow position, or if a non_arrowed_core_type + * appears in the last arrow position. + * + * class_instance_type wouldn't always fail if parsed as any "core type" + * everywhere else in the grammar. + * + * Once nuance to that would be making a parse rule for "type application", and + * deferring whether or not that becomes a Pcty_constr or a Ptyp_constr. (The + * same for type identifiers and extensions.) + */ + class myClassWithAnnotatedReturnType3_annotated_constructor: + (int) => + { + pub x: int; + pub y: int; + } = + fun (init) => { + pub x: int = init; + pub y: int = init; + }; + + class tupleClass ('a, 'b) (init: ('a, 'b)) = { + pub pr = init; + }; + + module HasTupleClasses: { + /** + * exportedClass. + */ + class exportedClass: + (int) => + { + pub x: int; + pub y: int; + }; + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b): + (('a, 'b)) => + { + pub pr: ('a, 'b); + }; + } = { + /** + * exportedClass. + */ + class exportedClass = + class myClassWithAnnotatedReturnType3; + + /** + * anotherExportedClass. + */ + class anotherExportedClass ('a, 'b) = + class tupleClass('a, 'b); + }; + + class intTuples = class tupleClass(int, int); + + class intTuplesHardcoded = + (class tupleClass(int, int))((8, 8)); + + /** + * Note that the inner tupleClass doesn't have the "class" prefix because + * they're not kinds of classes - they're types of *values*. + * The parens here shouldn't be required. + */ + class intTuplesTuples = + class tupleClass( + tupleClass(int, int), + tupleClass(int, int), + ); + + let x: tupleClass(int, int) = { + pub pr = (10, 10) + }; + + let x: #tupleClass(int, int) = x; + + let incrementMyClassInstance: + (int, #tupleClass(int, int)) => + #tupleClass(int, int) = + (i, inst) => { + let (x, y) = inst#pr; + {pub pr = (x + i, y + i)}; + }; + + class myClassWithNoTypeParams = {}; + /** + * The #myClassWithNoTypeParams should be treated as "simple" + */ + type optionalMyClassSubtype('a) = + option(#myClassWithNoTypeParams) as 'a; + + /** + * Remember, "class type" is really "class_instance_type" (which is the type of + * what is returned from the constructor). + * + * And when defining a class: + * + * addablePoint is the "class instance type" type generated in scope which is + * the closed object type of the return value of the constructor. + * + * #addablePoint is the extensible form of addablePoint (anything that + * adheres to the "interface.") + */ + class type addablePointClassType = { + pub x: int; + pub y: int; + pub add: + ( + addablePointClassType, + addablePointClassType + ) => + int; + }; + + /** + * Class constructor types can be annotated. + */ + class addablePoint: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + + class addablePoint2: + (int) => addablePointClassType = + fun (init) => { + as self; + pub add = + ( + one: addablePointClassType, + two: addablePointClassType, + ) => + one#x + two#x + one#y + two#x; + pub x: int = init; + pub y = init; + }; + + module type T = { + class virtual cl ('a): {} + and cl2: {}; + }; + + let privacy = {pri x = c => 5 + c}; + + module Js = { + type t('a); + }; + + /* supports trailing comma */ + type stream('a) = { + . + "observer": ('a => unit) => unit, + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/patternMatching.t/run.t b/test/patternMatching.t/run.t index df08f6c0b..195ff82f7 100644 --- a/test/patternMatching.t/run.t +++ b/test/patternMatching.t/run.t @@ -1,6 +1,321 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + type point = { + x: int, + y: int, + }; + + let id = x => x; + + type myVariant = + | TwoCombos(inner, inner) + | Short + | AlsoHasARecord(int, int, point) + and inner = + | Unused + | HeresTwoConstructorArguments(int, int); + + let computeTuple = (a, b, c, d, e, f, g, h) => ( + a + b, + c + d, + e + f, + g + h, + ); + + let res = + switch (TwoCombos(Unused, Unused)) { + | TwoCombos( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => ( + x, + y, + a, + b, + ) + | TwoCombos(_, _) => (0, 0, 0, 0) + | Short + | AlsoHasARecord(300, _, _) => ( + 100000, + 100000, + 100000, + 100000, + ) + | AlsoHasARecord(firstItem, two, {x, y}) => + computeTuple( + firstItem, + firstItem, + firstItem, + firstItem, + firstItem, + two, + two, + two, + ) + }; + + /** + * Match bodies may include sequence expressions, but without the `{}` + * braces required. + */ + let res = + switch (TwoCombos(Unused, Unused)) { + | TwoCombos( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => + let ret = (x, y, a, b); + ret; + | TwoCombos(_, _) => + /** + * See, no braces required - saves indentation as well! + */ + let ret = (0, 0, 0, 0); + ret; + | Short + | AlsoHasARecord(300, _, _) => + /** + * And no final semicolon is required. + */ + let ret = (100000, 100000, 100000, 100000); + ret; + | AlsoHasARecord(firstItem, two, {x, y}) => + computeTuple( + firstItem, + firstItem, + firstItem, + firstItem, + firstItem, + two, + two, + two, + ) + }; + + /** + * Ensure that nested Pexp_functions are correctly wrapped in parens. + * + */ + let res = + switch (TwoCombos(Unused, Unused)) { + | TwoCombos( + HeresTwoConstructorArguments(x, y), + HeresTwoConstructorArguments(a, b), + ) => ( + fun + | Some(x) => x + 1 + | None => 0 + ) + | TwoCombos(_, _) => + let x = ( + fun + | Some(x) => x + 1 + | None => 0 + ); + x; + | Short + | AlsoHasARecord(300, _, _) => + id( + fun + | Some(x) => x + 1 + | None => 0, + ) + | AlsoHasARecord(firstItem, two, {x, y}) => + id( + fun + | Some(x) => x + 1 + | None => 0, + ) + }; + + /* test (), which is sugar for (()) */ + switch (Some()) { + | Some () => 1 + | _ => 2 + }; + switch (Some()) { + | Some () => 1 + | _ => 2 + }; + switch (Some()) { + | Some () => 1 + | _ => 2 + }; + switch (Some()) { + | Some () => 1 + | _ => 2 + }; + + type foo = + | Foo(unit); + switch (Foo()) { + | Foo () => 1 + }; + switch (Foo()) { + | Foo () => 1 + }; + switch (Foo()) { + | Foo () => 1 + }; + switch (Foo()) { + | Foo () => 1 + }; + + switch () { + | () => 1 + }; + switch () { + | () => 1 + }; + switch () { + | () => 1 + }; + switch () { + | () => 1 + }; + + switch (Some(1)) { + | Some(1) => 1 + | None => 2 + | _ => 3 + }; + + let myInt = 100; + /* Numeric ranges are rejected by the type checker, but validly parsed so drop + * this in an annotation to test the parsing. */ + [@something? 1 .. 2] + let rangeInt = 0; + + let myChar = 'x'; + let rangeChar = + switch (myChar) { + | 'a' .. 'b' => "a to b" + | 'b' .. 'z' => "b to z" + | c => "something else" + }; + + /* with parens around direct list pattern in constructor pattern */ + switch (None) { + | Some([]) => () + | Some([_]) when true => () + | Some([x]) => () + | Some([x, ...xs]) when true => () + | Some([x, y, z]) => () + | _ => () + }; + + /* no parens around direct list pattern in constructor pattern (sugar) */ + switch (None) { + | Some([]) => () + | Some([_]) when true => () + | Some([x]) => () + | Some([x, ...xs]) when true => () + | Some([x, y, z]) => () + | _ => () + }; + + /* with parens around direct array pattern in constructor pattern */ + switch (None) { + | Some([||]) => "empty" + | Some([|_|]) when true => "one any" + | Some([|a|]) => "one" + | Some([|a, b|]) => "two" + | _ => "many" + }; + + /* no parens around direct array pattern in constructor pattern (sugar) */ + switch (None) { + | Some([||]) => "empty" + | Some([|_|]) when true => "one any" + | Some([|a|]) => "one" + | Some([|a, b|]) => "two" + | _ => "many" + }; + + /* parens around direct record pattern in constructor pattern */ + switch (None) { + | Some({x}) when true => () + | Some({x, y}) => () + | _ => () + }; + + /* no parens around direct record pattern in constructor pattern (sugar) */ + switch (None) { + | Some({x}) when true => () + | Some({x, y}) => () + | _ => () + }; + + switch (None) { + | Some([| + someSuperLongString, + thisShouldBreakTheLine, + |]) => + () + | _ => () + }; + + switch (None) { + | Some(( + someSuperLongString, + thisShouldBreakTheLine, + )) => + () + | _ => () + }; + + switch (None) { + | Some([ + someSuperLongString, + thisShouldBreakTheLine, + ]) => + () + | Some([ + someSuperLongString, + ...es6ListSugarLikeSyntaxWhichIsSuperLong, + ]) + when true === true => + () + | Some([ + someSuperLongString, + ...es6ListSugarLikeSyntaxWhichIsSuperLong, + ]) => + () + | _ => () + }; + + type aOrB = + | A(int) + | B(int); + let (nestedAnnotation: int): int = 0; + let (A(i) | B(i)): aOrB = A(0); + + type test_foo = + | VariantType1 + | VariantType2; + + let branch_with_variant_and_annotation = + fun + | (VariantType1: test_foo) => true + | VariantType2 => false; + + type intRange = { + from: option(string), + to_: option(string), + }; + + type optIntRange = option(intRange); + + let optIntRangeOfIntRange = + fun + | ({from: None, to_: None}: intRange) => ( + None: optIntRange + ) + | {from, to_} => Some({from, to_}); + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/sequences.t/run.t b/test/sequences.t/run.t index df08f6c0b..acc0eae22 100644 --- a/test/sequences.t/run.t +++ b/test/sequences.t/run.t @@ -1,6 +1,96 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */ + + /** + * Testing Sequences. + */ + let result = { + let twenty = 20; + let result = twenty; + result; + }; + + /* Final semicolon is not required */ + let result = { + let twenty = result; + twenty; + }; + let anInt = result + 20; + + let twenty = 20; + + /** + * Each of these are a sequence with a single item - they will be + * printed in reduced form because sequences are a *parse* time construct. + * To ensure these are parsed correctly, adding to an integer. + */ + let result = + 0 + + { + twenty; + }; + let result = + 0 + + { + twenty; + }; + let result = 0 + twenty; + + let unitValue = (); + /* While loops/for loops merely accept a "simple expression" (which means + * it is either a simple token or balanced with parens/braces). However, + * the formatter ensures that the bodies are printed in "sequence" form even if + * it's not required. + */ + while (false) { + unitValue; + }; + while (false) { + print_string("test"); + }; + while (false) { + print_string("test"); + }; + + type myRecord = {number: int}; + let x = {number: 20}; + let number = 20; + /* + * The (mild) consequence of not requiring a final semi in a sequence, + * is that we can no longer "pun" a single field record (which would) + * be very rare anyways. + */ + let cannotPunASingleFieldRecord = { + number: number, + }; + let fourty = + 20 + cannotPunASingleFieldRecord.number; + let thisIsASequenceNotPunedRecord = { + number; + }; + let fourty = 20 + thisIsASequenceNotPunedRecord; + + type recordType = { + a: int, + b: int, + c: int, + }; + let a = 0; + let b = 0; + let c = 0; + /* All of these will be printed as punned because they have more than one field. */ + let firstFieldPunned = {a, b, c}; + let sndFieldPunned = {a, b, c}; + let thirdFieldPunned = {a, b, c}; + let singlePunAcceptedIfExtended = { + ...firstFieldPunned, + a, + }; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/type-pipeFirst.t/run.t b/test/type-pipeFirst.t/run.t index df08f6c0b..816c64911 100644 --- a/test/type-pipeFirst.t/run.t +++ b/test/type-pipeFirst.t/run.t @@ -1,6 +1,192 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + let (|.) = (x, y) => x + y; + + let a = 1; + let b = 2; + let c = 3; + + /* parses as 10 < (a->b->c) */ + let t1: bool = 10 < a->b->c; + + type coordinate = { + x: int, + y: int, + }; + let coord = {x: 1, y: 1}; + + /* parses as (coord.x)->a->b->c */ + let t2: int = coord.x->a->b->c; + + let (|.) = (x, y) => x || y; + + let a = true; + let b = false; + let c = true; + + /* parses as !(a->b->c) */ + let t3: bool = !a->b->c; + + /* parse pipe first with underscore application correct */ + let doStuff = (a: int, b: int, c: int): int => { + a + 2 * b + 3 * c; + }; + + let (|.) = (a, f) => f(a); + + let t4: int = 5->doStuff(1, _, 7); + let t5: int = + 5->doStuff(1, _, 7)->doStuff(1, _, 7); + + module Foo = { + let createElement = (~children, ()) => + List.hd(children) ++ "test"; + + let map = (xs, f) => List.map(f, xs); + + let plusOne = x => x + 1; + + let toString = lst => + List.fold_left( + (acc, curr) => + acc ++ string_of_int(curr), + "", + lst, + ); + }; + + let items = [1, 2, 3]; + + let t6: string = + + {items->Foo.map(Foo.plusOne)->Foo.toString} + ; + + type saveStatus = + | Pristine + | Saved + | Saving + | Unsaved; + + let saveStatus = Pristine; + + let t7: string = + + {( + switch (saveStatus) { + | Pristine => [0] + | Saved => [1] + | Saving => [2] + | Unsaved => [3] + } + ) + ->Foo.map(Foo.plusOne) + ->Foo.toString} + ; + + let genItems = f => List.map(f, items); + + let t8: string = + + {genItems(Foo.plusOne)->Foo.toString} + ; + + let blocks = [1, 2, 3]; + + let t9: string = + blocks->(b => Foo.toString(b)) ; + + let foo = xs => List.concat([xs, xs]); + + let t10: string = + + {blocks + ->foo + ->Foo.map(Foo.plusOne) + ->Foo.toString} + ; + + let t11: string = + + {blocks + ->foo + ->Foo.map(Foo.plusOne) + ->Foo.map(Foo.plusOne) + ->Foo.toString} + ; + + let title = "los pilares de la tierra"; + + let t12: string = + + (title === "" ? [1, 2, 3] : blocks) + ->Foo.toString + ; + + type change = + | Change(list(int)); + + type this = {send: change => string}; + + let change = x => Change(x); + + let self = { + send: x => + switch (x) { + | Change(xs) => Foo.toString(xs) + }, + }; + + let urlToRoute = x => [x, x, x]; + + let t13: string = + urlToRoute(1)->change->(self.send); + + module FooLabeled = { + let createElement = (~children, ()) => + List.hd(children) ++ "test"; + + let map = (xs, ~f) => List.map(f, xs); + + let plusOne = x => x + 1; + + let toString = lst => + List.fold_left( + (acc, curr) => + acc ++ string_of_int(curr), + "", + lst, + ); + }; + + let t14: string = + + {items + ->FooLabeled.map(~f=FooLabeled.plusOne) + ->FooLabeled.toString} + ; + + let c = (a, b) => a + b; + let a = 1; + let b = 2; + let t: int = a->(b->c); + + module Div = { + let createElement = (~children, ()) => + List.hd(children) ++ "test"; + }; + + let url = "reason"; + let suffix = ".com"; + + let parse = (a, b) => a ++ b; + + let t15: string = +
{url->parse(suffix, _)}
; + Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re diff --git a/test/typeParameters.t/run.t b/test/typeParameters.t/run.t index df08f6c0b..0620eb043 100644 --- a/test/typeParameters.t/run.t +++ b/test/typeParameters.t/run.t @@ -1,6 +1,95 @@ Format basic $ refmt --print re ./input.re > ./formatted.re +Print the formatted file + $ cat ./formatted.re + /** + * Testing type parameters. + */ + + type threeThings('t) = ('t, 't, 't); + type listOf('t) = list('t); + + type underscoreParam(_) = + | Underscored; + type underscoreParamCovariance(+_) = + | Underscored; + type underscoreParamContravariance(-_) = + | Underscored; + + type tickParamCovariance(+'a) = + | Underscored; + type tickParamContravariance(-'a) = + | Underscored; + + let x: option(list('a)) = None; + type myFunctionType('a) = ( + list(('a, 'a)), + int => option(list('a)), + ); + let funcAnnoted = (~a: list(int)=[0, 1], ()) => a; + + /** + * Syntax that would be likely to conflict with lexing parsing of < > syntax. + */ + + let zero = 0; + let isGreaterThanNegFive = zero > (-5); + let isGreaterThanNegFive2 = zero > (-5); + let isGreaterThanNegFive3 = zero > (-5); + + let isGreaterThanEqNegFive = zero >= (-5); + let isGreaterThanEqNegFive2 = zero >= (-5); + let isGreaterThanEqNegFive3 = zero >= (-5); + + let (>>=) = (a, b) => a >= b; + + let isSuperGreaterThanEqNegFive = zero >>= (-5); + let isSuperGreaterThanEqNegFive2 = zero >>= (-5); + let isSuperGreaterThanEqNegFive3 = zero >>= (-5); + + let jsx = (~children, ()) => 0; + + type t('a) = 'a; + let optionArg = (~arg: option(t(int))=?, ()) => arg; + let optionArgList = + (~arg: option(list(list(int)))=?, ()) => arg; + let defaultJsxArg = (~arg: t(int)=, ()) => arg; + let defaultFalse = (~arg: t(bool)=!true, ()) => arg; + /* Doesn't work on master either let defaultTrue = (~arg:t= !!true) => arg; */ + + /** + * Things likely to conflict or impact precedence. + */ + let neg = (-1); + let tru = !false; + let x = + "arbitrary" === "example" + && "how long" >= "can you get" + && "seriously" <= "what is the line length"; + + let z = 0; + module Conss = { + let (>-) = (a, b) => a + b; + let four = 3 >- 1; + let two = 3 >- (-1); + let four' = 3 >- 1; + + let tr = 3 > (-1); + let tr' = 3 > 1; + let tr'' = 3 > (-1); + }; + + module Idents = { + let (>-) = (a, b) => a + b; + let four = z >- z; + let two = z >- - z; + let four' = z >- - (- z); + + let tr = z > - z; + let tr' = z > - (- z); + let tr'' = z > - (- (- z)); + }; Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re From 4d60802ed4d10c0569d67a545efd12bc60614019 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 16 Jun 2023 21:54:20 -0700 Subject: [PATCH 04/64] chore: prepare 3.9.0 (#2718) --- HISTORY.md | 2 +- flake.lock | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/HISTORY.md b/HISTORY.md index 9ff8d51d2..e4686ecad 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,4 +1,4 @@ -## 3.9 (unreleased) +## 3.9.0 - Reduce the amount of parentheses around functor usage (@SanderSpies, [#2683](https://github.com/reasonml/reason/pull/2683)) - Print module type body on separate line (@SanderSpies, [#2709](https://github.com/reasonml/reason/pull/2709)) diff --git a/flake.lock b/flake.lock index 031b284d5..2483e6b89 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1681202837, - "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", + "lastModified": 1685518550, + "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=", "owner": "numtide", "repo": "flake-utils", - "rev": "cfacdce06f30d2b68473a46042957675eebb3401", + "rev": "a1720a10a6cfe8234c0e93907ffe81be440f4cef", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1682622444, - "narHash": "sha256-V9GsNIiDcwzQe7y7y1cIp5A0QK8SuG6CRUqV1hRYxDE=", + "lastModified": 1686968282, + "narHash": "sha256-XDNUgEIvF4dxYYApEkQGkYXji0Cbjjvx673F9Z3c/Yk=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "f05f850a4e7fb4ff3cb351339271c3cf7310695a", + "rev": "65c280960218799ca5fbad04d9b36e0224615e68", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1682556406, - "narHash": "sha256-8kLelu0INHMEJxyeehuFv1+FwKUy4fSaY1hh65rhsF4=", + "lastModified": 1686953075, + "narHash": "sha256-wuyQEsKKW38bYzmkH51jrs9k+VtE0iWNLIyCUYapFDk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "af4cf4d6ae4a47fc9a8b58ea6238455a3acf0292", + "rev": "a199713f336d12f8bbc37cdf72a46e08b5cb4797", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "af4cf4d6ae4a47fc9a8b58ea6238455a3acf0292", + "rev": "a199713f336d12f8bbc37cdf72a46e08b5cb4797", "type": "github" } }, From 5d5c626f1e03d87aeb02220bc0eccc7a44b350da Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 16 Jun 2023 22:00:46 -0700 Subject: [PATCH 05/64] rename history -> changes --- HISTORY.md => CHANGES.md | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename HISTORY.md => CHANGES.md (100%) diff --git a/HISTORY.md b/CHANGES.md similarity index 100% rename from HISTORY.md rename to CHANGES.md From 8af1e160522da691aed27f47bf300fca7a80a510 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 16 Jun 2023 22:01:52 -0700 Subject: [PATCH 06/64] run dune build @fmt --- src/reason-parser/vendor/cmdliner/dune | 4 ++-- src/reason-parser/vendor/easy_format/dune | 9 ++++++--- src/rtop/dune | 8 +++++++- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/reason-parser/vendor/cmdliner/dune b/src/reason-parser/vendor/cmdliner/dune index 2e0827450..7669c0b89 100644 --- a/src/reason-parser/vendor/cmdliner/dune +++ b/src/reason-parser/vendor/cmdliner/dune @@ -1,5 +1,5 @@ (library (name ReasonCmdliner) (public_name reason.cmdliner) - (wrapped false) - (flags :standard -w -3-27-32-35-50)) + (wrapped false) + (flags :standard -w -3-27-32-35-50)) diff --git a/src/reason-parser/vendor/easy_format/dune b/src/reason-parser/vendor/easy_format/dune index 03de9fdd3..7e1537b22 100644 --- a/src/reason-parser/vendor/easy_format/dune +++ b/src/reason-parser/vendor/easy_format/dune @@ -1,6 +1,9 @@ (library (name ReasonEasyFormat) (public_name reason.easy_format) - (preprocess (action (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) - (wrapped false) - (flags (:standard -w -9-27-32-50))) + (preprocess + (action + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))) + (wrapped false) + (flags + (:standard -w -9-27-32-50))) diff --git a/src/rtop/dune b/src/rtop/dune index 729cc19da..30ab73801 100644 --- a/src/rtop/dune +++ b/src/rtop/dune @@ -4,7 +4,13 @@ (modules reason_util reason_utop reason_toploop) (wrapped false) (modes byte) - (libraries compiler-libs.common menhirLib reason.easy_format reason utop reason.ocaml-migrate-parsetree)) + (libraries + compiler-libs.common + menhirLib + reason.easy_format + reason + utop + reason.ocaml-migrate-parsetree)) (executable (name rtop) From f43999438d83a864452ad8d17a0047753b7268a7 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 17 Jun 2023 21:28:57 -0700 Subject: [PATCH 07/64] parser: fully qualify most modules (#2719) * parser: fully qualify most modules * more qualification --- src/reason-parser/dune | 1 + src/reason-parser/reason_parser.mly | 702 ++++++++++-------- ...on_parser_def.ml => reason_parser_def.mli} | 0 src/reason-parser/reason_toolchain_conf.ml | 4 +- 4 files changed, 380 insertions(+), 327 deletions(-) rename src/reason-parser/{reason_parser_def.ml => reason_parser_def.mli} (100%) diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 97ff1fb12..e5c67fe6f 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -123,6 +123,7 @@ reason_parser_explain_raw reason_parser_explain reason_parser_recover) + (modules_without_implementation reason_parser_def) (libraries reason.ocaml-migrate-parsetree menhirLib diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 719ffdefd..edebeb6c9 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -48,26 +48,20 @@ (* The parser definition *) %{ -open Ppxlib -open Reason_syntax_util -open Location -open Asttypes -open Longident -open Parsetree -open Ast_helper -open Reason_parser_def -open Reason_errors - -(* Menhir generates `Warnings.loc` *) -module Warnings = struct - type loc = Location.t -end +module Ast_helper = Ppxlib.Ast_helper +module Location = Ppxlib.Location +module Longident = Ppxlib.Longident + +open Ppxlib.Asttypes + -let mkloc txt loc = {txt;loc} -let mknoloc txt = mkloc txt none +let mkloc txt loc = + { Location.txt; loc } + +let mknoloc txt = mkloc txt Location.none let raise_error error loc = - raise_error (Ast_error error) loc + Reason_errors.raise_error (Ast_error error) loc module Clflags = Reason_syntax_util.Clflags (* @@ -145,48 +139,47 @@ module Clflags = Reason_syntax_util.Clflags *) -let make_floating_doc = function - | {attr_name = {txt = "ocaml.doc"; _} as attr_name; _} as attr -> +let make_floating_doc attr = + match attr with + | { Ppxlib.Parsetree.attr_name = {txt = "ocaml.doc"; _} as attr_name; _} -> {attr with attr_name = {attr_name with txt = "ocaml.text"}} | attr -> attr let uncurry_payload ?(name="bs") loc = - { attr_name = {loc; txt = name}; + { Ppxlib.Parsetree.attr_name = {loc; txt = name}; attr_payload = PStr []; attr_loc = loc } let dummy_loc () = { - loc_start = Lexing.dummy_pos; + Location.loc_start = Lexing.dummy_pos; loc_end = Lexing.dummy_pos; loc_ghost = false; } let mklocation loc_start loc_end = { - loc_start = loc_start; + Location.loc_start = loc_start; loc_end = loc_end; loc_ghost = false; } -let make_real_loc loc = { - loc with loc_ghost = false -} +let make_real_loc loc = + { loc with Location.loc_ghost = false } -let make_ghost_loc loc = { - loc with loc_ghost = true -} +let make_ghost_loc loc = + { loc with Location.loc_ghost = true } -let ghloc ?(loc=dummy_loc ()) d = { txt = d; loc = (make_ghost_loc loc) } +let ghloc ?(loc=dummy_loc ()) d = + { Location.txt = d; loc = (make_ghost_loc loc) } (** * turn an object into a real *) -let make_real_exp exp = { - exp with pexp_loc = make_real_loc exp.pexp_loc -} -let make_real_pat pat = { - pat with ppat_loc = make_real_loc pat.ppat_loc -} +let make_real_exp ({ Ppxlib.Parsetree.pexp_loc; _ } as exp) = + { exp with pexp_loc = make_real_loc pexp_loc } + +let make_real_pat ({ Ppxlib.Parsetree.ppat_loc; _ } as pat) = + { pat with ppat_loc = make_real_loc ppat_loc } (* * change the location state to be a ghost location or real location *) @@ -195,47 +188,47 @@ let set_loc_state is_ghost loc = let mktyp ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Typ.mk ~loc d + Ast_helper.Typ.mk ~loc d let mkpat ?(attrs=[]) ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Pat.mk ~loc ~attrs d + Ast_helper.Pat.mk ~loc ~attrs d let mkexp ?(attrs=[]) ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Exp.mk ~loc ~attrs d + Ast_helper.Exp.mk ~loc ~attrs d let mkmty ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Mty.mk ~loc d + Ast_helper.Mty.mk ~loc d let mksig ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Sig.mk ~loc d + Ast_helper.Sig.mk ~loc d let mkmod ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Mod.mk ~loc d + Ast_helper.Mod.mk ~loc d let mkstr ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Str.mk ~loc d + Ast_helper.Str.mk ~loc d let mkclass ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Cl.mk ~loc d + Ast_helper.Cl.mk ~loc d let mkcty ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Cty.mk ~loc d + Ast_helper.Cty.mk ~loc d let mkctf ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Ctf.mk ~loc d + Ast_helper.Ctf.mk ~loc d let may_tuple startp endp = function | [] -> assert false - | [x] -> {x with pexp_loc = mklocation startp endp} + | [x] -> {x with Ppxlib.Parsetree.pexp_loc = mklocation startp endp} | xs -> mkexp ~loc:(mklocation startp endp) (Pexp_tuple xs) (** @@ -245,18 +238,22 @@ let may_tuple startp endp = function type state = {nbrOfClicks: int}; type component = {props, state}; *) -let mkct lbl = - let lident = Lident lbl.txt in - let ttype = Ptyp_constr({txt = lident; loc = lbl.loc}, []) in - {ptyp_desc = ttype; ptyp_loc = lbl.loc; ptyp_attributes = []; ptyp_loc_stack =[]} +let mkct { Location.txt; loc } = + let lident = Longident.Lident txt in + let ttype = Ppxlib.Parsetree.Ptyp_constr({txt = lident; loc = loc}, []) in + { Ppxlib.Parsetree.ptyp_desc = ttype + ; ptyp_loc = loc + ; ptyp_attributes = [] + ; ptyp_loc_stack =[] + } let mkcf ?(loc=dummy_loc()) ?(ghost=false) d = let loc = set_loc_state ghost loc in - Cf.mk ~loc d + Ast_helper.Cf.mk ~loc d let simple_ghost_text_attr ?(loc=dummy_loc ()) txt = let loc = set_loc_state true loc in - [{ attr_name = {txt; loc}; + [{ Ppxlib.Parsetree.attr_name = {txt; loc}; attr_payload = PStr []; attr_loc = loc; }] @@ -281,11 +278,12 @@ let mkExplicitArityTupleExp ?(loc=dummy_loc ()) exp_desc = exp_desc let is_pattern_list_single_any = function - | [{ppat_desc=Ppat_any; ppat_attributes=[]} as onlyItem] -> Some onlyItem + | [{Ppxlib.Parsetree.ppat_desc=Ppat_any; ppat_attributes=[]} as onlyItem] -> + Some onlyItem | _ -> None -let mkoperator {Location. txt; loc} = - Exp.mk ~loc (Pexp_ident(mkloc (Lident txt) loc)) +let mkoperator { Location.txt; loc } = + Ast_helper.Exp.mk ~loc (Pexp_ident(mkloc (Longident.Lident txt) loc)) (* Ghost expressions and patterns: @@ -312,7 +310,7 @@ let mkoperator {Location. txt; loc} = let ghunit ?(loc=dummy_loc ()) () = - mkexp ~ghost:true ~loc (Pexp_construct (mknoloc (Lident "()"), None)) + mkexp ~ghost:true ~loc (Pexp_construct (mknoloc (Longident.Lident "()"), None)) let mkinfixop arg1 op arg2 = mkexp(Pexp_apply(op, [Nolabel, arg1; Nolabel, arg2])) @@ -325,8 +323,8 @@ let neg_string f = then String.sub f 1 (String.length f - 1) else "-" ^ f -let mkuminus name arg = - match name.txt, arg.pexp_desc with +let mkuminus name ({ Ppxlib.Parsetree.pexp_desc; _ } as arg) = + match name.Location.txt, pexp_desc with | "-", Pexp_constant(Pconst_integer (n,m)) -> mkexp(Pexp_constant(Pconst_integer(neg_string n,m))) | ("-" | "-."), Pexp_constant(Pconst_float (f, m)) -> @@ -336,15 +334,19 @@ let mkuminus name arg = mkexp(Pexp_apply(mkoperator name, [Nolabel, arg])) let mk_functor_mod args body = - let folder arg acc = mkmod ~loc:arg.loc (Pmod_functor(arg.txt, acc)) in + let folder { Location.txt; loc } acc = + mkmod ~loc (Pmod_functor(txt, acc)) + in List.fold_right folder args body let mk_functor_mty args body = - let folder arg acc = mkmty ~loc:arg.loc (Pmty_functor(arg.txt, acc)) in + let folder { Location.txt; loc } acc = + mkmty ~loc (Pmty_functor(txt, acc)) + in List.fold_right folder args body -let mkuplus name arg = - match name.txt, arg.pexp_desc with +let mkuplus name ({ Ppxlib.Parsetree.pexp_desc; _ } as arg) = + match name.Location.txt, pexp_desc with | "+", Pexp_constant(Pconst_integer _) | ("+" | "+."), Pexp_constant(Pconst_float _) -> mkexp arg.pexp_desc @@ -353,23 +355,23 @@ let mkuplus name arg = mkexp(Pexp_apply(mkoperator name, [Nolabel, arg])) let mkexp_cons consloc args loc = - mkexp ~loc (Pexp_construct(mkloc (Lident "::") consloc, Some args)) + mkexp ~loc (Pexp_construct(mkloc (Longident.Lident "::") consloc, Some args)) let mkexp_constructor_unit ?(uncurried=false) consloc loc = let attrs = if uncurried then [uncurry_payload ~name:"uncurry" loc] else [] in - mkexp ~attrs ~loc (Pexp_construct(mkloc (Lident "()") consloc, None)) + mkexp ~attrs ~loc (Pexp_construct(mkloc (Longident.Lident "()") consloc, None)) let ghexp_cons args loc = - mkexp ~ghost:true ~loc (Pexp_construct(mkloc (Lident "::") loc, Some args)) + mkexp ~ghost:true ~loc (Pexp_construct(mkloc (Longident.Lident "::") loc, Some args)) let mkpat_cons args loc = - mkpat ~loc (Ppat_construct(mkloc (Lident "::") loc, Some ([], args))) + mkpat ~loc (Ppat_construct(mkloc (Longident.Lident "::") loc, Some ([], args))) let ghpat_cons args loc = - mkpat ~ghost:true ~loc (Ppat_construct(mkloc (Lident "::") loc, Some ([], args))) + mkpat ~ghost:true ~loc (Ppat_construct(mkloc (Longident.Lident "::") loc, Some ([], args))) let mkpat_constructor_unit consloc loc = - mkpat ~loc (Ppat_construct(mkloc (Lident "()") consloc, None)) + mkpat ~loc (Ppat_construct(mkloc (Longident.Lident "()") consloc, None)) let simple_pattern_list_to_tuple ?(loc=dummy_loc ()) = function | [] -> assert false @@ -383,10 +385,10 @@ let mktailexp_extension loc seq ext_opt = ext | None -> let loc = make_ghost_loc loc in - let nil = { txt = Lident "[]"; loc } in - Exp.mk ~loc (Pexp_construct (nil, None)) in + let nil = { Location.txt = Longident.Lident "[]"; loc } in + Ast_helper.Exp.mk ~loc (Pexp_construct (nil, None)) in base_case - | e1 :: el -> + | (e1: Ppxlib.Parsetree.expression) :: el -> let exp_el = handle_seq el in let loc = mklocation e1.pexp_loc.loc_start exp_el.pexp_loc.loc_end in let arg = mkexp ~ghost:true ~loc (Pexp_tuple [e1; exp_el]) in @@ -402,19 +404,19 @@ let mktailpat_extension loc (seq, ext_opt) = ext | None -> let loc = make_ghost_loc loc in - let nil = { txt = Lident "[]"; loc } in + let nil = { Location.txt = Longident.Lident "[]"; loc } in mkpat ~loc (Ppat_construct (nil, None)) in base_case - | p1 :: pl -> + | (p1: Ppxlib.Parsetree.pattern) :: pl -> let pat_pl = handle_seq pl in let loc = mklocation p1.ppat_loc.loc_start pat_pl.ppat_loc.loc_end in let arg = mkpat ~ghost:true ~loc (Ppat_tuple [p1; pat_pl]) in ghpat_cons arg loc in handle_seq seq -let makeFrag loc body = +let makeFrag loc (body: Ppxlib.Parsetree.expression) = let attribute = { - attr_name = {txt = "JSX"; loc = loc}; + Ppxlib.Parsetree.attr_name = { Location.txt = "JSX"; loc }; attr_payload = PStr []; attr_loc = loc } @@ -425,7 +427,7 @@ let makeFrag loc body = (* Applies attributes to the structure item, not the expression itself. Makes * structure item have same location as expression. *) let mkstrexp e attrs = - { pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc } + { Ppxlib.Parsetree.pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc } let ghexp_constraint loc e (t1, t2) = match t1, t2 with @@ -439,22 +441,22 @@ let mk_record_expr ?loc (exten, fields) = | _ -> mkexp ?loc (Pexp_record (fields, exten)) let array_function ?(loc=dummy_loc()) str name = - ghloc ~loc (Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))) + ghloc ~loc (Longident.Ldot(Lident str, (if !Clflags.fast then "unsafe_" ^ name else name))) let syntax_error loc s = raise_error (Other_syntax_error s) loc let syntax_error_exp loc msg = - Exp.extension ~loc (Reason_errors.error_extension_node loc msg) + Ast_helper.Exp.extension ~loc (Reason_errors.error_extension_node loc msg) let syntax_error_pat loc msg = - Pat.extension ~loc (Reason_errors.error_extension_node loc msg) + Ast_helper.Pat.extension ~loc (Reason_errors.error_extension_node loc msg) let syntax_error_mty loc msg = - Mty.extension ~loc (Reason_errors.error_extension_node loc msg) + Ast_helper.Mty.extension ~loc (Reason_errors.error_extension_node loc msg) let syntax_error_typ loc msg = - Typ.extension ~loc (Reason_errors.error_extension_node loc msg) + Ast_helper.Typ.extension ~loc (Reason_errors.error_extension_node loc msg) let not_expecting start_pos end_pos nonterm = let location = mklocation start_pos end_pos in @@ -479,29 +481,29 @@ let check_nonrec_absent loc nonrec_flag = let err = {|"nonrec", type substitutions are non recursive by default|} in raise Syntaxerr.(Error(Not_expecting(loc, err))) -let mkexp_fun {Location.txt; loc} body = +let mkexp_fun {Location.txt; loc} (body: Ppxlib.Parsetree.expression) = let loc = mklocation loc.loc_start body.pexp_loc.loc_end in match txt with - | Term (label, default_expr, pat) -> - Exp.fun_ ~loc label default_expr pat body + | Reason_parser_def.Term (label, default_expr, pat) -> + Ast_helper.Exp.fun_ ~loc label default_expr pat body | Type str -> - Exp.newtype ~loc (mkloc str loc) body + Ast_helper.Exp.newtype ~loc (mkloc str loc) body -let mkclass_fun {Location. txt ; loc} body = +let mkclass_fun {Location. txt ; loc} (body: Ppxlib.Parsetree.class_expr) = let loc = mklocation loc.loc_start body.pcl_loc.loc_end in match txt with - | Term (label, default_expr, pat) -> - Cl.fun_ ~loc label default_expr pat body + | Reason_parser_def.Term (label, default_expr, pat) -> + Ast_helper.Cl.fun_ ~loc label default_expr pat body | Type _ -> let pat = syntax_error_pat loc "(type) not allowed in classes" in - Cl.fun_ ~loc Nolabel None pat body + Ast_helper.Cl.fun_ ~loc Nolabel None pat body -let mktyp_arrow ({Location.txt = (label, cod); loc}, uncurried) dom = +let mktyp_arrow ({Location.txt = (label, cod); loc}, uncurried) (dom: Ppxlib.Parsetree.core_type) = let loc = mklocation loc.loc_start dom.ptyp_loc.loc_end in let typ = mktyp ~loc (Ptyp_arrow (label, cod, dom)) in {typ with ptyp_attributes = (if uncurried then [uncurry_payload loc] else [])} -let mkcty_arrow ({Location.txt = (label, cod); loc}, uncurried) dom = +let mkcty_arrow ({Location.txt = (label, cod); loc}, uncurried) (dom: Ppxlib.Parsetree.class_type) = let loc = mklocation loc.loc_start dom.pcty_loc.loc_end in let ct = mkcty ~loc (Pcty_arrow (label, cod, dom)) in {ct with pcty_attributes = (if uncurried then [uncurry_payload loc] else [])} @@ -515,9 +517,10 @@ let mkcty_arrow ({Location.txt = (label, cod); loc}, uncurried) dom = let process_underscore_application args = let exp_question = ref None in let hidden_var = "__x" in - let check_arg ((lab, exp) as arg) = match exp.pexp_desc with + let check_arg ((lab, exp) as arg) = + match exp.Ppxlib.Parsetree.pexp_desc with | Pexp_ident ({ txt = Lident "_"} as id) -> - let new_id = mkloc (Lident hidden_var) id.loc in + let new_id = mkloc (Longident.Lident hidden_var) id.loc in let new_exp = mkexp (Pexp_ident new_id) ~loc:exp.pexp_loc in exp_question := Some new_exp; (lab, new_exp) @@ -527,7 +530,7 @@ let process_underscore_application args = let wrap exp_apply = match !exp_question with | Some {pexp_loc=loc} -> let pattern = mkpat (Ppat_var (mkloc hidden_var loc)) ~loc in - begin match exp_apply.pexp_desc with + begin match exp_apply.Ppxlib.Parsetree.pexp_desc with (* Transform pipe first with underscore application correct: * 5->doStuff(3, _, 7); * (5 |. doStuff)(3, _, 7) @@ -579,7 +582,7 @@ let process_underscore_application args = *) let mkexp_app_rev startp endp (body, args) = let loc = mklocation startp endp in - if args = [] then {body with pexp_loc = loc} + if args = [] then {body with Ppxlib.Parsetree.pexp_loc = loc} else (* * Post process the arguments and transform [@uncurry] into [@bs]. @@ -589,10 +592,10 @@ let mkexp_app_rev startp endp (body, args) = let rec process_args acc es = match es with | (lbl, e)::es -> - let attrs = e.pexp_attributes in + let attrs = e.Ppxlib.Parsetree.pexp_attributes in let hasUncurryAttr = ref false in let newAttrs = List.filter (function - | { attr_name = {txt = "uncurry"}; attr_payload = PStr []; _} -> + | { Ppxlib.Parsetree.attr_name = {txt = "uncurry"}; attr_payload = PStr []; _} -> hasUncurryAttr := true; false | _ -> true) attrs @@ -652,12 +655,12 @@ let mkexp_app_rev startp endp (body, args) = let groups = group (false, []) [] processed_args in make_appl body groups -let mkmod_app mexp marg = +let mkmod_app (mexp: Ppxlib.Parsetree.module_expr) (marg: Ppxlib.Parsetree.module_expr) = mkmod ~loc:(mklocation mexp.pmod_loc.loc_start marg.pmod_loc.loc_end) (Pmod_apply (mexp, marg)) let bigarray_function ?(loc=dummy_loc()) str name = - ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name)) + ghloc ~loc (Longident.Ldot(Ldot(Lident "Bigarray", str), name)) let bigarray_get ?(loc=dummy_loc()) arr arg = let get = if !Clflags.fast then "unsafe_get" else "get" in @@ -704,10 +707,10 @@ let check_variable vl loc v = raise_error (Variable_in_scope (loc,v)) loc let varify_constructors var_names t = - let rec loop t = + let rec loop (t: Ppxlib.Parsetree.core_type) = let desc = match t.ptyp_desc with - | Ptyp_any -> Ptyp_any + | Ptyp_any -> Ppxlib.Parsetree.Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x @@ -721,9 +724,9 @@ let varify_constructors var_names t = | Ptyp_object (lst, o) -> Ptyp_object (List.map - (fun ({ pof_desc; _ } as obj) -> + (fun ({ Ppxlib.Parsetree.pof_desc; _ } as obj) -> let pof_desc' = match pof_desc with - | Otag (s, t) -> Otag (s, loop t) + | Otag (s, t) -> Ppxlib.Parsetree.Otag (s, loop t) | Oinherit t -> Oinherit (loop t) in { obj with pof_desc = pof_desc' }) lst, o) @@ -748,7 +751,7 @@ let varify_constructors var_names t = fun ({ prf_desc; _} as rf) -> let prf_desc' = match prf_desc with | Rtag(label, flag, lst) -> - Rtag(label, flag, List.map loop lst) + Ppxlib.Parsetree.Rtag(label, flag, List.map loop lst) | Rinherit t -> Rinherit (loop t) in @@ -776,12 +779,12 @@ let struct_item_extension (ext_attrs, ext_id) structure_items = mkstr ~ghost:true (Pstr_extension ((ext_id, PStr structure_items), ext_attrs)) let expression_extension ?loc (ext_attrs, ext_id) item_expr = - let extension = (ext_id, PStr [mkstrexp item_expr []]) in + let extension = (ext_id, Ppxlib.Parsetree.PStr [mkstrexp item_expr []]) in let loc = match loc with | Some loc -> loc | None -> make_ghost_loc (dummy_loc ()) in - Exp.extension ~loc ~attrs:ext_attrs extension + Ast_helper.Exp.extension ~loc ~attrs:ext_attrs extension (* There's no more need for these functions - this was for the following: * @@ -808,36 +811,36 @@ let expression_extension ?loc (ext_attrs, ext_id) item_expr = (* wrap_exp_attrs (mkexp d) attrs *) let mkcf_attrs ?(loc=dummy_loc()) d attrs = - Cf.mk ~loc ~attrs d + Ast_helper.Cf.mk ~loc ~attrs d let mkctf_attrs d attrs = - Ctf.mk ~attrs d + Ast_helper.Ctf.mk ~attrs d let mklbs ext rf lb loc = - { lbs_bindings = [lb]; + { Reason_parser_def.lbs_bindings = [lb]; lbs_rec = rf; lbs_extension = ext; lbs_loc = loc; } -let addlbs lbs lbs' = - { lbs with lbs_bindings = lbs.lbs_bindings @ lbs' } +let addlbs (lbs: Reason_parser_def.let_bindings) lbs' = + { lbs with Reason_parser_def.lbs_bindings = lbs.lbs_bindings @ lbs' } -let val_of_let_bindings lbs = - let str = Str.value lbs.lbs_rec lbs.lbs_bindings in +let val_of_let_bindings (lbs: Reason_parser_def.let_bindings) = + let str = Ast_helper.Str.value lbs.lbs_rec lbs.lbs_bindings in match lbs.lbs_extension with | None -> str | Some ext -> struct_item_extension ext [str] -let expr_of_let_bindings ~loc lbs body = - let item_expr = Exp.let_ ~loc lbs.lbs_rec lbs.lbs_bindings body in +let expr_of_let_bindings ~loc (lbs: Reason_parser_def.let_bindings) body = + let item_expr = Ast_helper.Exp.let_ ~loc lbs.lbs_rec lbs.lbs_bindings body in match lbs.lbs_extension with | None -> item_expr | Some ext -> expression_extension ~loc:(make_ghost_loc loc) ext item_expr -let class_of_let_bindings lbs body = +let class_of_let_bindings (lbs: Reason_parser_def.let_bindings) body = if lbs.lbs_extension <> None then raise_error (Not_expecting (lbs.lbs_loc, "extension")) lbs.lbs_loc; - Cl.let_ lbs.lbs_rec lbs.lbs_bindings body + Ast_helper.Cl.let_ lbs.lbs_rec lbs.lbs_bindings body (* * arity_conflict_resolving_mapper is triggered when both "implicit_arity" "explicit_arity" @@ -850,7 +853,8 @@ let class_of_let_bindings lbs body = * unwrap the tuple to expose the inner tuple directly. * *) -let reason_to_ml_swap_operator_mapper = new reason_to_ml_swap_operator_mapper +let reason_to_ml_swap_operator_mapper = + new Reason_syntax_util.reason_to_ml_swap_operator_mapper let reason_mapper = object inherit Ppxlib.Ast_traverse.map as super @@ -858,7 +862,8 @@ let reason_mapper = object match expr with | {pexp_desc=Pexp_construct(lid, args); pexp_loc; - pexp_attributes} when attributes_conflicted "implicit_arity" "explicit_arity" pexp_attributes -> + pexp_attributes} + when Reason_syntax_util.attributes_conflicted "implicit_arity" "explicit_arity" pexp_attributes -> let new_args = match args with | Some {pexp_desc = Pexp_tuple [sp]} -> Some sp @@ -866,7 +871,7 @@ let reason_mapper = object super#expression { pexp_desc=Pexp_construct(lid, new_args); pexp_loc; - pexp_attributes = normalized_attributes "explicit_arity" pexp_attributes; + pexp_attributes = Reason_syntax_util.normalized_attributes "explicit_arity" pexp_attributes; pexp_loc_stack = [] } | x -> super#expression x @@ -874,7 +879,7 @@ let reason_mapper = object match pattern with | {ppat_desc=Ppat_construct(lid, args); ppat_loc; - ppat_attributes} when attributes_conflicted "implicit_arity" "explicit_arity" ppat_attributes -> + ppat_attributes} when Reason_syntax_util.attributes_conflicted "implicit_arity" "explicit_arity" ppat_attributes -> let new_args = match args with | Some (x, {ppat_desc = Ppat_tuple [sp]}) -> Some (x, sp) @@ -883,7 +888,7 @@ let reason_mapper = object super#pattern { ppat_desc=Ppat_construct(lid, new_args); ppat_loc; - ppat_attributes = normalized_attributes "explicit_arity" ppat_attributes; + ppat_attributes = Reason_syntax_util.normalized_attributes "explicit_arity" ppat_attributes; ppat_loc_stack = []; } | x -> super#pattern x @@ -894,15 +899,15 @@ let reason_mapper f a = let rewriteFunctorApp module_name elt loc = let rec applies = function - | Lident _ -> false + | Longident.Lident _ -> false | Ldot (m, _) -> applies m | Lapply (_, _) -> true in let rec flattenModName = function - | Lident id -> id + | Longident.Lident id -> id | Ldot (m, id) -> flattenModName m ^ "." ^ id | Lapply (m1, m2) -> flattenModName m1 ^ "(" ^ flattenModName m2 ^ ")" in let rec mkModExp = function - | Lident id -> mkmod ~loc (Pmod_ident {txt=Lident id; loc}) + | Longident.Lident id -> mkmod ~loc (Pmod_ident {txt=Lident id; loc}) | Ldot (m, id) -> mkmod ~loc (Pmod_ident {txt=Ldot (m, id); loc}) | Lapply (m1, m2) -> mkmod ~loc (Pmod_apply (mkModExp m1, mkModExp m2)) in if applies module_name then @@ -915,7 +920,7 @@ let rewriteFunctorApp module_name elt loc = let jsx_component lid attrs children loc = let is_module_name = function - | Lident s + | Longident.Lident s | Ldot (_, s) -> (* s will be non-empty so the 0th access is fine. Modules can't start with underscore *) String.get s 0 != '_' && s = String.capitalize_ascii s @@ -928,7 +933,7 @@ let jsx_component lid attrs children loc = in let body = mkexp(Pexp_apply(element_fn, attrs @ children)) ~loc in let attribute = { - attr_name = {txt = "JSX"; loc = loc}; + Ppxlib.Parsetree.attr_name = { Location.txt = "JSX"; loc }; attr_payload = PStr []; attr_loc = loc; } @@ -936,14 +941,14 @@ let jsx_component lid attrs children loc = { body with pexp_attributes = attribute :: body.pexp_attributes } let rec ignoreLapply = function - | Lident id -> Lident id + | Longident.Lident id -> Longident.Lident id | Ldot (lid, id) -> Ldot (ignoreLapply lid, id) | Lapply (m1, _) -> ignoreLapply m1 (* Like Longident.flatten, but ignores `Lapply`s. Useful because 1) we don't want to require `Lapply` in closing tags, and 2) Longident.flatten doesn't support `Lapply`. *) let rec flattenWithoutLapply = function - | Lident id -> [id] + | Longident.Lident id -> [id] | Ldot (lid, id) -> flattenWithoutLapply lid @ [id] | Lapply (m1, _) -> flattenWithoutLapply m1 @@ -965,26 +970,26 @@ let doc_loc loc = {txt = "ocaml.doc"; loc = loc} let doc_attr text loc = (* Here is where we will convert from markdown to odoc - transform the "text" *) - let open Parsetree in let exp = - { pexp_desc = Pexp_constant (Pconst_string(text, loc, None)); + { Ppxlib.Parsetree.pexp_desc = Pexp_constant (Pconst_string(text, loc, None)); pexp_loc = loc; pexp_attributes = []; pexp_loc_stack = []; } in let item = - { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } + { Ppxlib.Parsetree.pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { - attr_name = doc_loc loc; + Ppxlib.Parsetree.attr_name = doc_loc loc; attr_payload = PStr [item]; attr_loc = loc } let prepend_attrs_to_labels attrs = function | [] -> [] (* not possible for valid inputs *) - | x :: xs -> {x with pld_attributes = attrs @ x.pld_attributes} :: xs + | (x: Ppxlib.Parsetree.label_declaration) :: xs -> + { x with pld_attributes = attrs @ x.pld_attributes } :: xs let raise_record_trailing_semi_error loc = syntax_error_exp loc @@ -1023,9 +1028,9 @@ let filter_raise_spread_syntax msg nodes = * Rely on the parsing rules for generic module types, and then * extract a package type, enabling more explicit error messages * *) -let package_type_of_module_type pmty = +let package_type_of_module_type (pmty: Ppxlib.Parsetree.module_type) = let map_cstr = function - | Pwith_type (lid, ptyp) -> + | Ppxlib.Parsetree.Pwith_type (lid, ptyp) -> let loc = ptyp.ptype_loc in if ptyp.ptype_params <> [] then syntax_error loc "parametrized types are not supported"; @@ -1053,9 +1058,9 @@ let package_type_of_module_type pmty = Some (lid, List.flatten (List.map map_cstr cstrs)) | _ -> None -let add_brace_attr expr = +let add_brace_attr (expr: Ppxlib.Parsetree.expression) = let attr = { - attr_name = mknoloc "reason.preserve_braces"; + Ppxlib.Parsetree.attr_name = mknoloc "reason.preserve_braces"; attr_payload = PStr []; attr_loc = Location.none } @@ -1408,47 +1413,54 @@ conflicts. implementation: structure EOF - { reason_mapper apply_mapper_to_structure $1 } + { reason_mapper Reason_syntax_util.apply_mapper_to_structure $1 } ; interface: signature EOF - { reason_mapper apply_mapper_to_signature $1 } + { reason_mapper Reason_syntax_util.apply_mapper_to_signature $1 } ; toplevel_phrase: embedded ( EOF { raise End_of_file } - | structure_item SEMI { Ptop_def $1 } - | toplevel_directive SEMI { $1 } - ) { reason_mapper apply_mapper_to_toplevel_phrase $1 } + | structure_item SEMI { Ppxlib.Parsetree.Ptop_def $1 } + | toplevel_directive SEMI { + let x: Ppxlib.Parsetree.toplevel_phrase = $1 + in + x + } + ) { reason_mapper Reason_syntax_util.apply_mapper_to_toplevel_phrase $1 } ; use_file_no_mapper: embedded ( EOF { [] } - | structure_item SEMI use_file_no_mapper { Ptop_def $1 :: $3 } + | structure_item SEMI use_file_no_mapper { Ppxlib.Parsetree.Ptop_def $1 :: $3 } | toplevel_directive SEMI use_file_no_mapper { $1 :: $3 } - | structure_item EOF { [Ptop_def $1 ] } + | structure_item EOF { [Ppxlib.Parsetree.Ptop_def $1 ] } | toplevel_directive EOF { [$1] } - ) { $1 } + ) { + let phrase: Ppxlib.Parsetree.toplevel_phrase list = $1 in + phrase + } ; use_file: - use_file_no_mapper { reason_mapper apply_mapper_to_use_file $1 } + use_file_no_mapper { reason_mapper Reason_syntax_util.apply_mapper_to_use_file $1 } ; parse_core_type: core_type EOF - { reason_mapper apply_mapper_to_type $1 } + { reason_mapper Reason_syntax_util.apply_mapper_to_type $1 } ; parse_expression: expr EOF - { reason_mapper apply_mapper_to_expr $1 } + { reason_mapper Reason_syntax_util.apply_mapper_to_expr $1 } ; parse_pattern: pattern EOF - { reason_mapper apply_mapper_to_pattern $1 } + { reason_mapper Reason_syntax_util.apply_mapper_to_pattern $1 } ; (* Module expressions *) @@ -1456,11 +1468,11 @@ parse_pattern: module_parameter: as_loc ( LPAREN RPAREN - { Unit } + { Ppxlib.Parsetree.Unit } | as_loc(mod_ident) COLON module_type - { Named ($1, $3) } + { Ppxlib.Parsetree.Named ($1, $3) } | as_loc(module_type) - { Named ({ txt = None; loc = $1.loc}, $1.txt) } + { Ppxlib.Parsetree.Named ({ txt = None; loc = $1.loc}, $1.txt) } ) {$1}; %inline two_or_more_module_parameters_comma_list: @@ -1470,7 +1482,7 @@ as_loc functor_parameters: | LPAREN RPAREN { let loc = mklocation $startpos $endpos in - [mkloc Unit loc] + [mkloc Ppxlib.Parsetree.Unit loc] } (* This single parameter case needs to be explicitly specified so that * menhir can automatically remove the conflict between sigature: @@ -1661,37 +1673,37 @@ structure_item: | item_attributes EXTERNAL as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc)) } + mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc)) } | item_attributes EXTERNAL as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc)) } + mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc)) } | type_declarations { let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) } | str_type_extension { mkstr(Pstr_typext $1) } | str_exception_declaration - { mkstr(Pstr_exception (Te.mk_exception ~loc:$1.pext_loc $1)) } + { mkstr(Pstr_exception (Ast_helper.Te.mk_exception ~loc:$1.pext_loc $1)) } | item_attributes opt_LET_MODULE_ident module_binding_body { let loc = mklocation $symbolstartpos $endpos in - mkstr(Pstr_module (Mb.mk $2 $3 ~attrs:$1 ~loc)) } + mkstr(Pstr_module (Ast_helper.Mb.mk $2 $3 ~attrs:$1 ~loc)) } | item_attributes opt_LET_MODULE_REC_ident module_binding_body and_module_bindings* { let loc = mklocation $symbolstartpos $endpos($2) in - mkstr (Pstr_recmodule ((Mb.mk $2 $3 ~attrs:$1 ~loc) :: $4)) + mkstr (Pstr_recmodule ((Ast_helper.Mb.mk $2 $3 ~attrs:$1 ~loc) :: $4)) } | item_attributes MODULE TYPE OF? as_loc(ident) { let loc = mklocation $symbolstartpos $endpos in - mkstr(Pstr_modtype (Mtd.mk $5 ~attrs:$1 ~loc)) } + mkstr(Pstr_modtype (Ast_helper.Mtd.mk $5 ~attrs:$1 ~loc)) } | item_attributes MODULE TYPE OF? as_loc(ident) module_type_body(EQUAL) { let loc = mklocation $symbolstartpos $endpos in - mkstr(Pstr_modtype (Mtd.mk $5 ~typ:$6 ~attrs:$1 ~loc)) } + mkstr(Pstr_modtype (Ast_helper.Mtd.mk $5 ~typ:$6 ~attrs:$1 ~loc)) } | open_declaration { mkstr(Pstr_open $1) } | item_attributes CLASS class_declaration_details and_class_declaration* { let (ident, binding, virt, params) = $3 in let loc = mklocation $symbolstartpos $endpos($3) in - let first = Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc in + let first = Ast_helper.Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc in mkstr (Pstr_class (first :: $4)) } | class_type_declarations @@ -1699,7 +1711,7 @@ structure_item: { mkstr(Pstr_class_type $1) } | item_attributes INCLUDE module_expr { let loc = mklocation $symbolstartpos $endpos in - mkstr(Pstr_include (Incl.mk $3 ~attrs:$1 ~loc)) + mkstr(Pstr_include (Ast_helper.Incl.mk $3 ~attrs:$1 ~loc)) } | item_attributes item_extension (* No sense in having item_extension_sugar for something that's already an @@ -1726,7 +1738,7 @@ module_binding_body: and_module_bindings: item_attributes AND as_loc(mod_ident) module_binding_body - { Mb.mk $3 $4 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } + { Ast_helper.Mb.mk $3 $4 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } ; (* Module types *) @@ -1867,17 +1879,17 @@ signature_item: | item_attributes LET as_loc(val_ident) COLON core_type { let loc = mklocation $startpos($2) $endpos in - Psig_value (Val.mk $3 $5 ~attrs:$1 ~loc) + Psig_value (Ast_helper.Val.mk $3 $5 ~attrs:$1 ~loc) } | item_attributes EXTERNAL as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - Psig_value (Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc) + Psig_value (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc) } | item_attributes EXTERNAL as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - Psig_value (Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc) + Psig_value (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc) } | type_declarations { let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) } @@ -1889,45 +1901,45 @@ signature_item: { Psig_exception $1 } | item_attributes opt_LET_MODULE_ident module_declaration { let loc = mklocation $symbolstartpos $endpos in - Psig_module (Md.mk $2 $3 ~attrs:$1 ~loc) + Psig_module (Ast_helper.Md.mk $2 $3 ~attrs:$1 ~loc) } | item_attributes opt_LET_MODULE_ident EQUAL as_loc(mod_longident) { let loc = mklocation $symbolstartpos $endpos in let loc_mod = mklocation $startpos($4) $endpos($4) in Psig_module ( - Md.mk + Ast_helper.Md.mk $2 - (Mty.alias ~loc:loc_mod $4) + (Ast_helper.Mty.alias ~loc:loc_mod $4) ~attrs:$1 ~loc ) } | item_attributes opt_LET_MODULE as_loc(UIDENT) COLONEQUAL as_loc(mod_ext_longident) - { Psig_modsubst (Ms.mk $3 $5 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos))} + { Psig_modsubst (Ast_helper.Ms.mk $3 $5 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos))} | item_attributes opt_LET_MODULE_REC_ident module_type_body(COLON) and_module_rec_declaration* { let loc = mklocation $symbolstartpos $endpos($3) in - Psig_recmodule (Md.mk $2 $3 ~attrs:$1 ~loc :: $4) } + Psig_recmodule (Ast_helper.Md.mk $2 $3 ~attrs:$1 ~loc :: $4) } | item_attributes MODULE TYPE as_loc(ident) { let loc = mklocation $symbolstartpos $endpos in - Psig_modtype (Mtd.mk $4 ~attrs:$1 ~loc) + Psig_modtype (Ast_helper.Mtd.mk $4 ~attrs:$1 ~loc) } | item_attributes MODULE TYPE as_loc(ident) module_type_body(EQUAL) { let loc = mklocation $symbolstartpos $endpos in - Psig_modtype (Mtd.mk $4 ~typ:$5 ~loc ~attrs:$1) + Psig_modtype (Ast_helper.Mtd.mk $4 ~typ:$5 ~loc ~attrs:$1) } | open_description { Psig_open $1 } | item_attributes INCLUDE module_type { let loc = mklocation $symbolstartpos $endpos in - Psig_include (Incl.mk $3 ~attrs:$1 ~loc) + Ppxlib.Parsetree.Psig_include (Ast_helper.Incl.mk $3 ~attrs:$1 ~loc) } | class_descriptions { Psig_class $1 } | class_type_declarations { Psig_class_type $1 } | item_attributes item_extension - { Psig_extension ($2, $1) } + { Ppxlib.Parsetree.Psig_extension ($2, $1) } ; signature_items: @@ -1940,12 +1952,12 @@ signature_items: open_declaration: item_attributes OPEN override_flag module_expr - { Opn.mk $4 ~override:$3 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } + { Ast_helper.Opn.mk $4 ~override:$3 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } ; open_description: item_attributes OPEN override_flag as_loc(mod_longident) - { Opn.mk $4 ~override:$3 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } + { Ast_helper.Opn.mk $4 ~override:$3 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } ; module_declaration: @@ -1960,7 +1972,7 @@ module_type_body(DELIM): and_module_rec_declaration: item_attributes AND as_loc(mod_ident) module_type_body(COLON) - { Md.mk $3 $4 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } + { Ast_helper.Md.mk $3 $4 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos) } ; (* Class expressions *) @@ -1969,7 +1981,7 @@ and_class_declaration: item_attributes AND class_declaration_details { let (ident, binding, virt, params) = $3 in let loc = mklocation $symbolstartpos $endpos in - Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc + Ast_helper.Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc } ; @@ -1992,7 +2004,7 @@ class_declaration_body: either(preceded(EQUAL, class_expr), class_body_expr) { match $1 with | None -> $2 - | Some ct -> Cl.constraint_ ~loc:(mklocation $symbolstartpos $endpos) $2 ct + | Some ct -> Ast_helper.Cl.constraint_ ~loc:(mklocation $symbolstartpos $endpos) $2 ct } ; @@ -2004,7 +2016,7 @@ mark_position_cl | object_body { mkclass (Pcl_structure $1) } | LET? OPEN override_flag as_loc(mod_longident) SEMI class_expr_lets_and_rest { let loc = mklocation $startpos($2) $endpos($3) in - let od = Opn.mk ~override:$3 ~loc $4 in + let od = Ast_helper.Opn.mk ~override:$3 ~loc $4 in mkclass (Pcl_open (od, $6)) } ) {$1}; @@ -2015,15 +2027,15 @@ object_body: | loption(located_attributes) mark_position_pat(class_self_expr) { let attrs = List.map (fun x -> mkcf ~loc:x.loc (Pcf_attribute x.txt)) $1 in - Cstr.mk $2 attrs } + Ast_helper.Cstr.mk $2 attrs } | loption(located_attributes) mark_position_pat(class_self_expr) SEMI object_body_class_fields { let attrs = List.map (fun x -> mkcf ~loc:x.loc (Pcf_attribute x.txt)) $1 in - Cstr.mk $2 (attrs @ $4) } + Ast_helper.Cstr.mk $2 (attrs @ $4) } | object_body_class_fields { let loc = mklocation $symbolstartpos $symbolstartpos in - Cstr.mk (mkpat ~loc (Ppat_var (mkloc "this" loc))) $1 } + Ast_helper.Cstr.mk (mkpat ~loc (Ppat_var (mkloc "this" loc))) $1 } ; class_self_expr: @@ -2127,7 +2139,7 @@ value: | override_flag mutable_flag as_loc(label) type_constraint EQUAL expr { let loc = mklocation $symbolstartpos $endpos in let e = ghexp_constraint loc $6 $4 in - ($3, $2, Cfk_concrete ($1, e)) } + ($3, $2, Ppxlib.Parsetree.Cfk_concrete ($1, e)) } ; method_: @@ -2162,9 +2174,9 @@ method_: Pexp_poly (Pexp_constraint (methodFunWithNewtypes, non_varified), Some (Ptyp_poly newTypes varified)) *) let (exp_non_varified, poly_vars) = wrap_type_annotation $5 $7 $8 in - let exp = Pexp_poly(exp_non_varified, Some poly_vars) in + let exp = Ppxlib.Parsetree.Pexp_poly(exp_non_varified, Some poly_vars) in let loc = mklocation $symbolstartpos $endpos in - ($2, Cfk_concrete ($1, mkexp ~ghost:true ~loc exp)) + ($2, Ppxlib.Parsetree.Cfk_concrete ($1, mkexp ~ghost:true ~loc exp)) } ; @@ -2328,17 +2340,17 @@ class_sig_body_cty: | class_sig_body { Pcty_signature $1 } | LET? OPEN override_flag as_loc(mod_longident) SEMI as_loc(class_sig_body_cty) { let {txt; loc} = $6 in - let od = Opn.mk ~override:$3 ~loc:(mklocation $startpos($2) $endpos($3)) $4 in + let od = Ast_helper.Opn.mk ~override:$3 ~loc:(mklocation $startpos($2) $endpos($3)) $4 in Pcty_open (od, mkcty ~loc txt) } ; class_sig_body: | class_self_type - { Csig.mk $1 [] } + { Ast_helper.Csig.mk $1 [] } | class_self_type SEMI class_sig_body_fields - { Csig.mk $1 $3 } + { Ast_helper.Csig.mk $1 $3 } | class_sig_body_fields - { Csig.mk (Typ.mk ~loc:(mklocation $symbolstartpos $endpos) Ptyp_any) $1 } + { Ast_helper.Csig.mk (Ast_helper.Typ.mk ~loc:(mklocation $symbolstartpos $endpos) Ptyp_any) $1 } ; class_self_type: @@ -2385,7 +2397,7 @@ class_descriptions: item_attributes CLASS class_description_details and_class_description* { let (ident, binding, virt, params) = $3 in let loc = mklocation $symbolstartpos $endpos in - (Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc :: $4) + (Ast_helper.Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc :: $4) } ; @@ -2393,7 +2405,7 @@ and_class_description: item_attributes AND class_description_details { let (ident, binding, virt, params) = $3 in let loc = mklocation $symbolstartpos $endpos in - Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc + Ast_helper.Ci.mk ident binding ~virt ~params ~attrs:$1 ~loc } ; @@ -2415,7 +2427,7 @@ class_type_declarations: and_class_type_declaration* { let (ident, instance_type, virt, params) = $4 in let loc = mklocation $symbolstartpos $endpos in - (Ci.mk ident instance_type ~virt ~params ~attrs:$1 ~loc :: $5) + (Ast_helper.Ci.mk ident instance_type ~virt ~params ~attrs:$1 ~loc :: $5) } ; @@ -2423,7 +2435,7 @@ and_class_type_declaration: item_attributes AND class_type_declaration_details { let (ident, instance_type, virt, params) = $3 in let loc = mklocation $symbolstartpos $endpos in - Ci.mk ident instance_type ~virt ~params ~attrs:$1 ~loc + Ast_helper.Ci.mk ident instance_type ~virt ~params ~attrs:$1 ~loc } ; @@ -2435,8 +2447,8 @@ class_type_declaration_details: %inline open_dot_declaration: as_loc(mod_longident) { let loc = mklocation $startpos($1) $endpos($1) in - let me = Mod.ident ~loc $1 in - Opn.mk ~loc me } + let me = Ast_helper.Mod.ident ~loc $1 in + Ast_helper.Opn.mk ~loc me } ; (* Core expressions *) @@ -2497,8 +2509,8 @@ seq_expr_no_seq [@recover.expr default_expr ()]: { mkexp (Pexp_letmodule($1, $2, $4)) } | item_attributes LET? OPEN override_flag as_loc(mod_longident) SEMI seq_expr { let loc = (mklocation $startpos($1) $endpos($4)) in - let me = Mod.ident ~loc $5 in - let od = Opn.mk ~override:$4 ~loc me in + let me = Ast_helper.Mod.ident ~loc $5 in + let od = Ast_helper.Opn.mk ~override:$4 ~loc me in let exp = mkexp (Pexp_open(od, $7)) in { exp with pexp_attributes = $1 } } @@ -2516,7 +2528,7 @@ seq_expr_no_seq [@recover.expr default_expr ()]: { let (pbop_pat, pbop_exp, rev_ands) = $2 in let ands = List.rev rev_ands in let pbop_loc = mklocation $symbolstartpos $endpos($2) in - let let_ = {pbop_op = $1; pbop_pat; pbop_exp; pbop_loc} in + let let_ = {Ppxlib.Parsetree.pbop_op = $1; pbop_pat; pbop_exp; pbop_loc} in mkexp ~loc:pbop_loc (Pexp_letop { let_; ands; body = $4}) } ; @@ -2612,15 +2624,15 @@ labeled_pattern_constraint: labeled_pattern: as_loc ( TILDE as_loc(LIDENT) labeled_pattern_constraint - { Term (Labelled $2.txt, None, $3 $2) } + { Reason_parser_def.Term (Labelled $2.txt, None, $3 $2) } | TILDE as_loc(LIDENT) labeled_pattern_constraint EQUAL expr - { Term (Optional $2.txt, Some $5, $3 $2) } + { Reason_parser_def.Term (Optional $2.txt, Some $5, $3 $2) } | TILDE as_loc(LIDENT) labeled_pattern_constraint EQUAL QUESTION - { Term (Optional $2.txt, None, $3 $2) } + { Reason_parser_def.Term (Optional $2.txt, None, $3 $2) } | pattern_optional_constraint - { Term (Nolabel, None, $1) } + { Reason_parser_def.Term (Nolabel, None, $1) } | TYPE LIDENT - { Type $2 } + { Reason_parser_def.Type $2 } ) { $1 } ; @@ -2631,14 +2643,14 @@ as_loc %inline labeled_pattern_list: | LPAREN RPAREN { let loc = mklocation $startpos $endpos in - ([mkloc (Term (Nolabel, None, mkpat_constructor_unit loc loc)) loc], false) + ([mkloc (Reason_parser_def.Term (Nolabel, None, mkpat_constructor_unit loc loc)) loc], false) } | parenthesized(labelled_pattern_comma_list) { ($1, false) } | LPAREN DOT RPAREN { let loc = mklocation $startpos $endpos in - ([mkloc (Term (Nolabel, None, mkpat_constructor_unit loc loc)) loc], true) + ([mkloc (Reason_parser_def.Term (Nolabel, None, mkpat_constructor_unit loc loc)) loc], true) } | LPAREN DOT labelled_pattern_comma_list RPAREN { ($3, true) @@ -2650,7 +2662,7 @@ es6_parameters: | as_loc(UNDERSCORE) { ([{$1 with txt = Term (Nolabel, None, mkpat ~loc:$1.loc Ppat_any)}], false) } | simple_pattern_ident - { ([mkloc (Term (Nolabel, None, $1)) $1.ppat_loc], false) } + { ([mkloc (Reason_parser_def.Term (Nolabel, None, $1)) $1.ppat_loc], false) } ; (* TODO: properly fix JSX labelled/optional stuff *) @@ -2703,11 +2715,11 @@ jsx_arguments: jsx_start_tag_and_args: as_loc(LESSIDENT) jsx_arguments - { let name = parse_lid $1.txt in + { let name = Reason_syntax_util.parse_lid $1.txt in (jsx_component {$1 with txt = name} $2, name) } | LESS as_loc(LIDENT) jsx_arguments - { let name = parse_lid $2.txt in + { let name = Reason_syntax_util.parse_lid $2.txt in (jsx_component {$2 with txt = name} $3, name) } | LESS as_loc(mod_ext_longident) jsx_arguments @@ -2754,7 +2766,7 @@ jsx: { let (component, start) = $1 in let loc = mklocation $startpos($4) $endpos in (* TODO: Make this tag check simply a warning *) - let endName = parse_lid $4 in + let endName = Reason_syntax_util.parse_lid $4 in let _ = ensureTagsAreEqual start endName loc in let siblings = if List.length $3 > 0 then $3 else [] in component [ @@ -2767,7 +2779,7 @@ jsx: { let (component, start) = $1 in let loc = mklocation $symbolstartpos $endpos in (* TODO: Make this tag check simply a warning *) - let endName = parse_lid $4 in + let endName = Reason_syntax_util.parse_lid $4 in let _ = ensureTagsAreEqual start endName loc in let child = $3 in component [ @@ -2795,7 +2807,7 @@ jsx_without_leading_less: let (component, start) = $1 in let loc = mklocation $symbolstartpos $endpos in (* TODO: Make this tag check simply a warning *) - let endName = parse_lid $4 in + let endName = Reason_syntax_util.parse_lid $4 in let _ = ensureTagsAreEqual start endName loc in let siblings = if List.length $3 > 0 then $3 else [] in component [ @@ -2807,7 +2819,7 @@ jsx_without_leading_less: let (component, start) = $1 in let loc = mklocation $symbolstartpos $endpos in (* TODO: Make this tag check simply a warning *) - let endName = parse_lid $4 in + let endName = Reason_syntax_util.parse_lid $4 in let _ = ensureTagsAreEqual start endName loc in let child = $3 in component [ @@ -2896,13 +2908,13 @@ mark_position_exp { mkexp(Pexp_setfield($1, $3, $5)) } | simple_expr LBRACKET expr RBRACKET EQUAL expr { let loc = mklocation $symbolstartpos $endpos in - let exp = Pexp_ident(array_function ~loc "Array" "set") in + let exp = Ppxlib.Parsetree.Pexp_ident(array_function ~loc "Array" "set") in mkexp(Pexp_apply(mkexp ~ghost:true ~loc exp, [Nolabel,$1; Nolabel,$3; Nolabel,$6])) } | simple_expr DOT LBRACKET expr RBRACKET EQUAL expr { let loc = mklocation $symbolstartpos $endpos in - let exp = Pexp_ident(array_function ~loc "String" "set") in + let exp = Ppxlib.Parsetree.Pexp_ident(array_function ~loc "String" "set") in mkexp(Pexp_apply(mkexp ~ghost:true ~loc exp, [Nolabel,$1; Nolabel,$4; Nolabel,$7])) } @@ -2946,11 +2958,11 @@ mark_position_exp let loc_question = mklocation $startpos($2) $endpos($2) in let loc_colon = mklocation $startpos($4) $endpos($4) in let fauxTruePat = - Pat.mk ~loc:loc_question (Ppat_construct({txt = Lident "true"; loc = loc_question}, None)) in + Ast_helper.Pat.mk ~loc:loc_question (Ppat_construct({txt = Lident "true"; loc = loc_question}, None)) in let fauxFalsePat = - Pat.mk ~loc:loc_colon (Ppat_construct({txt = Lident "false"; loc = loc_colon}, None)) in - let fauxMatchCaseTrue = Exp.case fauxTruePat $3 in - let fauxMatchCaseFalse = Exp.case fauxFalsePat $5 in + Ast_helper.Pat.mk ~loc:loc_colon (Ppat_construct({txt = Lident "false"; loc = loc_colon}, None)) in + let fauxMatchCaseTrue = Ast_helper.Exp.case fauxTruePat $3 in + let fauxMatchCaseFalse = Ast_helper.Exp.case fauxFalsePat $5 in mkexp (Pexp_match ($1, [fauxMatchCaseTrue; fauxMatchCaseFalse])) } ) {$1}; @@ -3028,16 +3040,16 @@ parenthesized_expr: | od=open_dot_declaration DOT LBRACE RBRACE { let loc = mklocation $symbolstartpos $endpos in let pat = mkpat (Ppat_var (mkloc "this" loc)) in - mkexp(Pexp_open (od, mkexp(Pexp_object(Cstr.mk pat [])))) + mkexp(Pexp_open (od, mkexp(Pexp_object(Ast_helper.Cstr.mk pat [])))) } | E LBRACKET expr RBRACKET { let loc = mklocation $symbolstartpos $endpos in - let exp = Pexp_ident(array_function ~loc "Array" "get") in + let exp = Ppxlib.Parsetree.Pexp_ident(array_function ~loc "Array" "get") in mkexp(Pexp_apply(mkexp ~ghost:true ~loc exp, [Nolabel,$1; Nolabel,$3])) } | E DOT LBRACKET expr RBRACKET { let loc = mklocation $symbolstartpos $endpos in - let exp = Pexp_ident(array_function ~loc "String" "get") in + let exp = Ppxlib.Parsetree.Pexp_ident(array_function ~loc "String" "get") in mkexp(Pexp_apply(mkexp ~ghost:true ~loc exp, [Nolabel,$1; Nolabel,$4])) } | E bigarray_access @@ -3057,7 +3069,7 @@ parenthesized_expr: } | od=open_dot_declaration DOT LBRACKETBAR expr_list BARRBRACKET { let loc = mklocation $symbolstartpos $endpos in - let rec_exp = Exp.mk ~loc ~attrs:[] (Pexp_array $4) in + let rec_exp = Ast_helper.Exp.mk ~loc ~attrs:[] (Pexp_array $4) in mkexp(Pexp_open(od, rec_exp)) } (* Parse Module.[
] *) @@ -3095,7 +3107,7 @@ parenthesized_expr: { mkexp (Pexp_new $2) } | od=open_dot_declaration DOT LBRACELESS field_expr_list COMMA? GREATERRBRACE { let loc = mklocation $symbolstartpos $endpos in - let exp = Exp.mk ~loc ~attrs:[] (Pexp_override $4) in + let exp = Ast_helper.Exp.mk ~loc ~attrs:[] (Pexp_override $4) in mkexp (Pexp_open(od, exp)) } | E SHARP as_loc(label) @@ -3242,7 +3254,7 @@ labeled_expr_constraint: | DOT? labeled_expr { let uncurried = match $1 with | Some _ -> true | None -> false in if uncurried then - let (lbl, argExpr) = $2 in + let (lbl, (argExpr: Ppxlib.Parsetree.expression)) = $2 in let loc = mklocation $startpos $endpos in let up = uncurry_payload ~name:"uncurry" loc in (lbl, {argExpr with pexp_attributes = up::argExpr.pexp_attributes}) @@ -3279,13 +3291,13 @@ labeled_expr: | TILDE as_loc(LIDENT) EQUAL optional as_loc(UNDERSCORE) { (* foo(~l =_) *) let loc = $5.loc in - let exp = mkexp (Pexp_ident (mkloc (Lident "_") loc)) ~loc in + let exp = mkexp (Pexp_ident (mkloc (Longident.Lident "_") loc)) ~loc in ($4 $2.txt, exp) } | as_loc(UNDERSCORE) { (* foo(_) *) let loc = $1.loc in - let exp = mkexp (Pexp_ident (mkloc (Lident "_") loc)) ~loc in + let exp = mkexp (Pexp_ident (mkloc (Longident.Lident "_") loc)) ~loc in (Nolabel, exp) } ; @@ -3298,7 +3310,7 @@ labeled_expr: *) item_attributes AND let_binding_body { let pat, expr = $3 in - Vb.mk ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 pat expr } + Ast_helper.Vb.mk ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 pat expr } ; let_bindings: let_binding and_let_binding* { addlbs $1 $2 }; @@ -3308,7 +3320,7 @@ let_binding: item_attributes LET item_extension_sugar? rec_flag let_binding_body { let loc = mklocation $symbolstartpos $endpos in let pat, expr = $5 in - mklbs $3 $4 (Vb.mk ~loc ~attrs:$1 pat expr) loc } + mklbs $3 $4 (Ast_helper.Vb.mk ~loc ~attrs:$1 pat expr) loc } ; let_binding_body: @@ -3413,7 +3425,7 @@ letop_bindings: { let let_pat, let_exp, rev_ands = bindings in let pbop_pat, pbop_exp = body in let pbop_loc = mklocation $symbolstartpos $endpos in - let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in + let and_ = {Ppxlib.Parsetree.pbop_op; pbop_pat; pbop_exp; pbop_loc} in let_pat, let_exp, and_ :: rev_ands } ; @@ -3437,7 +3449,7 @@ match_case(EXPR): loc_start = $1.loc.loc_start } } in - Exp.case pat ?guard:$3 $5 } + Ast_helper.Exp.case pat ?guard:$3 $5 } ; fun_def(DELIM, typ): @@ -3449,7 +3461,7 @@ fun_def(DELIM, typ): let exp = List.fold_right mkexp_fun pl (match $2 with | None -> $3 - | Some ct -> Exp.constraint_ ~loc $3 ct) + | Some ct -> Ast_helper.Exp.constraint_ ~loc $3 ct) in if uncurried then {exp with pexp_attributes = (uncurry_payload loc)::exp.pexp_attributes} @@ -3541,7 +3553,7 @@ record_expr_with_string_keys: | STRING COLON expr COMMA? { let loc = mklocation $symbolstartpos $endpos in let (s, _, _) = $1 in - let lident_lident_loc = mkloc (Lident s) loc in + let lident_lident_loc = mkloc (Longident.Lident s) loc in (None, [(lident_lident_loc, $3)]) } | string_literal_expr_maybe_punned_with_comma string_literal_exprs_maybe_punned { @@ -3557,14 +3569,14 @@ string_literal_expr_maybe_punned_with_comma: | STRING COMMA { let loc = mklocation $startpos $endpos in let (s, _, _) = $1 in - let lident_lident_loc = mkloc (Lident s) loc in + let lident_lident_loc = mkloc (Longident.Lident s) loc in let exp = mkexp ~loc (Pexp_ident lident_lident_loc) in (lident_lident_loc, exp) } | STRING COLON expr COMMA { let loc = mklocation $startpos $endpos in let (s, _, _) = $1 in - let lident_lident_loc = mkloc (Lident s) loc in + let lident_lident_loc = mkloc (Longident.Lident s) loc in let exp = $3 in (lident_lident_loc, exp) } @@ -3573,7 +3585,7 @@ string_literal_expr_maybe_punned: STRING preceded(COLON, expr)? { let loc = mklocation $startpos $endpos in let (s, _, _) = $1 in - let lident_lident_loc = mkloc (Lident s) loc in + let lident_lident_loc = mkloc (Longident.Lident s) loc in let exp = match $2 with | Some x -> x | None -> mkexp ~loc (Pexp_ident lident_lident_loc) @@ -3599,7 +3611,7 @@ field_expr: | LIDENT { let loc = mklocation $symbolstartpos $endpos in let lident_loc = mkloc $1 loc in - let lident_lident_loc = mkloc (Lident $1) loc in + let lident_lident_loc = mkloc (Longident.Lident $1) loc in (lident_loc, mkexp (Pexp_ident lident_lident_loc)) } ; @@ -3786,10 +3798,10 @@ simple_pattern_not_ident_: | as_loc(mod_longident) DOT LPAREN pattern RPAREN { let loc = mklocation $symbolstartpos $endpos in mkpat ~loc (Ppat_open ($1, $4)) } - | as_loc(mod_longident) DOT as_loc(LBRACKET RBRACKET {Lident "[]"}) + | as_loc(mod_longident) DOT as_loc(LBRACKET RBRACKET {Longident.Lident "[]"}) { let loc = mklocation $symbolstartpos $endpos in mkpat ~loc (Ppat_open($1, mkpat ~loc:$3.loc (Ppat_construct($3, None)))) } - | as_loc(mod_longident) DOT as_loc(LPAREN RPAREN {Lident "()"}) + | as_loc(mod_longident) DOT as_loc(LPAREN RPAREN {Longident.Lident "()"}) { let loc = mklocation $symbolstartpos $endpos in mkpat ~loc (Ppat_open($1, mkpat ~loc:$3.loc (Ppat_construct($3, None)))) } @@ -3912,7 +3924,7 @@ type_declarations: item_attributes TYPE nonrec_flag type_declaration_details { let (ident, params, constraints, kind, priv, manifest), endpos, and_types = $4 in let loc = mklocation $startpos($2) endpos in - let ty = Type.mk ident ~params:params ~cstrs:constraints + let ty = Ast_helper.Type.mk ident ~params:params ~cstrs:constraints ~kind ~priv ?manifest ~attrs:$1 ~loc in ($3, ty :: and_types) } @@ -3923,7 +3935,7 @@ and_type_declaration: | item_attributes AND type_declaration_details { let (ident, params, cstrs, kind, priv, manifest), endpos, and_types = $3 in let loc = mklocation $symbolstartpos endpos in - Type.mk ident ~params ~cstrs ~kind ~priv ?manifest ~attrs:$1 ~loc + Ast_helper.Type.mk ident ~params ~cstrs ~kind ~priv ?manifest ~attrs:$1 ~loc :: and_types } ; @@ -3956,7 +3968,7 @@ type_subst_kind: ((Ptype_variant (cstrs), $2, None), constraints, endpos, and_types) } | COLONEQUAL core_type EQUAL private_flag type_subst_constructor_declarations { let (cstrs, constraints, endpos, and_types) = $5 in - ((Ptype_variant cstrs, $4, Some $2), constraints, endpos, and_types) } + ((Ppxlib.Parsetree.Ptype_variant cstrs, $4, Some $2), constraints, endpos, and_types) } | type_subst_other_kind constraints and_type_subst_declaration { ($1, $2, $endpos($2), $3) } ; @@ -3967,7 +3979,7 @@ type_subst_declarations: { check_nonrec_absent (mklocation $startpos(nrf) $endpos(nrf)) nrf; let (kind, priv, manifest), cstrs, endpos, and_types = kind_priv_man in let ty = - Type.mk name ~params ~cstrs ~kind ~priv + Ast_helper.Type.mk name ~params ~cstrs ~kind ~priv ?manifest ~attrs:$1 ~loc:(mklocation $symbolstartpos endpos) in @@ -3979,7 +3991,7 @@ and_type_subst_declaration: | item_attributes AND name=as_loc(LIDENT) params=type_variables_with_variance kind_priv_man=type_subst_kind { let (kind, priv, manifest), cstrs, endpos, and_types = kind_priv_man in - Type.mk name ~params ~cstrs + Ast_helper.Type.mk name ~params ~cstrs ~kind ~priv ?manifest ~attrs:$1 ~loc:(mklocation $symbolstartpos endpos) @@ -3998,22 +4010,22 @@ type_subst_other_kind: type_other_kind: | (*empty*) - { (Ptype_abstract, Public, None) } + { (Ppxlib.Parsetree.Ptype_abstract, Public, None) } | nonempty_type_other_kind(EQUAL) { $1 } ; %inline nonempty_type_other_kind(eq_symbol): | eq_symbol private_flag core_type - { (Ptype_abstract, $2, Some $3) } + { (Ppxlib.Parsetree.Ptype_abstract, $2, Some $3) } | eq_symbol private_flag item_attributes record_declaration - { (Ptype_record (prepend_attrs_to_labels $3 $4), $2, None) } + { (Ppxlib.Parsetree.Ptype_record (prepend_attrs_to_labels $3 $4), $2, None) } | eq_symbol private_flag DOTDOT - { (Ptype_open, $2, None) } + { (Ppxlib.Parsetree.Ptype_open, $2, None) } | eq_symbol core_type EQUAL DOTDOT - { (Ptype_open, Public, Some $2) } + { (Ppxlib.Parsetree.Ptype_open, Public, Some $2) } | eq_symbol core_type EQUAL private_flag item_attributes record_declaration - { (Ptype_record (prepend_attrs_to_labels $5 $6), $4, Some $2) } + { (Ppxlib.Parsetree.Ptype_record (prepend_attrs_to_labels $5 $6), $4, Some $2) } ; type_variables_with_variance_comma_list: @@ -4039,7 +4051,7 @@ type_variable_with_variance: | MINUS QUOTE ident { (mktyp (Ptyp_var $3) , (Contravariant, NoInjectivity)) } | MINUS UNDERSCORE { (mktyp Ptyp_any , (Contravariant, NoInjectivity)) } ) - { let first, second = $1 in + { let (first: Ppxlib.Parsetree.core_type), second = $1 in let ptyp_loc = {first.ptyp_loc with loc_start = $symbolstartpos; loc_end = $endpos} in @@ -4104,27 +4116,33 @@ constructor_declaration: item_attributes as_loc(constr_ident) generalized_constructor_arguments { let args, res = $3 in let loc = mklocation $symbolstartpos $endpos in - Type.constructor ~attrs:$1 $2 ~args ?res ~loc } + Ast_helper.Type.constructor ~attrs:$1 $2 ~args ?res ~loc } ; (* Why are there already attribute* on the extension_constructor_declaration? *) str_exception_declaration: item_attributes EXCEPTION either(extension_constructor_declaration, extension_constructor_rebind) - { { $3 with pext_attributes = $3.pext_attributes @ $1} } + { + let expr: Ppxlib.Parsetree.extension_constructor = $3 in + { expr with pext_attributes = expr.pext_attributes @ $1} + } ; sig_exception_declaration: item_attributes EXCEPTION extension_constructor_declaration - { let decl = { $3 with pext_attributes = $3.pext_attributes @ $1} in - Te.mk_exception ~loc:decl.pext_loc decl + { let decl = + let ext: Ppxlib.Parsetree.extension_constructor = $3 in + { ext with pext_attributes = ext.pext_attributes @ $1} + in + Ast_helper.Te.mk_exception ~loc:decl.pext_loc decl } ; generalized_constructor_arguments: constructor_arguments? preceded(COLON,core_type)? - { ((match $1 with None -> Pcstr_tuple [] | Some x -> x), $2) } + { ((match $1 with None -> Ppxlib.Parsetree.Pcstr_tuple [] | Some x -> x), $2) } ; constructor_arguments_comma_list: @@ -4145,11 +4163,11 @@ constructor_arguments: record_label_declaration: | item_attributes mutable_flag as_loc(LIDENT) { let loc = mklocation $symbolstartpos $endpos in - Type.field $3 (mkct $3) ~attrs:$1 ~mut:$2 ~loc + Ast_helper.Type.field $3 (mkct $3) ~attrs:$1 ~mut:$2 ~loc } | item_attributes mutable_flag as_loc(LIDENT) COLON poly_type { let loc = mklocation $symbolstartpos $endpos in - Type.field $3 $5 ~attrs:$1 ~mut:$2 ~loc + Ast_helper.Type.field $3 $5 ~attrs:$1 ~mut:$2 ~loc } ; @@ -4171,7 +4189,7 @@ str_type_extension: attributed_ext_constructors(either(extension_constructor_declaration, extension_constructor_rebind)) { if flag <> Recursive then not_expecting $startpos(flag) $endpos(flag) "nonrec flag"; - Te.mk ~params ~priv ~attrs ident constructors + Ast_helper.Te.mk ~params ~priv ~attrs ident constructors } ; @@ -4185,7 +4203,7 @@ sig_type_extension: attributed_ext_constructors(extension_constructor_declaration) { if flag <> Recursive then not_expecting $startpos(flag) $endpos(flag) "nonrec flag"; - Te.mk ~params ~priv ~attrs ident constructors + Ast_helper.Te.mk ~params ~priv ~attrs ident constructors } ; @@ -4210,14 +4228,14 @@ extension_constructor_declaration: as_loc(constr_ident) generalized_constructor_arguments { let args, res = $2 in let loc = mklocation $symbolstartpos $endpos in - Te.decl $1 ~args ?res ~loc + Ast_helper.Te.decl $1 ~args ?res ~loc } ; extension_constructor_rebind: as_loc(constr_ident) EQUAL as_loc(constr_longident) { let loc = mklocation $symbolstartpos $endpos in - Te.rebind $1 $3 ~loc + Ast_helper.Te.rebind $1 $3 ~loc } ; @@ -4227,7 +4245,7 @@ with_constraint: | TYPE as_loc(label_longident) type_variables_with_variance EQUAL embedded(private_flag) core_type constraints { let loc = mklocation $symbolstartpos $endpos in - let typ = Type.mk {$2 with txt=Longident.last_exn $2.txt} + let typ = Ast_helper.Type.mk {$2 with txt=Longident.last_exn $2.txt} ~params:$3 ~cstrs:$7 ~manifest:$6 ~priv:$5 ~loc in Pwith_type ($2, typ) } @@ -4236,24 +4254,24 @@ with_constraint: | TYPE as_loc(label_longident) type_variables_with_variance COLONEQUAL core_type { let last = match $2.txt with - | Lident s -> s + | Longident.Lident s -> s | other -> not_expecting $startpos($2) $endpos($2) "Long type identifier"; let rec fallback = function - | Lident s -> s + | Longident.Lident s -> s | Ldot (_, s) -> s | Lapply (l, _) -> fallback l in fallback other in let loc = mklocation $symbolstartpos $endpos in - Pwith_typesubst ($2, Type.mk {$2 with txt=last} ~params:$3 ~manifest:$5 ~loc) + Pwith_typesubst ($2, Ast_helper.Type.mk {$2 with txt=last} ~params:$3 ~manifest:$5 ~loc) } | MODULE as_loc(mod_longident) EQUAL as_loc(mod_ext_longident) { Pwith_module ($2, $4) } | MODULE as_loc(UIDENT) COLONEQUAL as_loc(mod_ext_longident) - { let lident = {$2 with txt=Lident $2.txt} in - Pwith_modsubst (lident, $4) } + { let lident = {$2 with txt=Longident.Lident $2.txt} in + Ppxlib.Parsetree.Pwith_modsubst (lident, $4) } ; (* Polymorphic types *) @@ -4479,7 +4497,7 @@ non_arrowed_core_type: ; %inline first_less_than_type_ident: - LESSIDENT { Lident $1 } + LESSIDENT { Longident.Lident $1 } (* Since the - Rf.tag ~loc ~attrs:($1 @ $3.prf_attributes) name amp typs + Ast_helper.Rf.tag ~loc ~attrs:($1 @ $3.prf_attributes) name amp typs | Rinherit typ -> - Rf.inherit_ ~loc { typ with ptyp_attributes = ($1 @ typ.ptyp_attributes) } + Ast_helper.Rf.inherit_ ~loc { typ with ptyp_attributes = ($1 @ typ.ptyp_attributes) } } ; @@ -4630,9 +4648,9 @@ tag_field: | item_attributes as_loc(name_tag) boption(AMPERSAND) separated_nonempty_list(AMPERSAND, non_arrowed_simple_core_types) - { Rf.tag ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 $2 $3 $4 } + { Ast_helper.Rf.tag ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 $2 $3 $4 } | item_attributes as_loc(name_tag) - { Rf.tag ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 $2 true [] } + { Ast_helper.Rf.tag ~loc:(mklocation $symbolstartpos $endpos) ~attrs:$1 $2 true [] } ; (* Constants *) @@ -4646,8 +4664,8 @@ constant: let attr = match raw with | None -> [] | Some raw -> - let constant = Exp.constant (Pconst_string (raw, loc, None)) in - [ { attr_name = mkloc "reason.raw_literal" loc; + let constant = Ast_helper.Exp.constant (Pconst_string (raw, loc, None)) in + [ { Ppxlib.Parsetree.attr_name = mkloc "reason.raw_literal" loc; attr_payload = PStr [mkstrexp constant []]; attr_loc = Location.none } ] @@ -4661,7 +4679,7 @@ signed_constant: | MINUS INT { let (n, m) = $2 in ([], Pconst_integer("-" ^ n, m)) } | MINUS FLOAT { let (f, m) = $2 in ([], Pconst_float("-" ^ f, m)) } | PLUS INT { let (n, m) = $2 in ([], Pconst_integer (n, m)) } - | PLUS FLOAT { let (f, m) = $2 in ([], Pconst_float(f, m)) } + | PLUS FLOAT { let (f, m) = $2 in ([], Ppxlib.Parsetree.Pconst_float(f, m)) } ; (* Identifiers and long identifiers *) @@ -4729,32 +4747,32 @@ operator: val_longident: | val_ident { Lident $1 } - | mod_longident DOT val_ident { Ldot($1, $3) } + | mod_longident DOT val_ident { Longident.Ldot($1, $3) } ; constr_longident: | mod_longident %prec below_DOT { $1 } - | LBRACKET RBRACKET { Lident "[]" } - | LPAREN RPAREN { Lident "()" } - | FALSE { Lident "false" } - | TRUE { Lident "true" } + | LBRACKET RBRACKET { Longident.Lident "[]" } + | LPAREN RPAREN { Longident.Lident "()" } + | FALSE { Longident.Lident "false" } + | TRUE { Longident.Lident "true" } ; label_longident: - | LIDENT { Lident $1 } - | mod_longident DOT LIDENT { Ldot($1, $3) } + | LIDENT { Longident.Lident $1 } + | mod_longident DOT LIDENT { Longident.Ldot($1, $3) } ; type_longident: as_loc(itype_longident) { $1 }; %inline itype_longident: - | LIDENT { Lident $1 } - | mod_ext_longident DOT LIDENT { Ldot($1, $3) } + | LIDENT { Longident.Lident $1 } + | mod_ext_longident DOT LIDENT { Longident.Ldot($1, $3) } ; mod_longident: - | UIDENT { Lident $1 } - | mod_longident DOT UIDENT { Ldot($1, $3) } + | UIDENT { Longident.Lident $1 } + | mod_longident DOT UIDENT { Longident.Ldot($1, $3) } ; /* @@ -4763,16 +4781,16 @@ mod_less_uident_ext_longident: ; %inline imod_less_uident_ext_longident: - | LESSUIDENT { Lident $1 } - | mod_ext_longident DOT UIDENT { Ldot($1, $3) } + | LESSUIDENT { Longident.Lident $1 } + | mod_ext_longident DOT UIDENT { Longident.Ldot($1, $3) } ; */ mod_ext_longident: imod_ext_longident { $1 } %inline imod_ext_longident: - | UIDENT { Lident $1 } - | mod_ext_longident DOT UIDENT { Ldot($1, $3) } + | UIDENT { Longident.Lident $1 } + | mod_ext_longident DOT UIDENT { Longident.Ldot($1, $3) } | mod_ext_apply { $1 } ; @@ -4783,15 +4801,15 @@ mod_ext_apply: let loc = mklocation $startpos $endpos in raise_error (Applicative_path loc) loc ); - List.fold_left (fun p1 p2 -> Lapply (p1, p2)) $1 $2 + List.fold_left (fun p1 p2 -> Longident.Lapply (p1, p2)) $1 $2 } ; mod_ext_lesslongident: imod_ext_lesslongident { $1 } %inline imod_ext_lesslongident: - | LESSUIDENT { Lident $1 } - | mod_ext_lesslongident DOT UIDENT { Ldot($1, $3) } + | LESSUIDENT { Longident.Lident $1 } + | mod_ext_lesslongident DOT UIDENT { Longident.Ldot($1, $3) } | mod_ext_less_apply { $1 } ; @@ -4802,7 +4820,7 @@ mod_ext_less_apply: let loc = mklocation $startpos $endpos in raise_error (Applicative_path loc) loc ); - List.fold_left (fun p1 p2 -> Lapply (p1, p2)) $1 $2 + List.fold_left (fun p1 p2 -> Longident.Lapply (p1, p2)) $1 $2 } ; @@ -4815,17 +4833,17 @@ mod_ext_less_apply: mty_longident: | ident { Lident $1 } - | mod_ext_longident DOT ident { Ldot($1, $3) } + | mod_ext_longident DOT ident { Longident.Ldot($1, $3) } ; clty_longident: | LIDENT { Lident $1 } - | mod_ext_longident DOT LIDENT { Ldot($1, $3) } + | mod_ext_longident DOT LIDENT { Longident.Ldot($1, $3) } ; class_longident: | LIDENT { Lident $1 } - | mod_longident DOT LIDENT { Ldot($1, $3) } + | mod_longident DOT LIDENT { Longident.Ldot($1, $3) } ; (* Toplevel directives *) @@ -4833,22 +4851,22 @@ class_longident: toplevel_directive: SHARP as_loc(ident) embedded ( (* empty *) { None } - | STRING { let (s, _, _) = $1 in Some(Pdir_string s) } - | INT { let (n, m) = $1 in Some(Pdir_int (n, m)) } - | val_longident { Some(Pdir_ident $1) } - | mod_longident { Some(Pdir_ident $1) } - | FALSE { Some(Pdir_bool false) } - | TRUE { Some(Pdir_bool true) } + | STRING { let (s, _, _) = $1 in Some(Ppxlib.Parsetree.Pdir_string s) } + | INT { let (n, m) = $1 in Some(Ppxlib.Parsetree.Pdir_int (n, m)) } + | val_longident { Some(Ppxlib.Parsetree.Pdir_ident $1) } + | mod_longident { Some(Ppxlib.Parsetree.Pdir_ident $1) } + | FALSE { Some(Ppxlib.Parsetree.Pdir_bool false) } + | TRUE { Some(Ppxlib.Parsetree.Pdir_bool true) } ) { let pdir_arg = match $3 with | None -> None | Some pdira_desc -> Some { - pdira_desc; + Ppxlib.Parsetree.pdira_desc; pdira_loc = mklocation $startpos($3) $endpos($3); } in - Ptop_dir + Ppxlib.Parsetree.Ptop_dir { pdir_name = $2 ; pdir_arg ; pdir_loc = $2.loc @@ -5038,8 +5056,8 @@ payload: *) | simple_pattern_ident EQUALGREATER expr { let loc = mklocation $symbolstartpos $endpos in - let expr = Exp.fun_ ~loc Nolabel None $1 $3 in - PStr([mkstrexp expr []]) + let expr = Ast_helper.Exp.fun_ ~loc Nolabel None $1 $3 in + Ppxlib.Parsetree.PStr([mkstrexp expr []]) } ; @@ -5049,43 +5067,77 @@ optional: ; %inline mark_position_mod(X): x = X - { {x with pmod_loc = {x.pmod_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.module_expr = x in + {x with pmod_loc = {x.pmod_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_cty(X): x = X - { {x with pcty_loc = {x.pcty_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x : Ppxlib.Parsetree.class_type = x in + {x with pcty_loc = {x.pcty_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_ctf(X): x = X - { {x with pctf_loc = {x.pctf_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.class_type_field = x in + {x with pctf_loc = {x.pctf_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_exp(X): x = X - { {x with pexp_loc = {x.pexp_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.expression = x in + {x with pexp_loc = {x.pexp_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_typ(X): x = X - { {x with ptyp_loc = {x.ptyp_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.core_type = x in + { x + with ptyp_loc = + { x.ptyp_loc with loc_start = $symbolstartpos; loc_end = $endpos } + } + } ; %inline mark_position_mty(X): x = X - { {x with pmty_loc = {x.pmty_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.module_type = x in + { x + with pmty_loc = + {x.pmty_loc with loc_start = $symbolstartpos; loc_end = $endpos} + } + } ; %inline mark_position_str(X): x = X - { {x with pstr_loc = {x.pstr_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.structure_item = x in + { x + with pstr_loc = + { x.pstr_loc with loc_start = $symbolstartpos; loc_end = $endpos } + } + } ; %inline mark_position_cl(X): x = X - { {x with pcl_loc = {x.pcl_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.class_expr = x in + {x with pcl_loc = {x.pcl_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_cf(X): x = X - { {x with pcf_loc = {x.pcf_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.class_field = x in + {x with pcf_loc = {x.pcf_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline mark_position_pat(X): x = X - { {x with ppat_loc = {x.ppat_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } + { + let x: Ppxlib.Parsetree.pattern = x in + { x + with ppat_loc = + {x.ppat_loc with loc_start = $symbolstartpos; loc_end = $endpos}} } ; %inline as_loc(X): x = X diff --git a/src/reason-parser/reason_parser_def.ml b/src/reason-parser/reason_parser_def.mli similarity index 100% rename from src/reason-parser/reason_parser_def.ml rename to src/reason-parser/reason_parser_def.mli diff --git a/src/reason-parser/reason_toolchain_conf.ml b/src/reason-parser/reason_toolchain_conf.ml index afb1ef87a..87d1f6b85 100644 --- a/src/reason-parser/reason_toolchain_conf.ml +++ b/src/reason-parser/reason_toolchain_conf.ml @@ -1,11 +1,11 @@ open Ppxlib module From_current = struct - include Ppxlib.Selected_ast.Of_ocaml + include Selected_ast.Of_ocaml include Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) end module To_current = struct - include Ppxlib.Selected_ast.To_ocaml + include Selected_ast.To_ocaml include Reason_omp.Convert (Reason_omp.OCaml_414) (Reason_omp.OCaml_current) end From 0da0be2a8c44a0dd492a4a6b47601cdad1da4194 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 17 Jun 2023 21:29:33 -0700 Subject: [PATCH 08/64] prepare to release 3.9 --- dune-project | 2 +- reason.opam | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dune-project b/dune-project index 546b268db..6f47f40e9 100644 --- a/dune-project +++ b/dune-project @@ -34,7 +34,7 @@ (ocaml (and (>= "4.03") - (< "5.1"))) + (< "5.2"))) (ocamlfind :build) (dune-build-info (>= 2.9.3)) diff --git a/reason.opam b/reason.opam index 4eaf5db39..d814410ba 100644 --- a/reason.opam +++ b/reason.opam @@ -16,7 +16,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.1"} + "ocaml" {>= "4.03" & < "5.2"} "ocamlfind" {build} "dune-build-info" {>= "2.9.3"} "menhir" {>= "20180523"} From a2203e09d474db82adec72edff31abb8dc77656d Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 27 Jul 2023 14:02:57 -0700 Subject: [PATCH 09/64] recognize `mel.obj` instead of `bs.obj` (#2721) * recognize `mel.obj` instead of `bs.obj` * uncurrying: bs -> u * fix test --- flake.lock | 26 +++++++++++----------- src/reason-parser/reason_attributes.ml | 2 +- src/reason-parser/reason_parser.mly | 6 +++--- src/reason-parser/reason_pprint_ast.ml | 30 +++++++++++++------------- test/ocaml_identifiers.t/input.ml | 2 +- test/uncurried.t/run.t | 2 +- 6 files changed, 34 insertions(+), 34 deletions(-) diff --git a/flake.lock b/flake.lock index 2483e6b89..7a5ba3942 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1685518550, - "narHash": "sha256-o2d0KcvaXzTrPRIo0kOLV0/QXHhDQ5DTi+OxcjO8xqY=", + "lastModified": 1689068808, + "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", "owner": "numtide", "repo": "flake-utils", - "rev": "a1720a10a6cfe8234c0e93907ffe81be440f4cef", + "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1681154353, - "narHash": "sha256-MCJ5FHOlbfQRFwN0brqPbCunLEVw05D/3sRVoNVt2tI=", + "lastModified": 1687178632, + "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=", "owner": "numtide", "repo": "nix-filter", - "rev": "f529f42792ade8e32c4be274af6b6d60857fbee7", + "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1686968282, - "narHash": "sha256-XDNUgEIvF4dxYYApEkQGkYXji0Cbjjvx673F9Z3c/Yk=", + "lastModified": 1689983586, + "narHash": "sha256-iXoptb2wkyXy1gQDKNFoal4KVEasgWFZAiSERqKgtq0=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "65c280960218799ca5fbad04d9b36e0224615e68", + "rev": "055362e6b820fa29ed59d779bbfa85869b1e9b23", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1686953075, - "narHash": "sha256-wuyQEsKKW38bYzmkH51jrs9k+VtE0iWNLIyCUYapFDk=", + "lastModified": 1689951833, + "narHash": "sha256-wdpIgb5X0p85RRne74TeUOp9ti7a1k9KDSe4NzsaAGk=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "a199713f336d12f8bbc37cdf72a46e08b5cb4797", + "rev": "ebf4e87429ce7faa51a86a36a7b2e615c8bcc735", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "a199713f336d12f8bbc37cdf72a46e08b5cb4797", + "rev": "ebf4e87429ce7faa51a86a36a7b2e615c8bcc735", "type": "github" } }, diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index a272ebdfa..c944eb840 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -17,7 +17,7 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attrib match attrs with | [] -> {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; stylisticAttrs=[]; uncurried = false} - | ({ attr_name = {txt = "bs"}; attr_payload = PStr []; _ } as attr)::atTl -> + | ({ attr_name = {txt = ("u" | "bs")}; attr_payload = PStr []; _ } as attr)::atTl -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in if allowUncurry then {partition with uncurried = true} diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index edebeb6c9..1af8d5bd8 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -145,7 +145,7 @@ let make_floating_doc attr = {attr with attr_name = {attr_name with txt = "ocaml.text"}} | attr -> attr -let uncurry_payload ?(name="bs") loc = +let uncurry_payload ?(name="u") loc = { Ppxlib.Parsetree.attr_name = {loc; txt = name}; attr_payload = PStr []; attr_loc = loc @@ -2495,7 +2495,7 @@ mark_position_exp | LBRACE record_expr_with_string_keys RBRACE { let loc = mklocation $symbolstartpos $endpos in let (exten, fields) = $2 in - mkexp ~loc (Pexp_extension (mkloc ("bs.obj") loc, + mkexp ~loc (Pexp_extension (mkloc ("mel.obj") loc, PStr [mkstrexp (mkexp ~loc (Pexp_record(fields, exten))) []])) } (* Todo: Why is this not a simple_expr? *) @@ -3062,7 +3062,7 @@ parenthesized_expr: | od=open_dot_declaration DOT LBRACE record_expr_with_string_keys RBRACE { let (exten, fields) = $4 in let loc = mklocation $symbolstartpos $endpos in - let rec_exp = mkexp ~loc (Pexp_extension (mkloc ("bs.obj") loc, + let rec_exp = mkexp ~loc (Pexp_extension (mkloc ("mel.obj") loc, PStr [mkstrexp (mkexp ~loc (Pexp_record(fields, exten))) []])) in mkexp(Pexp_open(od, rec_exp)) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 668540a30..3874ccfe4 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -152,7 +152,7 @@ let expression_extension_sugar x = if x.pexp_attributes != [] then None else match x.pexp_desc with | Pexp_extension (name, PStr [{pstr_desc = Pstr_eval(expr, [])}]) - when name.txt <> "bs.obj" -> + when name.txt <> "mel.obj" -> Some (name, expr) | _ -> None @@ -2113,7 +2113,7 @@ let isSingleArgParenApplication = function | [{pexp_attributes = []; pexp_desc = Pexp_tuple _}] | [{pexp_attributes = []; pexp_desc = Pexp_array _}] | [{pexp_attributes = []; pexp_desc = Pexp_object _}] -> true - | [{pexp_attributes = []; pexp_desc = Pexp_extension (s, _)}] when s.txt = "bs.obj" -> true + | [{pexp_attributes = []; pexp_desc = Pexp_extension (s, _)}] when s.txt = "mel.obj" -> true | [({pexp_attributes = []} as exp)] when (is_simple_list_expr exp) -> true | _ -> false @@ -3901,7 +3901,7 @@ let printer = object(self:'self) )} as e -> let args = PipeFirstTree.Args args in begin match pexp_attributes with - | [{ attr_name = {txt = "bs"}; attr_payload = PStr []}] -> + | [{ attr_name = {txt = "u" | "bs"}; attr_payload = PStr []}] -> flatten ((PipeFirstTree.ExpU arg2)::args::acc) arg1 | [] -> (* the uncurried attribute might sit on the Pstr_eval @@ -4358,7 +4358,7 @@ let printer = object(self:'self) | [], Pexp_object {pcstr_fields = []} (* syntax sugar for M.{} *) | [], Pexp_construct ( {txt= Lident"::"},Some _) | [], Pexp_construct ( {txt= Lident"[]"},_) - | [], Pexp_extension ( {txt = "bs.obj"}, _ ) -> + | [], Pexp_extension ( {txt = "mel.obj"}, _ ) -> self#simplifyUnparseExpr e (* syntax sugar for M.[x,y] *) (* syntax sugar for the rest, wrap with parens to avoid ambiguity. * E.g., avoid M.(M2.v) being printed as M.M2.v @@ -6114,7 +6114,7 @@ let printer = object(self:'self) | (Pexp_ident {txt = Lident value}, true, true) when Longident.last_exn li.txt = value -> makeList (maybeQuoteFirstElem li []) - (* Force breaks for nested records or bs obj sugar + (* Force breaks for nested records or mel.obj sugar * Example: * let person = {name: {first: "Bob", last: "Zhmith"}, age: 32}; * is a lot less readable than @@ -6131,7 +6131,7 @@ let printer = object(self:'self) let keyWithColon = makeList (maybeQuoteFirstElem li [atom ":"]) in let value = self#unparseRecord ~forceBreak: true recordRows optionalGadt in label ~space:true keyWithColon value - | (Pexp_extension (s, p), _, _) when s.txt = "bs.obj" -> + | (Pexp_extension (s, p), _, _) when s.txt = "mel.obj" -> forceBreak := true; let keyWithColon = makeList (maybeQuoteFirstElem li [atom ":"]) in let value = self#formatBsObjExtensionSugar ~forceBreak:true p in @@ -6202,7 +6202,7 @@ let printer = object(self:'self) | ([], Pexp_open (me, e)) -> me.popen_override == Fresh && self#isSeriesOfOpensFollowedByNonSequencyExpression e | ([], Pexp_letexception _) -> false - | ([], Pexp_extension ({txt}, _)) -> txt = "bs.obj" + | ([], Pexp_extension ({txt}, _)) -> txt = "mel.obj" | _ -> true method unparseObject ?wrap:((lwrap,rwrap)=("", "")) ?(withStringKeys=false) l o = @@ -6276,14 +6276,14 @@ let printer = object(self:'self) match itm with | {pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (l, eo) }, []) } -> self#unparseRecord ~forceBreak ~wrap ~withStringKeys:true ~allowPunning:false l eo - | {pstr_desc = Pstr_eval ({ pexp_desc = Pexp_extension ({txt = "bs.obj"}, payload) }, []) } -> - (* some folks write `[%bs.obj [%bs.obj {foo: bar}]]`. This looks improbable but - it happens often if you use the sugared version: `[%bs.obj {"foo": bar}]`. + | {pstr_desc = Pstr_eval ({ pexp_desc = Pexp_extension ({txt = "mel.obj"}, payload) }, []) } -> + (* some folks write `[%mel.obj [%mel.obj {foo: bar}]]`. This looks improbable but + it happens often if you use the sugared version: `[%mel.obj {"foo": bar}]`. We're gonna be lenient here and treat it as if they wanted to just write - `{"foo": bar}`. BuckleScript does the same relaxation when parsing bs.obj + `{"foo": bar}`. BuckleScript does the same relaxation when parsing mel.obj *) self#formatBsObjExtensionSugar ~wrap ~forceBreak payload - | _ -> raise (Invalid_argument "bs.obj only accepts a record. You've passed something else")) + | _ -> raise (Invalid_argument "mel.obj only accepts a record. You've passed something else")) | _ -> assert false method should_preserve_requested_braces expr = @@ -6545,10 +6545,10 @@ let printer = object(self:'self) (* [% ...] *) method extension (s, p) = match s.txt with - (* We special case "bs.obj" for now to allow for a nicer interop with + (* We special case "mel.obj" for now to allow for a nicer interop with * BuckleScript. We might be able to generalize to any kind of record * looking thing with struct keys. *) - | "bs.obj" -> self#formatBsObjExtensionSugar p + | "mel.obj" -> self#formatBsObjExtensionSugar p | _ -> (self#payload "%" s p) method item_extension (s, e) = (self#payload "%%" s e) @@ -7966,7 +7966,7 @@ let printer = object(self:'self) self#unparseSequence ~wrap:(lparen, rparen) ~construct:`Array l | [{pexp_attributes = []; pexp_desc = Pexp_object cs}] -> self#classStructure ~wrap:(lparen, rparen) cs - | [{pexp_attributes = []; pexp_desc = Pexp_extension (s, p)}] when s.txt = "bs.obj" -> + | [{pexp_attributes = []; pexp_desc = Pexp_extension (s, p)}] when s.txt = "mel.obj" -> self#formatBsObjExtensionSugar ~wrap:(lparen, rparen) p | [({pexp_attributes = []} as exp)] when (is_simple_list_expr exp) -> (match view_expr exp with diff --git a/test/ocaml_identifiers.t/input.ml b/test/ocaml_identifiers.t/input.ml index 804b25442..0a0044691 100644 --- a/test/ocaml_identifiers.t/input.ml +++ b/test/ocaml_identifiers.t/input.ml @@ -85,7 +85,7 @@ let x = f ~method_:"GET" type marshalFields = < switch: string > Js.t -let testMarshalFields = ([%bs.obj { switch = "switch" }] : marshalFields) +let testMarshalFields = ([%mel.obj { switch = "switch" }] : marshalFields) (* Not an identifier test, but this is testing OCaml -> RE *) let x = List.map (fun y -> diff --git a/test/uncurried.t/run.t b/test/uncurried.t/run.t index a4d347b3c..616efd5fa 100644 --- a/test/uncurried.t/run.t +++ b/test/uncurried.t/run.t @@ -88,7 +88,7 @@ Format uncurried }; class type _rect = - [@bs] + [@u] { [@bs.set] pub height: int; From 972261dab3b651ff8ab9b8b9fcc32940595073dc Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jul 2023 09:59:44 -0700 Subject: [PATCH 10/64] add changelog entry for #2721 --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index e4686ecad..e334c7174 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +## Unreleased + +- Support `@mel.*` attributes in addition to `@bs.*` (@anmonteiro, + [#2721](https://github.com/reasonml/reason/pull/2721)) + ## 3.9.0 - Reduce the amount of parentheses around functor usage (@SanderSpies, [#2683](https://github.com/reasonml/reason/pull/2683)) From a3545e5f40bf90f20214a878bd3072b2365d6504 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 10 Sep 2023 16:18:14 -0700 Subject: [PATCH 11/64] release 3.10 (#2722) --- CHANGES.md | 2 +- flake.lock | 26 +++++++++++++------------- flake.nix | 2 +- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e334c7174..92a18868d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## Unreleased +## 3.10.0 - Support `@mel.*` attributes in addition to `@bs.*` (@anmonteiro, [#2721](https://github.com/reasonml/reason/pull/2721)) diff --git a/flake.lock b/flake.lock index 7a5ba3942..d4f897541 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1689068808, - "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", + "lastModified": 1692799911, + "narHash": "sha256-3eihraek4qL744EvQXsK1Ha6C3CR7nnT8X2qWap4RNk=", "owner": "numtide", "repo": "flake-utils", - "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", + "rev": "f9e7cf818399d17d347f847525c5a5a8032e4e44", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1687178632, - "narHash": "sha256-HS7YR5erss0JCaUijPeyg2XrisEb959FIct3n2TMGbE=", + "lastModified": 1693833173, + "narHash": "sha256-hlMABKrGbEiJD5dwUSfnw1CQ3bG7KKwDV+Nx3bEZd7U=", "owner": "numtide", "repo": "nix-filter", - "rev": "d90c75e8319d0dd9be67d933d8eb9d0894ec9174", + "rev": "ac030bd9ba98e318e1f4c4328d60766ade8ebe8b", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1689983586, - "narHash": "sha256-iXoptb2wkyXy1gQDKNFoal4KVEasgWFZAiSERqKgtq0=", + "lastModified": 1694321661, + "narHash": "sha256-x7eYMZrseg9Mr31T8JdJpWP0nBPnRFZF+CMZyr1BoQU=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "055362e6b820fa29ed59d779bbfa85869b1e9b23", + "rev": "71ddf5eb18018ef1a5e27f34af5df62a0fd68622", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1689951833, - "narHash": "sha256-wdpIgb5X0p85RRne74TeUOp9ti7a1k9KDSe4NzsaAGk=", + "lastModified": 1694254102, + "narHash": "sha256-oM2qC5TyeM1zZE3BQnOodg31a2u/G5DF/Yx02UJRGfc=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "ebf4e87429ce7faa51a86a36a7b2e615c8bcc735", + "rev": "4a76638020344ae8a9f061856431182179ab0d28", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "ebf4e87429ce7faa51a86a36a7b2e615c8bcc735", + "rev": "4a76638020344ae8a9f061856431182179ab0d28", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 4e0a93f6f..7885e8eab 100644 --- a/flake.nix +++ b/flake.nix @@ -10,7 +10,7 @@ flake-utils.lib.eachDefaultSystem (system: let pkgs = nixpkgs.legacyPackages."${system}".extend (self: super: { - ocamlPackages = super.ocaml-ng.ocamlPackages_5_0; + ocamlPackages = super.ocaml-ng.ocamlPackages_5_1; }); in rec { From 2c576b2e9e678e4054aec7af2a2d6748737a4cd6 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 19 Sep 2023 13:19:20 -0700 Subject: [PATCH 12/64] test: reproduce extension bug when nested inside a module --- flake.lock | 26 +++++++++++++------------- test/extension-str-in-module.t | 17 +++++++++++++++++ 2 files changed, 30 insertions(+), 13 deletions(-) create mode 100644 test/extension-str-in-module.t diff --git a/flake.lock b/flake.lock index d4f897541..43e4fadc6 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1692799911, - "narHash": "sha256-3eihraek4qL744EvQXsK1Ha6C3CR7nnT8X2qWap4RNk=", + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", "owner": "numtide", "repo": "flake-utils", - "rev": "f9e7cf818399d17d347f847525c5a5a8032e4e44", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1693833173, - "narHash": "sha256-hlMABKrGbEiJD5dwUSfnw1CQ3bG7KKwDV+Nx3bEZd7U=", + "lastModified": 1694857738, + "narHash": "sha256-bxxNyLHjhu0N8T3REINXQ2ZkJco0ABFPn6PIe2QUfqo=", "owner": "numtide", "repo": "nix-filter", - "rev": "ac030bd9ba98e318e1f4c4328d60766ade8ebe8b", + "rev": "41fd48e00c22b4ced525af521ead8792402de0ea", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1694321661, - "narHash": "sha256-x7eYMZrseg9Mr31T8JdJpWP0nBPnRFZF+CMZyr1BoQU=", + "lastModified": 1695149910, + "narHash": "sha256-rzpTFXX0yVO02Y2l9J+9zcnHEEWJ0/uKB74aBoW8PUs=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "71ddf5eb18018ef1a5e27f34af5df62a0fd68622", + "rev": "c9e78a97c6dc5ce6ec9a96aaabe74e21f2a485d8", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1694254102, - "narHash": "sha256-oM2qC5TyeM1zZE3BQnOodg31a2u/G5DF/Yx02UJRGfc=", + "lastModified": 1695043561, + "narHash": "sha256-ajrDIUJA5RB6Y2I1G4suDhiDMJuwg1WarNuasshRobE=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "4a76638020344ae8a9f061856431182179ab0d28", + "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "4a76638020344ae8a9f061856431182179ab0d28", + "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", "type": "github" } }, diff --git a/test/extension-str-in-module.t b/test/extension-str-in-module.t new file mode 100644 index 000000000..f1c7a0284 --- /dev/null +++ b/test/extension-str-in-module.t @@ -0,0 +1,17 @@ +Format extensions in modules + + $ refmt < [%%toplevelExtension "payload"]; + > module X = { + > /* No payload */ + > [%%someExtension]; + > [%%someExtension "payload"]; + > }; + > EOF + [%%toplevelExtension "payload"]; + module X = { + /* No payload */ + [%%someExtension]; + [%someExtension "payload"]; + }; + From 67b12bdc8f545c868a839c52d2a6070c2fb5c838 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 19 Sep 2023 14:10:36 -0700 Subject: [PATCH 13/64] fix: structure item extensions in nested modules --- src/reason-parser/reason_pprint_ast.ml | 32 ++++++++------------------ test/extension-str-in-module.t | 2 +- 2 files changed, 11 insertions(+), 23 deletions(-) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 3874ccfe4..4784535d6 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5570,11 +5570,11 @@ let printer = object(self:'self) * brace {} in the let sequence. *) let layout = source_map ~loc:letModuleLoc letModuleLayout in let (_, return) = self#curriedFunctorPatternsAndReturnStruct moduleExpr in - let loc = { - letModuleLoc with - loc_end = return.pmod_loc.loc_end - } in - processLetList ((loc, layout)::acc) e + let loc = { + letModuleLoc with + loc_end = return.pmod_loc.loc_end + } in + processLetList ((loc, layout)::acc) e | ([], Pexp_letexception (extensionConstructor, expr)) -> let exc = self#exception_declaration extensionConstructor in let layout = source_map ~loc:extensionConstructor.pext_loc exc in @@ -7548,20 +7548,7 @@ let printer = object(self:'self) else ("({", "})") else ("{", "}") in - let items = - groupAndPrint - ~xf:self#structure_item - ~getLoc:(fun x -> x.pstr_loc) - ~comments:self#comments - s - in - makeList - ~break:Layout.Always_rec - ~inline:(true, false) - ~wrap - ~postSpace:true - ~sep:(SepFinal (";", ";")) - items + self#structure ~indent:None ~wrap s | _ -> (* For example, functor application will be wrapped. *) formatPrecedence ~wrap:("", "") (self#module_expr x) @@ -7582,7 +7569,7 @@ let printer = object(self:'self) | Pmod_constraint _ | Pmod_structure _ -> self#simple_module_expr x - method structure structureItems = + method structure ?(indent=Some 0) ?wrap structureItems = (* We don't have any way to know if an extension is placed at the top level by the parsetree while there's a difference syntactically (% for structure_items/expressons and %% for top_level). This small fn detects this particular case (structure > structure_item > extension > value) and @@ -7598,7 +7585,7 @@ let printer = object(self:'self) | _ -> self#structure_item item in match structureItems with - | [] -> atom "" + | [] -> makeList ?wrap [] | first :: _ as structureItems -> let last = match (List.rev structureItems) with | last::_ -> last | [] -> assert false in let loc_start = first.pstr_loc.loc_start in @@ -7614,7 +7601,8 @@ let printer = object(self:'self) (makeList ~postSpace:true ~break:Always_rec - ~indent:0 + ?wrap + ?indent ~inline:(true, false) ~sep:(SepFinal (";", ";")) items) diff --git a/test/extension-str-in-module.t b/test/extension-str-in-module.t index f1c7a0284..87d40152f 100644 --- a/test/extension-str-in-module.t +++ b/test/extension-str-in-module.t @@ -12,6 +12,6 @@ Format extensions in modules module X = { /* No payload */ [%%someExtension]; - [%someExtension "payload"]; + [%%someExtension "payload"]; }; From f92f7ecc228d19ebf4d9d0214792da7b45472766 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Tue, 19 Sep 2023 14:44:54 -0700 Subject: [PATCH 14/64] chore: add changelog entry --- CHANGES.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 92a18868d..6be902d35 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +## Unreleased + +- Print structure items extension nodes correctly inside modules (@anmonteiro, + [#2723](https://github.com/reasonml/reason/pull/2723)) + ## 3.10.0 - Support `@mel.*` attributes in addition to `@bs.*` (@anmonteiro, From d47e613b736cc25629aabc1c8ef91795e265eacb Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Wed, 4 Oct 2023 17:52:07 -0700 Subject: [PATCH 15/64] fix: record constraint pattern (#2725) undefined --- CHANGES.md | 2 ++ flake.lock | 14 +++++++------- src/reason-parser/reason_pprint_ast.ml | 11 ++++++++++- test/wrapping-re.t/input.re | 5 ++++- test/wrapping-re.t/run.t | 2 ++ 5 files changed, 25 insertions(+), 9 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 6be902d35..7cb4853de 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,8 @@ - Print structure items extension nodes correctly inside modules (@anmonteiro, [#2723](https://github.com/reasonml/reason/pull/2723)) +- Print wrapped type constraint on record patterns (@anmonteiro, + [#2725](https://github.com/reasonml/reason/pull/2725)) ## 3.10.0 diff --git a/flake.lock b/flake.lock index 43e4fadc6..1f84b9ff7 100644 --- a/flake.lock +++ b/flake.lock @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1695149910, - "narHash": "sha256-rzpTFXX0yVO02Y2l9J+9zcnHEEWJ0/uKB74aBoW8PUs=", + "lastModified": 1696357929, + "narHash": "sha256-FJ8SgB4rgAXD1qjplpWAr14mudSSnOrShjbuhC9w2M0=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "c9e78a97c6dc5ce6ec9a96aaabe74e21f2a485d8", + "rev": "6fe39115c01d42e452f837ed38ae7a244a78f699", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1695043561, - "narHash": "sha256-ajrDIUJA5RB6Y2I1G4suDhiDMJuwg1WarNuasshRobE=", + "lastModified": 1696303624, + "narHash": "sha256-mL5k0klTRO3/59HCI8U1QujzGsnyL0GtQI+5XABXDNA=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", + "rev": "4d29250d5b55fe14280906afad7afacd910850b8", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "089313d7c7c864b21648d78fb8700062dafab1f2", + "rev": "4d29250d5b55fe14280906afad7afacd910850b8", "type": "github" } }, diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 4784535d6..ba092976a 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -5760,7 +5760,16 @@ let printer = object(self:'self) (* works with module prefix too: {ReasonReact.state: state as prevState} becomes {ReasonReact.state as prevState *) makeList ~sep:(Sep " ") [self#longident_loc li; atom "as"; atom aliasIdent] | _ -> - label ~space:true (makeList [self#longident_loc li; atom ":"]) (self#pattern p) + let pattern = + let formatted = self#pattern p in + let wrap = + match p.ppat_desc with + | Ppat_constraint (_, _) -> Some("(", ")") + | _ -> None + in + makeList ~inline:(true, true) ?wrap [ formatted ] + in + label ~space:true (makeList [self#longident_loc li; atom ":"]) pattern in let rows = (List.map longident_x_pattern l)@( match closed with diff --git a/test/wrapping-re.t/input.re b/test/wrapping-re.t/input.re index 01fe0339f..13a9e533b 100644 --- a/test/wrapping-re.t/input.re +++ b/test/wrapping-re.t/input.re @@ -1486,7 +1486,7 @@ let funcOnSomeRecord /* With two args */ let funcOnSomeConstructorHi - (SomeConstructorHi(x,y), secondArg) = + (SomeConstructorHi(x,y), secondArg) = x + y; let funcOnSomeRecord @@ -1982,3 +1982,6 @@ fooSpreadES6List([ "more tests", ...x ]); + +let { foo: (_: int), } = 2; + diff --git a/test/wrapping-re.t/run.t b/test/wrapping-re.t/run.t index c8823ac54..29ce4349f 100644 --- a/test/wrapping-re.t/run.t +++ b/test/wrapping-re.t/run.t @@ -2904,3 +2904,5 @@ Format wrapping in .re files "more tests", ...x, ]); + + let {foo: (_: int)} = 2; From 56ceb6a3d87a2a46a94af99974e724838386ae70 Mon Sep 17 00:00:00 2001 From: prometheansacrifice <3097018+ManasJayanth@users.noreply.github.com> Date: Fri, 10 Nov 2023 04:57:26 +0530 Subject: [PATCH 16/64] Rtop for ocaml5 (#2731) * rtop package: relax compiler constraint to < 5.2 * Update lock files: rtop.esy.lock --- dune-project | 2 +- rtop.esy.lock/.gitattributes | 3 + rtop.esy.lock/.gitignore | 3 + rtop.esy.lock/index.json | 1231 +++++++++++++++++ rtop.esy.lock/opam/base-bytes.base/opam | 9 + rtop.esy.lock/opam/base-threads.base/opam | 6 + rtop.esy.lock/opam/base-unix.base/opam | 6 + rtop.esy.lock/opam/cppo.1.6.9/opam | 39 + rtop.esy.lock/opam/csexp.1.5.2/opam | 58 + rtop.esy.lock/opam/dot-merlin-reader.4.9/opam | 30 + .../opam/dune-build-info.3.11.1/opam | 46 + .../opam/dune-configurator.3.11.1/opam | 50 + rtop.esy.lock/opam/dune.3.11.1/opam | 57 + rtop.esy.lock/opam/fix.20230505/opam | 26 + rtop.esy.lock/opam/lambda-term.3.3.2/opam | 49 + rtop.esy.lock/opam/logs.0.7.0/opam | 66 + rtop.esy.lock/opam/lwt.5.7.0/opam | 57 + rtop.esy.lock/opam/lwt_react.1.2.0/opam | 34 + rtop.esy.lock/opam/menhir.20230608/opam | 29 + rtop.esy.lock/opam/menhirLib.20230608/opam | 30 + rtop.esy.lock/opam/menhirSdk.20230608/opam | 30 + rtop.esy.lock/opam/merlin-extend.0.6.1/opam | 30 + rtop.esy.lock/opam/merlin-lib.4.12-501/opam | 34 + rtop.esy.lock/opam/merlin.4.12-501/opam | 81 ++ rtop.esy.lock/opam/mew.0.1.0/opam | 25 + rtop.esy.lock/opam/mew_vi.0.5.0/opam | 25 + .../opam/ocaml-compiler-libs.v0.12.4/opam | 39 + rtop.esy.lock/opam/ocamlbuild.0.14.2+win/opam | 38 + .../files/0001-Harden-test-for-OCaml-5.patch | 12 + rtop.esy.lock/opam/ocamlfind.1.9.6/opam | 48 + rtop.esy.lock/opam/ocplib-endian.1.2/opam | 40 + rtop.esy.lock/opam/ppx_derivers.1.2.1/opam | 23 + rtop.esy.lock/opam/ppxlib.0.31.0/opam | 61 + rtop.esy.lock/opam/react.1.2.2/opam | 34 + rtop.esy.lock/opam/reason.3.10.0/opam | 51 + rtop.esy.lock/opam/result.1.5/opam | 22 + rtop.esy.lock/opam/seq.base/files/META.seq | 4 + rtop.esy.lock/opam/seq.base/files/seq.install | 3 + rtop.esy.lock/opam/seq.base/opam | 15 + rtop.esy.lock/opam/sexplib0.v0.16.0/opam | 26 + rtop.esy.lock/opam/stdlib-shims.0.3.0/opam | 31 + rtop.esy.lock/opam/topkg.1.0.7/opam | 47 + rtop.esy.lock/opam/trie.1.0.0/opam | 19 + rtop.esy.lock/opam/uchar.0.0.2/opam | 36 + rtop.esy.lock/opam/utop.2.13.1/opam | 50 + rtop.esy.lock/opam/uucp.15.1.0/opam | 51 + rtop.esy.lock/opam/uuseg.15.1.0/opam | 55 + rtop.esy.lock/opam/uutf.1.0.3/opam | 36 + rtop.esy.lock/opam/xdg.3.11.1/opam | 40 + rtop.esy.lock/opam/yojson.2.1.1/opam | 48 + rtop.esy.lock/opam/zed.3.2.3/opam | 48 + .../files/ocamlbuild-0.14.2.patch | 0 .../files/winpatch.patch | 11 + .../package.json | 29 + .../files/findlib.patch | 11 + .../package.json | 61 + .../files/winpatch.patch | 11 + .../package.json | 11 + rtop.json | 6 +- rtop.opam | 2 +- 60 files changed, 3070 insertions(+), 5 deletions(-) create mode 100644 rtop.esy.lock/.gitattributes create mode 100644 rtop.esy.lock/.gitignore create mode 100644 rtop.esy.lock/index.json create mode 100644 rtop.esy.lock/opam/base-bytes.base/opam create mode 100644 rtop.esy.lock/opam/base-threads.base/opam create mode 100644 rtop.esy.lock/opam/base-unix.base/opam create mode 100644 rtop.esy.lock/opam/cppo.1.6.9/opam create mode 100644 rtop.esy.lock/opam/csexp.1.5.2/opam create mode 100644 rtop.esy.lock/opam/dot-merlin-reader.4.9/opam create mode 100644 rtop.esy.lock/opam/dune-build-info.3.11.1/opam create mode 100644 rtop.esy.lock/opam/dune-configurator.3.11.1/opam create mode 100644 rtop.esy.lock/opam/dune.3.11.1/opam create mode 100644 rtop.esy.lock/opam/fix.20230505/opam create mode 100644 rtop.esy.lock/opam/lambda-term.3.3.2/opam create mode 100644 rtop.esy.lock/opam/logs.0.7.0/opam create mode 100644 rtop.esy.lock/opam/lwt.5.7.0/opam create mode 100644 rtop.esy.lock/opam/lwt_react.1.2.0/opam create mode 100644 rtop.esy.lock/opam/menhir.20230608/opam create mode 100644 rtop.esy.lock/opam/menhirLib.20230608/opam create mode 100644 rtop.esy.lock/opam/menhirSdk.20230608/opam create mode 100644 rtop.esy.lock/opam/merlin-extend.0.6.1/opam create mode 100644 rtop.esy.lock/opam/merlin-lib.4.12-501/opam create mode 100644 rtop.esy.lock/opam/merlin.4.12-501/opam create mode 100644 rtop.esy.lock/opam/mew.0.1.0/opam create mode 100644 rtop.esy.lock/opam/mew_vi.0.5.0/opam create mode 100644 rtop.esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam create mode 100644 rtop.esy.lock/opam/ocamlbuild.0.14.2+win/opam create mode 100644 rtop.esy.lock/opam/ocamlfind.1.9.6/files/0001-Harden-test-for-OCaml-5.patch create mode 100644 rtop.esy.lock/opam/ocamlfind.1.9.6/opam create mode 100644 rtop.esy.lock/opam/ocplib-endian.1.2/opam create mode 100644 rtop.esy.lock/opam/ppx_derivers.1.2.1/opam create mode 100644 rtop.esy.lock/opam/ppxlib.0.31.0/opam create mode 100644 rtop.esy.lock/opam/react.1.2.2/opam create mode 100644 rtop.esy.lock/opam/reason.3.10.0/opam create mode 100644 rtop.esy.lock/opam/result.1.5/opam create mode 100644 rtop.esy.lock/opam/seq.base/files/META.seq create mode 100644 rtop.esy.lock/opam/seq.base/files/seq.install create mode 100644 rtop.esy.lock/opam/seq.base/opam create mode 100644 rtop.esy.lock/opam/sexplib0.v0.16.0/opam create mode 100644 rtop.esy.lock/opam/stdlib-shims.0.3.0/opam create mode 100644 rtop.esy.lock/opam/topkg.1.0.7/opam create mode 100644 rtop.esy.lock/opam/trie.1.0.0/opam create mode 100644 rtop.esy.lock/opam/uchar.0.0.2/opam create mode 100644 rtop.esy.lock/opam/utop.2.13.1/opam create mode 100644 rtop.esy.lock/opam/uucp.15.1.0/opam create mode 100644 rtop.esy.lock/opam/uuseg.15.1.0/opam create mode 100644 rtop.esy.lock/opam/uutf.1.0.3/opam create mode 100644 rtop.esy.lock/opam/xdg.3.11.1/opam create mode 100644 rtop.esy.lock/opam/yojson.2.1.1/opam create mode 100644 rtop.esy.lock/opam/zed.3.2.3/opam create mode 100644 rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/ocamlbuild-0.14.2.patch create mode 100644 rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/winpatch.patch create mode 100644 rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/package.json create mode 100644 rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch create mode 100644 rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json create mode 100644 rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/files/winpatch.patch create mode 100644 rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/package.json diff --git a/dune-project b/dune-project index 6f47f40e9..a9e1089a0 100644 --- a/dune-project +++ b/dune-project @@ -56,7 +56,7 @@ (ocaml (and (>= "4.03") - (< "5.1"))) + (< "5.2"))) (reason (= :version)) (utop diff --git a/rtop.esy.lock/.gitattributes b/rtop.esy.lock/.gitattributes new file mode 100644 index 000000000..e0b4e26c5 --- /dev/null +++ b/rtop.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/rtop.esy.lock/.gitignore b/rtop.esy.lock/.gitignore new file mode 100644 index 000000000..a221be227 --- /dev/null +++ b/rtop.esy.lock/.gitignore @@ -0,0 +1,3 @@ + +# Reset any possible .gitignore, we want all esy.lock to be un-ignored. +!* diff --git a/rtop.esy.lock/index.json b/rtop.esy.lock/index.json new file mode 100644 index 000000000..3ca4e29ae --- /dev/null +++ b/rtop.esy.lock/index.json @@ -0,0 +1,1231 @@ +{ + "checksum": "73942c99544ff080661a28f66af5109c", + "root": "@esy-ocaml/rtop@link-dev:./rtop.json", + "node": { + "ocaml@5.1.4@d41d8cd9": { + "id": "ocaml@5.1.4@d41d8cd9", + "name": "ocaml", + "version": "5.1.4", + "source": { + "type": "install", + "source": [ + "archive:https://registry.npmjs.org/ocaml/-/ocaml-5.1.4.tgz#sha1:51c3dd9ef69db5ad52c6431ba6336095e37215ab" + ] + }, + "overrides": [], + "dependencies": [], + "devDependencies": [] + }, + "@opam/zed@opam:3.2.3@57ab913c": { + "id": "@opam/zed@opam:3.2.3@57ab913c", + "name": "@opam/zed", + "version": "opam:3.2.3", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/63/637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b#sha512:637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b", + "archive:https://github.com/ocaml-community/zed/archive/refs/tags/3.2.3.tar.gz#sha512:637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b" + ], + "opam": { + "name": "zed", + "version": "3.2.3", + "path": "rtop.esy.lock/opam/zed.3.2.3" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uuseg@opam:15.1.0@af4a84a3", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/uchar@opam:0.0.2@aedf91f9", + "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uuseg@opam:15.1.0@af4a84a3", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/uchar@opam:0.0.2@aedf91f9", + "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/yojson@opam:2.1.1@ad5e299c": { + "id": "@opam/yojson@opam:2.1.1@ad5e299c", + "name": "@opam/yojson", + "version": "opam:2.1.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/d5/d58183207b198dc065866239066e074c34f9e139c0d9c4175a38809790e88173#sha256:d58183207b198dc065866239066e074c34f9e139c0d9c4175a38809790e88173", + "archive:https://github.com/ocaml-community/yojson/releases/download/2.1.1/yojson-2.1.1.tbz#sha256:d58183207b198dc065866239066e074c34f9e139c0d9c4175a38809790e88173" + ], + "opam": { + "name": "yojson", + "version": "2.1.1", + "path": "rtop.esy.lock/opam/yojson.2.1.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@opam/cppo@opam:1.6.9@db929a12", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/xdg@opam:3.11.1@1e207b0b": { + "id": "@opam/xdg@opam:3.11.1@1e207b0b", + "name": "@opam/xdg", + "version": "opam:3.11.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/86/866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71", + "archive:https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + ], + "opam": { + "name": "xdg", + "version": "3.11.1", + "path": "rtop.esy.lock/opam/xdg.3.11.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/uutf@opam:1.0.3@47c95a18": { + "id": "@opam/uutf@opam:1.0.3@47c95a18", + "name": "@opam/uutf", + "version": "opam:1.0.3", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/50/50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8#sha512:50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8", + "archive:https://erratique.ch/software/uutf/releases/uutf-1.0.3.tbz#sha512:50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8" + ], + "opam": { + "name": "uutf", + "version": "1.0.3", + "path": "rtop.esy.lock/opam/uutf.1.0.3" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/uuseg@opam:15.1.0@af4a84a3": { + "id": "@opam/uuseg@opam:15.1.0@af4a84a3", + "name": "@opam/uuseg", + "version": "opam:15.1.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/1e/1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a#sha512:1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a", + "archive:https://erratique.ch/software/uuseg/releases/uuseg-15.1.0.tbz#sha512:1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a" + ], + "opam": { + "name": "uuseg", + "version": "15.1.0", + "path": "rtop.esy.lock/opam/uuseg.15.1.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/uucp@opam:15.1.0@ef3e0a4e" + ] + }, + "@opam/uucp@opam:15.1.0@ef3e0a4e": { + "id": "@opam/uucp@opam:15.1.0@ef3e0a4e", + "name": "@opam/uucp", + "version": "opam:15.1.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/99/998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364#sha512:998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364", + "archive:https://erratique.ch/software/uucp/releases/uucp-15.1.0.tbz#sha512:998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364" + ], + "opam": { + "name": "uucp", + "version": "15.1.0", + "path": "rtop.esy.lock/opam/uucp.15.1.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/utop@opam:2.13.1@dc6689f5": { + "id": "@opam/utop@opam:2.13.1@dc6689f5", + "name": "@opam/utop", + "version": "opam:2.13.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/b0/b04ec2a394d1a6a28a79444c58f66eab77b7f74401f4714aa6e6f1c2125a6ffd#sha256:b04ec2a394d1a6a28a79444c58f66eab77b7f74401f4714aa6e6f1c2125a6ffd", + "archive:https://github.com/ocaml-community/utop/releases/download/2.13.1/utop-2.13.1.tbz#sha256:b04ec2a394d1a6a28a79444c58f66eab77b7f74401f4714aa6e6f1c2125a6ffd" + ], + "opam": { + "name": "utop", + "version": "2.13.1", + "path": "rtop.esy.lock/opam/utop.2.13.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/xdg@opam:3.11.1@1e207b0b", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/lwt_react@opam:1.2.0@4253a145", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@46a3dffc", + "@opam/lambda-term@opam:3.3.2@0f91853c", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/xdg@opam:3.11.1@1e207b0b", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/lwt_react@opam:1.2.0@4253a145", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@46a3dffc", + "@opam/lambda-term@opam:3.3.2@0f91853c", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084" + ] + }, + "@opam/uchar@opam:0.0.2@aedf91f9": { + "id": "@opam/uchar@opam:0.0.2@aedf91f9", + "name": "@opam/uchar", + "version": "opam:0.0.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/c9/c9ba2c738d264c420c642f7bb1cf4a36#md5:c9ba2c738d264c420c642f7bb1cf4a36", + "archive:https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz#md5:c9ba2c738d264c420c642f7bb1cf4a36" + ], + "opam": { + "name": "uchar", + "version": "0.0.2", + "path": "rtop.esy.lock/opam/uchar.0.0.2" + } + }, + "overrides": [ + { + "opamoverride": "rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override" + } + ], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/trie@opam:1.0.0@f4e510e2": { + "id": "@opam/trie@opam:1.0.0@f4e510e2", + "name": "@opam/trie", + "version": "opam:1.0.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/84/84519b5f8bd92490bfc68a52f706ba14#md5:84519b5f8bd92490bfc68a52f706ba14", + "archive:https://github.com/kandu/trie/archive/1.0.0.tar.gz#md5:84519b5f8bd92490bfc68a52f706ba14" + ], + "opam": { + "name": "trie", + "version": "1.0.0", + "path": "rtop.esy.lock/opam/trie.1.0.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/topkg@opam:1.0.7@7ee47d76": { + "id": "@opam/topkg@opam:1.0.7@7ee47d76", + "name": "@opam/topkg", + "version": "opam:1.0.7", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/09/09e59f1759bf4db8471f02d0aefd8db602b44932a291c05c312b1423796e7a15d1598d3c62a0cec7f083eff8e410fac09363533dc4bd2120914bb9664efea535#sha512:09e59f1759bf4db8471f02d0aefd8db602b44932a291c05c312b1423796e7a15d1598d3c62a0cec7f083eff8e410fac09363533dc4bd2120914bb9664efea535", + "archive:https://erratique.ch/software/topkg/releases/topkg-1.0.7.tbz#sha512:09e59f1759bf4db8471f02d0aefd8db602b44932a291c05c312b1423796e7a15d1598d3c62a0cec7f083eff8e410fac09363533dc4bd2120914bb9664efea535" + ], + "opam": { + "name": "topkg", + "version": "1.0.7", + "path": "rtop.esy.lock/opam/topkg.1.0.7" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d" + ] + }, + "@opam/stdlib-shims@opam:0.3.0@72c7bc98": { + "id": "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "name": "@opam/stdlib-shims", + "version": "opam:0.3.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/ba/babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a", + "archive:https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz#sha256:babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" + ], + "opam": { + "name": "stdlib-shims", + "version": "0.3.0", + "path": "rtop.esy.lock/opam/stdlib-shims.0.3.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/sexplib0@opam:v0.16.0@c0ffad0c": { + "id": "@opam/sexplib0@opam:v0.16.0@c0ffad0c", + "name": "@opam/sexplib0", + "version": "opam:v0.16.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/86/86dba26468194512f789f2fb709063515a9cb4e5c4461c021c239a369590701d#sha256:86dba26468194512f789f2fb709063515a9cb4e5c4461c021c239a369590701d", + "archive:https://ocaml.janestreet.com/ocaml-core/v0.16/files/sexplib0-v0.16.0.tar.gz#sha256:86dba26468194512f789f2fb709063515a9cb4e5c4461c021c239a369590701d" + ], + "opam": { + "name": "sexplib0", + "version": "v0.16.0", + "path": "rtop.esy.lock/opam/sexplib0.v0.16.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/seq@opam:base@d8d7de1d": { + "id": "@opam/seq@opam:base@d8d7de1d", + "name": "@opam/seq", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "seq", + "version": "base", + "path": "rtop.esy.lock/opam/seq.base" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/result@opam:1.5@1c6a6533": { + "id": "@opam/result@opam:1.5@1c6a6533", + "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": "rtop.esy.lock/opam/result.1.5" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/reason@opam:3.10.0@77493263": { + "id": "@opam/reason@opam:3.10.0@77493263", + "name": "@opam/reason", + "version": "opam:3.10.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/17/17ead4c2864af7273f56d0ad62c4564be2eade76d3da87b1d381ed5b44f466cb#sha256:17ead4c2864af7273f56d0ad62c4564be2eade76d3da87b1d381ed5b44f466cb", + "archive:https://github.com/reasonml/reason/releases/download/3.10.0/reason-3.10.0.tbz#sha256:17ead4c2864af7273f56d0ad62c4564be2eade76d3da87b1d381ed5b44f466cb" + ], + "opam": { + "name": "reason", + "version": "3.10.0", + "path": "rtop.esy.lock/opam/reason.3.10.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ppxlib@opam:0.31.0@1212d9eb", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/merlin-extend@opam:0.6.1@7d979feb", + "@opam/menhir@opam:20230608@c0081728", + "@opam/fix@opam:20230505@941a65ff", + "@opam/dune-build-info@opam:3.11.1@0dfbdab2", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ppxlib@opam:0.31.0@1212d9eb", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/merlin-extend@opam:0.6.1@7d979feb", + "@opam/menhir@opam:20230608@c0081728", + "@opam/fix@opam:20230505@941a65ff", + "@opam/dune-build-info@opam:3.11.1@0dfbdab2", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/react@opam:1.2.2@e0f4480e": { + "id": "@opam/react@opam:1.2.2@e0f4480e", + "name": "@opam/react", + "version": "opam:1.2.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/18/18cdd544d484222ba02db6bd9351571516532e7a1c107b59bbe39193837298f5c745eab6754f8bc6ff125b387be7018c6d6e6ac99f91925a5e4f53af688522b1#sha512:18cdd544d484222ba02db6bd9351571516532e7a1c107b59bbe39193837298f5c745eab6754f8bc6ff125b387be7018c6d6e6ac99f91925a5e4f53af688522b1", + "archive:https://erratique.ch/software/react/releases/react-1.2.2.tbz#sha512:18cdd544d484222ba02db6bd9351571516532e7a1c107b59bbe39193837298f5c745eab6754f8bc6ff125b387be7018c6d6e6ac99f91925a5e4f53af688522b1" + ], + "opam": { + "name": "react", + "version": "1.2.2", + "path": "rtop.esy.lock/opam/react.1.2.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/ppxlib@opam:0.31.0@1212d9eb": { + "id": "@opam/ppxlib@opam:0.31.0@1212d9eb", + "name": "@opam/ppxlib", + "version": "opam:0.31.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/d2/d21676654e57faa12d7895caffe8703b64521d66efcf152491871a55b2ae41d8#sha256:d21676654e57faa12d7895caffe8703b64521d66efcf152491871a55b2ae41d8", + "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.31.0/ppxlib-0.31.0.tbz#sha256:d21676654e57faa12d7895caffe8703b64521d66efcf152491871a55b2ae41d8" + ], + "opam": { + "name": "ppxlib", + "version": "0.31.0", + "path": "rtop.esy.lock/opam/ppxlib.0.31.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.16.0@c0ffad0c", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.16.0@c0ffad0c", + "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/ppx_derivers@opam:1.2.1@e2cbad12": { + "id": "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "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": "rtop.esy.lock/opam/ppx_derivers.1.2.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/ocplib-endian@opam:1.2@008dc942": { + "id": "@opam/ocplib-endian@opam:1.2@008dc942", + "name": "@opam/ocplib-endian", + "version": "opam:1.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/8d/8d5492eeb7c6815ade72a7415ea30949#md5:8d5492eeb7c6815ade72a7415ea30949", + "archive:https://github.com/OCamlPro/ocplib-endian/archive/refs/tags/1.2.tar.gz#md5:8d5492eeb7c6815ade72a7415ea30949" + ], + "opam": { + "name": "ocplib-endian", + "version": "1.2", + "path": "rtop.esy.lock/opam/ocplib-endian.1.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/cppo@opam:1.6.9@db929a12", + "@opam/base-bytes@opam:base@19d0c2ff", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/base-bytes@opam:base@19d0c2ff" + ] + }, + "@opam/ocamlfind@opam:1.9.6@da5169c7": { + "id": "@opam/ocamlfind@opam:1.9.6@da5169c7", + "name": "@opam/ocamlfind", + "version": "opam:1.9.6", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/96/96c6ee50a32cca9ca277321262dbec57#md5:96c6ee50a32cca9ca277321262dbec57", + "archive:http://download.camlcity.org/download/findlib-1.9.6.tar.gz#md5:96c6ee50a32cca9ca277321262dbec57" + ], + "opam": { + "name": "ocamlfind", + "version": "1.9.6", + "path": "rtop.esy.lock/opam/ocamlfind.1.9.6" + } + }, + "overrides": [ + { + "opamoverride": "rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override" + } + ], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d": { + "id": "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "name": "@opam/ocamlbuild", + "version": "opam:0.14.2+win", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/2f/2f407fadd57b073155a6aead887d9676#md5:2f407fadd57b073155a6aead887d9676", + "archive:https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.2.tar.gz#md5:2f407fadd57b073155a6aead887d9676" + ], + "opam": { + "name": "ocamlbuild", + "version": "0.14.2+win", + "path": "rtop.esy.lock/opam/ocamlbuild.0.14.2+win" + } + }, + "overrides": [ + { + "opamoverride": "rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override" + } + ], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ], + "extraSources": [ + { + "checksum": "sha256:a9b7e1829a3304e5a073d8ddea29d3d8272698e93b7e1ee659ae5e31e5cfb6b9", + "url": "https://raw.githubusercontent.com/ocaml-opam/opam-repository-mingw/354a87b397856f2a70024c5c83fc5001074935b6/packages/ocamlbuild/ocamlbuild.0.14.2/files/ocamlbuild-0.14.2.patch", + "relativePath": "ocamlbuild-0.14.2.patch" + } + ] + }, + "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882": { + "id": "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "name": "@opam/ocaml-compiler-libs", + "version": "opam:v0.12.4", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/4e/4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760", + "archive:https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz#sha256:4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" + ], + "opam": { + "name": "ocaml-compiler-libs", + "version": "v0.12.4", + "path": "rtop.esy.lock/opam/ocaml-compiler-libs.v0.12.4" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/mew_vi@opam:0.5.0@cf66c299": { + "id": "@opam/mew_vi@opam:0.5.0@cf66c299", + "name": "@opam/mew_vi", + "version": "opam:0.5.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/34/341e9a9a20383641015bf503952906bc#md5:341e9a9a20383641015bf503952906bc", + "archive:https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz#md5:341e9a9a20383641015bf503952906bc" + ], + "opam": { + "name": "mew_vi", + "version": "0.5.0", + "path": "rtop.esy.lock/opam/mew_vi.0.5.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/mew@opam:0.1.0@65011d4b": { + "id": "@opam/mew@opam:0.1.0@65011d4b", + "name": "@opam/mew", + "version": "opam:0.1.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/22/2298149d1415cd804ab4e01f01ea10a0#md5:2298149d1415cd804ab4e01f01ea10a0", + "archive:https://github.com/kandu/mew/archive/0.1.0.tar.gz#md5:2298149d1415cd804ab4e01f01ea10a0" + ], + "opam": { + "name": "mew", + "version": "0.1.0", + "path": "rtop.esy.lock/opam/mew.0.1.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", + "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", + "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/merlin-lib@opam:4.12-501@63956d65": { + "id": "@opam/merlin-lib@opam:4.12-501@63956d65", + "name": "@opam/merlin-lib", + "version": "opam:4.12-501", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/cc/cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0#sha256:cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0", + "archive:https://github.com/ocaml/merlin/releases/download/v4.12-501/merlin-4.12-501.tbz#sha256:cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0" + ], + "opam": { + "name": "merlin-lib", + "version": "4.12-501", + "path": "rtop.esy.lock/opam/merlin-lib.4.12-501" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/csexp@opam:1.5.2@46614bf4", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/csexp@opam:1.5.2@46614bf4" + ] + }, + "@opam/merlin-extend@opam:0.6.1@7d979feb": { + "id": "@opam/merlin-extend@opam:0.6.1@7d979feb", + "name": "@opam/merlin-extend", + "version": "opam:0.6.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/5e/5ec84b355ddb2d129a5948b132bfacc93adcbde2158c7de695f7bfc3650bead7#sha256:5ec84b355ddb2d129a5948b132bfacc93adcbde2158c7de695f7bfc3650bead7", + "archive:https://github.com/let-def/merlin-extend/releases/download/v0.6.1/merlin-extend-0.6.1.tbz#sha256:5ec84b355ddb2d129a5948b132bfacc93adcbde2158c7de695f7bfc3650bead7" + ], + "opam": { + "name": "merlin-extend", + "version": "0.6.1", + "path": "rtop.esy.lock/opam/merlin-extend.0.6.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/merlin@opam:4.12-501@92a40085": { + "id": "@opam/merlin@opam:4.12-501@92a40085", + "name": "@opam/merlin", + "version": "opam:4.12-501", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/cc/cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0#sha256:cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0", + "archive:https://github.com/ocaml/merlin/releases/download/v4.12-501/merlin-4.12-501.tbz#sha256:cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0" + ], + "opam": { + "name": "merlin", + "version": "4.12-501", + "path": "rtop.esy.lock/opam/merlin.4.12-501" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/yojson@opam:2.1.1@ad5e299c", + "@opam/merlin-lib@opam:4.12-501@63956d65", + "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/dot-merlin-reader@opam:4.9@5d77f68f", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/yojson@opam:2.1.1@ad5e299c", + "@opam/merlin-lib@opam:4.12-501@63956d65", + "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/dot-merlin-reader@opam:4.9@5d77f68f" + ] + }, + "@opam/menhirSdk@opam:20230608@36f21a74": { + "id": "@opam/menhirSdk@opam:20230608@36f21a74", + "name": "@opam/menhirSdk", + "version": "opam:20230608", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/8f/8ff26b1e3685c472b7b3aba2fe938a43#md5:8ff26b1e3685c472b7b3aba2fe938a43", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz#md5:8ff26b1e3685c472b7b3aba2fe938a43" + ], + "opam": { + "name": "menhirSdk", + "version": "20230608", + "path": "rtop.esy.lock/opam/menhirSdk.20230608" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/menhirLib@opam:20230608@cf13bc0d": { + "id": "@opam/menhirLib@opam:20230608@cf13bc0d", + "name": "@opam/menhirLib", + "version": "opam:20230608", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/8f/8ff26b1e3685c472b7b3aba2fe938a43#md5:8ff26b1e3685c472b7b3aba2fe938a43", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz#md5:8ff26b1e3685c472b7b3aba2fe938a43" + ], + "opam": { + "name": "menhirLib", + "version": "20230608", + "path": "rtop.esy.lock/opam/menhirLib.20230608" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/menhir@opam:20230608@c0081728": { + "id": "@opam/menhir@opam:20230608@c0081728", + "name": "@opam/menhir", + "version": "opam:20230608", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/8f/8ff26b1e3685c472b7b3aba2fe938a43#md5:8ff26b1e3685c472b7b3aba2fe938a43", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz#md5:8ff26b1e3685c472b7b3aba2fe938a43" + ], + "opam": { + "name": "menhir", + "version": "20230608", + "path": "rtop.esy.lock/opam/menhir.20230608" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/menhirSdk@opam:20230608@36f21a74", + "@opam/menhirLib@opam:20230608@cf13bc0d", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/menhirSdk@opam:20230608@36f21a74", + "@opam/menhirLib@opam:20230608@cf13bc0d", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/lwt_react@opam:1.2.0@4253a145": { + "id": "@opam/lwt_react@opam:1.2.0@4253a145", + "name": "@opam/lwt_react", + "version": "opam:1.2.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/e6/e63979ee40a80d5b9e9e5545f33323b4#md5:e63979ee40a80d5b9e9e5545f33323b4", + "archive:https://github.com/ocsigen/lwt/archive/5.6.0.tar.gz#md5:e63979ee40a80d5b9e9e5545f33323b4" + ], + "opam": { + "name": "lwt_react", + "version": "1.2.0", + "path": "rtop.esy.lock/opam/lwt_react.1.2.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/lwt@opam:5.7.0@4a33823d": { + "id": "@opam/lwt@opam:5.7.0@4a33823d", + "name": "@opam/lwt", + "version": "opam:5.7.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/73/737039d29d45b2d2b35db6931c8d75c6#md5:737039d29d45b2d2b35db6931c8d75c6", + "archive:https://github.com/ocsigen/lwt/archive/refs/tags/5.7.0.tar.gz#md5:737039d29d45b2d2b35db6931c8d75c6" + ], + "opam": { + "name": "lwt", + "version": "5.7.0", + "path": "rtop.esy.lock/opam/lwt.5.7.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", + "@opam/dune-configurator@opam:3.11.1@24d75a5c", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", + "@opam/dune-configurator@opam:3.11.1@24d75a5c", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/logs@opam:0.7.0@46a3dffc": { + "id": "@opam/logs@opam:0.7.0@46a3dffc", + "name": "@opam/logs", + "version": "opam:0.7.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/2b/2bf021ca13331775e33cf34ab60246f7#md5:2bf021ca13331775e33cf34ab60246f7", + "archive:https://erratique.ch/software/logs/releases/logs-0.7.0.tbz#md5:2bf021ca13331775e33cf34ab60246f7" + ], + "opam": { + "name": "logs", + "version": "0.7.0", + "path": "rtop.esy.lock/opam/logs.0.7.0" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/ocamlbuild@opam:0.14.2+win@39b9f56d", + "@opam/lwt@opam:5.7.0@4a33823d", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@5.1.4@d41d8cd9" ] + }, + "@opam/lambda-term@opam:3.3.2@0f91853c": { + "id": "@opam/lambda-term@opam:3.3.2@0f91853c", + "name": "@opam/lambda-term", + "version": "opam:3.3.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/78/78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766#sha512:78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766", + "archive:https://github.com/ocaml-community/lambda-term/archive/refs/tags/3.3.2.tar.gz#sha512:78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766" + ], + "opam": { + "name": "lambda-term", + "version": "3.3.2", + "path": "rtop.esy.lock/opam/lambda-term.3.3.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew_vi@opam:0.5.0@cf66c299", + "@opam/lwt_react@opam:1.2.0@4253a145", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@46a3dffc", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew_vi@opam:0.5.0@cf66c299", + "@opam/lwt_react@opam:1.2.0@4253a145", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@46a3dffc", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/fix@opam:20230505@941a65ff": { + "id": "@opam/fix@opam:20230505@941a65ff", + "name": "@opam/fix", + "version": "opam:20230505", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/2a/2a4afa633128c5010677222f7b3c9451#md5:2a4afa633128c5010677222f7b3c9451", + "archive:https://gitlab.inria.fr/fpottier/fix/-/archive/20230505/archive.tar.gz#md5:2a4afa633128c5010677222f7b3c9451" + ], + "opam": { + "name": "fix", + "version": "20230505", + "path": "rtop.esy.lock/opam/fix.20230505" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/dune-configurator@opam:3.11.1@24d75a5c": { + "id": "@opam/dune-configurator@opam:3.11.1@24d75a5c", + "name": "@opam/dune-configurator", + "version": "opam:3.11.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/86/866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71", + "archive:https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + ], + "opam": { + "name": "dune-configurator", + "version": "3.11.1", + "path": "rtop.esy.lock/opam/dune-configurator.3.11.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/csexp@opam:1.5.2@46614bf4", + "@opam/base-unix@opam:base@87d0b2eb", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/csexp@opam:1.5.2@46614bf4", + "@opam/base-unix@opam:base@87d0b2eb" + ] + }, + "@opam/dune-build-info@opam:3.11.1@0dfbdab2": { + "id": "@opam/dune-build-info@opam:3.11.1@0dfbdab2", + "name": "@opam/dune-build-info", + "version": "opam:3.11.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/86/866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71", + "archive:https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + ], + "opam": { + "name": "dune-build-info", + "version": "3.11.1", + "path": "rtop.esy.lock/opam/dune-build-info.3.11.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/dune@opam:3.11.1@ba2e0e6a": { + "id": "@opam/dune@opam:3.11.1@ba2e0e6a", + "name": "@opam/dune", + "version": "opam:3.11.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/86/866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71", + "archive:https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz#sha256:866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + ], + "opam": { + "name": "dune", + "version": "3.11.1", + "path": "rtop.esy.lock/opam/dune.3.11.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", + "@opam/base-threads@opam:base@36803084" + ] + }, + "@opam/dot-merlin-reader@opam:4.9@5d77f68f": { + "id": "@opam/dot-merlin-reader@opam:4.9@5d77f68f", + "name": "@opam/dot-merlin-reader", + "version": "opam:4.9", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/e2/e23fc47813591269ff9d27c820988e520a662c89dd0af7ea652b21517499cbfd#sha256:e23fc47813591269ff9d27c820988e520a662c89dd0af7ea652b21517499cbfd", + "archive:https://github.com/ocaml/merlin/releases/download/v4.9-414/merlin-4.9-414.tbz#sha256:e23fc47813591269ff9d27c820988e520a662c89dd0af7ea652b21517499cbfd" + ], + "opam": { + "name": "dot-merlin-reader", + "version": "4.9", + "path": "rtop.esy.lock/opam/dot-merlin-reader.4.9" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/merlin-lib@opam:4.12-501@63956d65", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/merlin-lib@opam:4.12-501@63956d65", + "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/csexp@opam:1.5.2@46614bf4": { + "id": "@opam/csexp@opam:1.5.2@46614bf4", + "name": "@opam/csexp", + "version": "opam:1.5.2", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/1a/1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff#sha256:1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff", + "archive:https://github.com/ocaml-dune/csexp/releases/download/1.5.2/csexp-1.5.2.tbz#sha256:1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff" + ], + "opam": { + "name": "csexp", + "version": "1.5.2", + "path": "rtop.esy.lock/opam/csexp.1.5.2" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a" + ] + }, + "@opam/cppo@opam:1.6.9@db929a12": { + "id": "@opam/cppo@opam:1.6.9@db929a12", + "name": "@opam/cppo", + "version": "opam:1.6.9", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/d2/d23ffe85ac7dc8f0afd1ddf622770d09#md5:d23ffe85ac7dc8f0afd1ddf622770d09", + "archive:https://github.com/ocaml-community/cppo/archive/v1.6.9.tar.gz#md5:d23ffe85ac7dc8f0afd1ddf622770d09" + ], + "opam": { + "name": "cppo", + "version": "1.6.9", + "path": "rtop.esy.lock/opam/cppo.1.6.9" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/base-unix@opam:base@87d0b2eb", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/dune@opam:3.11.1@ba2e0e6a", + "@opam/base-unix@opam:base@87d0b2eb" + ] + }, + "@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": "rtop.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": "rtop.esy.lock/opam/base-threads.base" + } + }, + "overrides": [], + "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], + "devDependencies": [] + }, + "@opam/base-bytes@opam:base@19d0c2ff": { + "id": "@opam/base-bytes@opam:base@19d0c2ff", + "name": "@opam/base-bytes", + "version": "opam:base", + "source": { + "type": "install", + "source": [ "no-source:" ], + "opam": { + "name": "base-bytes", + "version": "base", + "path": "rtop.esy.lock/opam/base-bytes.base" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@da5169c7" + ] + }, + "@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/rtop@link-dev:./rtop.json": { + "id": "@esy-ocaml/rtop@link-dev:./rtop.json", + "name": "@esy-ocaml/rtop", + "version": "link-dev:./rtop.json", + "source": { "type": "link-dev", "path": ".", "manifest": "rtop.json" }, + "overrides": [], + "dependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/utop@opam:2.13.1@dc6689f5", + "@opam/reason@opam:3.10.0@77493263", + "@opam/ocamlfind@opam:1.9.6@da5169c7", + "@opam/dune@opam:3.11.1@ba2e0e6a", "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@5.1.4@d41d8cd9", "@opam/merlin@opam:4.12-501@92a40085" + ] + } + } +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/base-bytes.base/opam b/rtop.esy.lock/opam/base-bytes.base/opam new file mode 100644 index 000000000..f1cae506c --- /dev/null +++ b/rtop.esy.lock/opam/base-bytes.base/opam @@ -0,0 +1,9 @@ +opam-version: "2.0" +maintainer: " " +authors: " " +homepage: " " +depends: [ + "ocaml" {>= "4.02.0"} + "ocamlfind" {>= "1.5.3"} +] +synopsis: "Bytes library distributed with the OCaml compiler" diff --git a/rtop.esy.lock/opam/base-threads.base/opam b/rtop.esy.lock/opam/base-threads.base/opam new file mode 100644 index 000000000..914ff50ce --- /dev/null +++ b/rtop.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/rtop.esy.lock/opam/base-unix.base/opam b/rtop.esy.lock/opam/base-unix.base/opam new file mode 100644 index 000000000..b973540bc --- /dev/null +++ b/rtop.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/rtop.esy.lock/opam/cppo.1.6.9/opam b/rtop.esy.lock/opam/cppo.1.6.9/opam new file mode 100644 index 000000000..9c51ec6d8 --- /dev/null +++ b/rtop.esy.lock/opam/cppo.1.6.9/opam @@ -0,0 +1,39 @@ +opam-version: "2.0" +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""" +maintainer: [ + "Martin Jambon " "Yishuai Li " +] +authors: "Martin Jambon" +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/cppo" +doc: "https://ocaml-community.github.io/cppo" +bug-reports: "https://github.com/ocaml-community/cppo/issues" +depends: [ + "ocaml" {>= "4.02.3"} + "dune" {>= "1.10"} + "base-unix" +] +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} + ["dune" "build" "-p" name "@doc"] {with-doc} +] +dev-repo: "git+https://github.com/ocaml-community/cppo.git" +url { + src: "https://github.com/ocaml-community/cppo/archive/v1.6.9.tar.gz" + checksum: [ + "md5=d23ffe85ac7dc8f0afd1ddf622770d09" + "sha512=26ff5a7b7f38c460661974b23ca190f0feae3a99f1974e0fd12ccf08745bd7d91b7bc168c70a5385b837bfff9530e0e4e41cf269f23dd8cf16ca658008244b44" + ] +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/csexp.1.5.2/opam b/rtop.esy.lock/opam/csexp.1.5.2/opam new file mode 100644 index 000000000..7d511ab80 --- /dev/null +++ b/rtop.esy.lock/opam/csexp.1.5.2/opam @@ -0,0 +1,58 @@ +opam-version: "2.0" +synopsis: "Parsing and printing of S-expressions in Canonical form" +description: """ + +This library provides minimal support for Canonical S-expressions +[1]. Canonical S-expressions are a binary encoding of S-expressions +that is super simple and well suited for communication between +programs. + +This library only provides a few helpers for simple applications. If +you need more advanced support, such as parsing from more fancy input +sources, you should consider copying the code of this library given +how simple parsing S-expressions in canonical form is. + +To avoid a dependency on a particular S-expression library, the only +module of this library is parameterised by the type of S-expressions. + +[1] https://en.wikipedia.org/wiki/Canonical_S-expressions +""" +maintainer: ["Jeremie Dimino "] +authors: [ + "Quentin Hocquet " + "Jane Street Group, LLC " + "Jeremie Dimino " +] +license: "MIT" +homepage: "https://github.com/ocaml-dune/csexp" +doc: "https://ocaml-dune.github.io/csexp/" +bug-reports: "https://github.com/ocaml-dune/csexp/issues" +depends: [ + "dune" {>= "3.4"} + "ocaml" {>= "4.03.0"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml-dune/csexp.git" +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" +# "@runtest" {with-test & ocaml:version >= "4.04"} + "@doc" {with-doc} + ] +] +url { + src: + "https://github.com/ocaml-dune/csexp/releases/download/1.5.2/csexp-1.5.2.tbz" + checksum: [ + "sha256=1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff" + "sha512=be281018bcfc20d4db14894ef51c4b836d6338d2fdfe22e63d46f405f8dea7349e16f1c0ecd65f73d4c85a2a80e618cdbb8c9dafcbb9f229f04f1adca5b1973c" + ] +} +x-commit-hash: "e6c4768e10c61bcb04d09748744dad55602149c6" diff --git a/rtop.esy.lock/opam/dot-merlin-reader.4.9/opam b/rtop.esy.lock/opam/dot-merlin-reader.4.9/opam new file mode 100644 index 000000000..e2a8ce56e --- /dev/null +++ b/rtop.esy.lock/opam/dot-merlin-reader.4.9/opam @@ -0,0 +1,30 @@ +opam-version: "2.0" +maintainer: "defree@gmail.com" +authors: "The Merlin team" +synopsis: "Reads config files for merlin" +homepage: "https://github.com/ocaml/merlin" +bug-reports: "https://github.com/ocaml/merlin/issues" +dev-repo: "git+https://github.com/ocaml/merlin.git" +license: "MIT" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.08" & < "6.0"} + "dune" {>= "2.9.0"} + "merlin-lib" {>= "4.9"} + "ocamlfind" {>= "1.6.0"} +] +description: + "Helper process: reads .merlin files and outputs the normalized content to + stdout." +url { + src: + "https://github.com/ocaml/merlin/releases/download/v4.9-414/merlin-4.9-414.tbz" + checksum: [ + "sha256=e23fc47813591269ff9d27c820988e520a662c89dd0af7ea652b21517499cbfd" + "sha512=2199f963368597d10cc197e41ebb883f6a166018c9da3fe259c354550df41b713781003598a2fe5956b0a4ae96f8c07ba33831d3cf6f9d494b731944f87e491e" + ] +} +x-commit-hash: "df75a4550704c113ac29505fd68ef9b7893d4bf5" diff --git a/rtop.esy.lock/opam/dune-build-info.3.11.1/opam b/rtop.esy.lock/opam/dune-build-info.3.11.1/opam new file mode 100644 index 000000000..f0bb6ed48 --- /dev/null +++ b/rtop.esy.lock/opam/dune-build-info.3.11.1/opam @@ -0,0 +1,46 @@ +opam-version: "2.0" +synopsis: "Embed build information inside executable" +description: """ +The build-info library allows to access information about how the +executable was built, such as the version of the project at which it +was built or the list of statically linked libraries with their +versions. It supports reporting the version from the version control +system during development to get an precise reference of when the +executable was built. +""" +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" +depends: [ + "dune" {>= "3.5"} + "ocaml" {>= "4.08"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["dune" "subst"] {dev} + ["rm" "-rf" "vendor/csexp"] + ["rm" "-rf" "vendor/pp"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] +url { + src: + "https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz" + checksum: [ + "sha256=866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + "sha512=c888153b204a16bcfed2636de776bbd5f9ca84484e716cc1e9ef3ba3c904e9dd15a2609ae943cddb6097912623ec54618c58386d6730ff742d746850400fb3cc" + ] +} +x-commit-hash: "7cbb0e7277c6cacd1ccf7941cac5a03c25fc63cf" diff --git a/rtop.esy.lock/opam/dune-configurator.3.11.1/opam b/rtop.esy.lock/opam/dune-configurator.3.11.1/opam new file mode 100644 index 000000000..8ee593d15 --- /dev/null +++ b/rtop.esy.lock/opam/dune-configurator.3.11.1/opam @@ -0,0 +1,50 @@ +opam-version: "2.0" +synopsis: "Helper library for gathering system configuration" +description: """ +dune-configurator is a small library that helps writing OCaml scripts that +test features available on the system, in order to generate config.h +files for instance. +Among other things, dune-configurator allows one to: +- test if a C program compiles +- query pkg-config +- import #define from OCaml header files +- generate config.h file +""" +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" +depends: [ + "dune" {>= "3.5"} + "ocaml" {>= "4.04.0"} + "base-unix" + "csexp" {>= "1.5.0"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["dune" "subst"] {dev} + ["rm" "-rf" "vendor/csexp"] + ["rm" "-rf" "vendor/pp"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] +url { + src: + "https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz" + checksum: [ + "sha256=866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + "sha512=c888153b204a16bcfed2636de776bbd5f9ca84484e716cc1e9ef3ba3c904e9dd15a2609ae943cddb6097912623ec54618c58386d6730ff742d746850400fb3cc" + ] +} +x-commit-hash: "7cbb0e7277c6cacd1ccf7941cac5a03c25fc63cf" diff --git a/rtop.esy.lock/opam/dune.3.11.1/opam b/rtop.esy.lock/opam/dune.3.11.1/opam new file mode 100644 index 000000000..e79328cef --- /dev/null +++ b/rtop.esy.lock/opam/dune.3.11.1/opam @@ -0,0 +1,57 @@ +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: [ + "merlin" {< "3.4.0"} + "ocaml-lsp-server" {< "1.3.0"} + "dune-configurator" {< "2.3.0"} + "odoc" {< "2.0.1"} + "dune-release" {< "1.3.0"} + "js_of_ocaml-compiler" {< "3.6.0"} + "jbuilder" {= "transition"} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["ocaml" "boot/bootstrap.ml" "-j" jobs] + ["./_boot/dune.exe" "build" "dune.install" "--release" "--profile" "dune-bootstrap" "-j" jobs] +] +depends: [ + # Please keep the lower bound in sync with .github/workflows/workflow.yml, + # dune-project and min_ocaml_version in bootstrap.ml + ("ocaml" {>= "4.08"} | ("ocaml" {>= "4.02" & < "4.08~~"} & "ocamlfind-secondary")) + "base-unix" + "base-threads" +] +url { + src: + "https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz" + checksum: [ + "sha256=866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + "sha512=c888153b204a16bcfed2636de776bbd5f9ca84484e716cc1e9ef3ba3c904e9dd15a2609ae943cddb6097912623ec54618c58386d6730ff742d746850400fb3cc" + ] +} +x-commit-hash: "7cbb0e7277c6cacd1ccf7941cac5a03c25fc63cf" diff --git a/rtop.esy.lock/opam/fix.20230505/opam b/rtop.esy.lock/opam/fix.20230505/opam new file mode 100644 index 000000000..6278f49e6 --- /dev/null +++ b/rtop.esy.lock/opam/fix.20230505/opam @@ -0,0 +1,26 @@ + +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" +license: "LGPL-2.0-only" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.03" } + "dune" { >= "1.3" } +] +synopsis: "Algorithmic building blocks for memoization, recursion, and more" +url { + src: + "https://gitlab.inria.fr/fpottier/fix/-/archive/20230505/archive.tar.gz" + checksum: [ + "md5=2a4afa633128c5010677222f7b3c9451" + "sha512=30d446ba6c19aef78b52d9831eb26f8f6ac10e88bd1eff36d16fbbfb32278b2637e31e63a160aec4abbbfdb1e7612ed25d68c936f4cbf2073e51d713ff3a8adf" + ] +} diff --git a/rtop.esy.lock/opam/lambda-term.3.3.2/opam b/rtop.esy.lock/opam/lambda-term.3.3.2/opam new file mode 100644 index 000000000..66fc69572 --- /dev/null +++ b/rtop.esy.lock/opam/lambda-term.3.3.2/opam @@ -0,0 +1,49 @@ +opam-version: "2.0" +synopsis: "Terminal manipulation library for OCaml" +description: """ +Lambda-term is a cross-platform library for manipulating the terminal. It +provides an abstraction for keys, mouse events, colors, as well as a set of +widgets to write curses-like applications. The main objective of lambda-term is +to provide a higher level functional interface to terminal manipulation than, +for example, ncurses, by providing a native OCaml interface instead of bindings +to a C library. Lambda-term integrates with zed to provide text edition +facilities in console applications.""" +maintainer: ["ZAN DoYe "] +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/lambda-term" +bug-reports: "https://github.com/ocaml-community/lambda-term/issues" +depends: [ + "dune" {>= "3.0"} + "ocaml" {>= "4.08.0"} + "logs" + "lwt" {>= "4.2.0"} + "lwt_react" + "mew_vi" {>= "0.5.0" & < "0.6.0"} + "react" + "zed" {>= "3.2.0" & < "4.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/lambda-term.git" +url { + src: + "https://github.com/ocaml-community/lambda-term/archive/refs/tags/3.3.2.tar.gz" + checksum: [ + "sha512=78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766" + ] +} +x-commit-hash: "cade31f3c56f1e52fa6d297ddb78f37d09062761" diff --git a/rtop.esy.lock/opam/logs.0.7.0/opam b/rtop.esy.lock/opam/logs.0.7.0/opam new file mode 100644 index 000000000..c803bafdb --- /dev/null +++ b/rtop.esy.lock/opam/logs.0.7.0/opam @@ -0,0 +1,66 @@ +opam-version: "2.0" +maintainer: "Daniel Bünzli " +authors: ["The logs programmers"] +homepage: "https://erratique.ch/software/logs" +doc: "https://erratique.ch/software/logs/doc" +dev-repo: "git+https://erratique.ch/repos/logs.git" +bug-reports: "https://github.com/dbuenzli/logs/issues" +tags: [ "log" "system" "org:erratique" ] +license: "ISC" +depends: [ + "ocaml" {>= "4.03.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build} + "mtime" {with-test} ] +depopts: [ + "js_of_ocaml" + "fmt" + "cmdliner" + "lwt" + "base-threads" +] +conflicts: [ + "cmdliner" {< "0.9.8"} + "js_of_ocaml" { < "3.3.0" } +] + +build: [[ + "ocaml" "pkg/pkg.ml" "build" + "--pinned" "%{pinned}%" + "--with-js_of_ocaml" "%{js_of_ocaml:installed}%" + "--with-fmt" "%{fmt:installed}%" + "--with-cmdliner" "%{cmdliner:installed}%" + "--with-lwt" "%{lwt:installed}%" + "--with-base-threads" "%{base-threads:installed}%" +]] + +synopsis: """Logging infrastructure for OCaml""" +description: """\ + +Logs provides a logging infrastructure for OCaml. Logging is performed +on sources whose reporting level can be set independently. Log message +report is decoupled from logging and is handled by a reporter. + +A few optional log reporters are distributed with the base library and +the API easily allows to implement your own. + +`Logs` has no dependencies. The optional `Logs_fmt` reporter on OCaml +formatters depends on [Fmt][fmt]. The optional `Logs_browser` +reporter that reports to the web browser console depends on +[js_of_ocaml][jsoo]. The optional `Logs_cli` library that provides +command line support for controlling Logs depends on +[`Cmdliner`][cmdliner]. The optional `Logs_lwt` library that provides +Lwt logging functions depends on [`Lwt`][lwt] + +Logs and its reporters are distributed under the ISC license. + +[fmt]: http://erratique.ch/software/fmt +[jsoo]: http://ocsigen.org/js_of_ocaml/ +[cmdliner]: http://erratique.ch/software/cmdliner +[lwt]: http://ocsigen.org/lwt/ +""" +url { +archive: "https://erratique.ch/software/logs/releases/logs-0.7.0.tbz" +checksum: "2bf021ca13331775e33cf34ab60246f7" +} diff --git a/rtop.esy.lock/opam/lwt.5.7.0/opam b/rtop.esy.lock/opam/lwt.5.7.0/opam new file mode 100644 index 000000000..8366437df --- /dev/null +++ b/rtop.esy.lock/opam/lwt.5.7.0/opam @@ -0,0 +1,57 @@ +opam-version: "2.0" + +synopsis: "Promises and event-driven I/O" +license: "MIT" +homepage: "https://github.com/ocsigen/lwt" +doc: "https://ocsigen.org/lwt" +bug-reports: "https://github.com/ocsigen/lwt/issues" + +authors: [ + "Jérôme Vouillon" + "Jérémie Dimino" +] +maintainer: [ + "Raphaël Proust " + "Anton Bachin " +] +dev-repo: "git+https://github.com/ocsigen/lwt.git" + +depends: [ + "cppo" {build & >= "1.1.0"} + "dune" {>= "1.8.0"} + "dune-configurator" + "ocaml" {>= "4.08"} + "ocplib-endian" + + # Until https://github.com/aantron/bisect_ppx/pull/327. + # "bisect_ppx" {dev & >= "2.0.0"} + "ocamlfind" {dev & >= "1.7.3-1"} +] + +depopts: [ + "base-threads" + "base-unix" + "conf-libev" +] + +build: [ + ["dune" "exec" "-p" name "src/unix/config/discover.exe" "--" "--save" + "--use-libev" "%{conf-libev:installed}%"] + ["dune" "build" "-p" name "-j" jobs] +] + +description: "A promise is a value that may become determined in the future. + +Lwt provides typed, composable promises. Promises that are resolved by I/O are +resolved by Lwt in parallel. + +Meanwhile, OCaml code, including code creating and waiting on promises, runs in +a single thread by default. This reduces the need for locks or other +synchronization primitives. Code can be run in parallel on an opt-in basis." +url { + src: "https://github.com/ocsigen/lwt/archive/refs/tags/5.7.0.tar.gz" + checksum: [ + "md5=737039d29d45b2d2b35db6931c8d75c6" + "sha512=42e629920783428673b99c9d7a639237c9e6b35079b5d907bc67e7ea506acf9edadc48cec580bdcfd2410ed9412bf5e6bcc8b09de2fa7d35ce1490973d05ddd1" + ] +} diff --git a/rtop.esy.lock/opam/lwt_react.1.2.0/opam b/rtop.esy.lock/opam/lwt_react.1.2.0/opam new file mode 100644 index 000000000..b3435cb1b --- /dev/null +++ b/rtop.esy.lock/opam/lwt_react.1.2.0/opam @@ -0,0 +1,34 @@ +opam-version: "2.0" + +synopsis: "Helpers for using React with Lwt" +license: "MIT" +homepage: "https://github.com/ocsigen/lwt" +doc: "https://ocsigen.org/lwt/dev/api/Lwt_react" +bug-reports: "https://github.com/ocsigen/lwt/issues" + +authors: [ + "Jérémie Dimino" +] +maintainer: [ + "Anton Bachin " +] +dev-repo: "git+https://github.com/ocsigen/lwt.git" + +depends: [ + "dune" {>= "1.8.0"} + "lwt" {>= "3.0.0"} + "ocaml" {>= "4.08"} + "react" {>= "1.0.0"} + "cppo" {build & >= "1.1.0"} +] + +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +url { + src: "https://github.com/ocsigen/lwt/archive/5.6.0.tar.gz" + checksum: [ + "md5=e63979ee40a80d5b9e9e5545f33323b4" + "sha512=d616389bc9e0da11f25843ab7541ac2d40c9543700a89455f14115b339bbe58cef2b8acf0ae97fd54e15a4cb93149cfe1ebfda301aa93933045f76b7d9344160" + ] +} diff --git a/rtop.esy.lock/opam/menhir.20230608/opam b/rtop.esy.lock/opam/menhir.20230608/opam new file mode 100644 index 000000000..994e202c6 --- /dev/null +++ b/rtop.esy.lock/opam/menhir.20230608/opam @@ -0,0 +1,29 @@ + +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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" +license: "GPL-2.0-only" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.03.0"} + "dune" {>= "2.8.0"} + "menhirLib" {= version} + "menhirSdk" {= version} +] +synopsis: "An LR(1) parser generator" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz" + checksum: [ + "md5=8ff26b1e3685c472b7b3aba2fe938a43" + "sha512=334b9dcb1283a28b8547082a89536b1d439ff588290b8eaecdf4802c5f74dbc8d16ad6fc6c0820036183518d83e2cc273a75787a8b41137424c8e7ee82e2b50a" + ] +} diff --git a/rtop.esy.lock/opam/menhirLib.20230608/opam b/rtop.esy.lock/opam/menhirLib.20230608/opam new file mode 100644 index 000000000..a83c2db7a --- /dev/null +++ b/rtop.esy.lock/opam/menhirLib.20230608/opam @@ -0,0 +1,30 @@ + +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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" +license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.03.0" } + "dune" { >= "2.8.0" } +] +conflicts: [ + "menhir" { != version } +] +synopsis: "Runtime support library for parsers generated by Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz" + checksum: [ + "md5=8ff26b1e3685c472b7b3aba2fe938a43" + "sha512=334b9dcb1283a28b8547082a89536b1d439ff588290b8eaecdf4802c5f74dbc8d16ad6fc6c0820036183518d83e2cc273a75787a8b41137424c8e7ee82e2b50a" + ] +} diff --git a/rtop.esy.lock/opam/menhirSdk.20230608/opam b/rtop.esy.lock/opam/menhirSdk.20230608/opam new file mode 100644 index 000000000..892f09220 --- /dev/null +++ b/rtop.esy.lock/opam/menhirSdk.20230608/opam @@ -0,0 +1,30 @@ + +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: "https://gitlab.inria.fr/fpottier/menhir/-/issues" +license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.03.0" } + "dune" { >= "2.8.0" } +] +conflicts: [ + "menhir" { != version } +] +synopsis: "Compile-time library for auxiliary tools related to Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230608/archive.tar.gz" + checksum: [ + "md5=8ff26b1e3685c472b7b3aba2fe938a43" + "sha512=334b9dcb1283a28b8547082a89536b1d439ff588290b8eaecdf4802c5f74dbc8d16ad6fc6c0820036183518d83e2cc273a75787a8b41137424c8e7ee82e2b50a" + ] +} diff --git a/rtop.esy.lock/opam/merlin-extend.0.6.1/opam b/rtop.esy.lock/opam/merlin-extend.0.6.1/opam new file mode 100644 index 000000000..9f9936505 --- /dev/null +++ b/rtop.esy.lock/opam/merlin-extend.0.6.1/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"] {dev} + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "dune" {>= "1.0"} + "cppo" {build & >= "1.1.0"} + "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" +url { + src: + "https://github.com/let-def/merlin-extend/releases/download/v0.6.1/merlin-extend-0.6.1.tbz" + checksum: [ + "sha256=5ec84b355ddb2d129a5948b132bfacc93adcbde2158c7de695f7bfc3650bead7" + "sha512=631fc96aab2f35e12a078c9b4907ca7b0db9f1e3a4026040e6c23b82e0171c256a89fb5d4c887f1d156eb9e3152783cdf7a546b2496051007a1bcf5777417396" + ] +} +x-commit-hash: "cf2707bbe8e034c6ecf5d0fecd3fd889f6ab14bf" diff --git a/rtop.esy.lock/opam/merlin-lib.4.12-501/opam b/rtop.esy.lock/opam/merlin-lib.4.12-501/opam new file mode 100644 index 000000000..38dc863c0 --- /dev/null +++ b/rtop.esy.lock/opam/merlin-lib.4.12-501/opam @@ -0,0 +1,34 @@ +opam-version: "2.0" +maintainer: "defree@gmail.com" +authors: "The Merlin team" +homepage: "https://github.com/ocaml/merlin" +bug-reports: "https://github.com/ocaml/merlin/issues" +dev-repo: "git+https://github.com/ocaml/merlin.git" +license: "MIT" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "5.1" & < "5.2"} + "dune" {>= "2.9.0"} + "csexp" {>= "1.5.1"} + "menhir" {dev & >= "20201216"} + "menhirLib" {dev & >= "20201216"} + "menhirSdk" {dev & >= "20201216"} +] +synopsis: + "Merlin's libraries" +description: + "These libraries provides access to low-level compiler interfaces and the + standard higher-level merlin protocol. The library is provided as-is, is not + thoroughly documented, and its public API might break with any new release." +url { + src: + "https://github.com/ocaml/merlin/releases/download/v4.12-501/merlin-4.12-501.tbz" + checksum: [ + "sha256=cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0" + "sha512=95ece87b42316824cc5c847bada2bb1f2131a2b75b00a79d561f1ff801d107146df6d2732cf340d5000a0de373a03d09714a35f75b0ec1e6ab869b2cdaf065e8" + ] +} +x-commit-hash: "fcc3157ab0b2ecccf6ac530d8add326fdbf9fb1c" diff --git a/rtop.esy.lock/opam/merlin.4.12-501/opam b/rtop.esy.lock/opam/merlin.4.12-501/opam new file mode 100644 index 000000000..7d9a0d392 --- /dev/null +++ b/rtop.esy.lock/opam/merlin.4.12-501/opam @@ -0,0 +1,81 @@ +opam-version: "2.0" +maintainer: "defree@gmail.com" +authors: "The Merlin team" +homepage: "https://github.com/ocaml/merlin" +bug-reports: "https://github.com/ocaml/merlin/issues" +dev-repo: "git+https://github.com/ocaml/merlin.git" +license: "MIT" +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +depends: [ + "ocaml" {>= "5.1" & < "5.2"} + "dune" {>= "2.9.0"} + "merlin-lib" {= version} + "dot-merlin-reader" {>= "4.9"} + "yojson" {>= "2.0.0"} + "conf-jq" {with-test} + "ppxlib" {with-test} +] +conflicts: [ + "seq" {!= "base"} + "base-effects" +] +synopsis: + "Editor helper, provides completion, typing and source browsing in Vim and Emacs" +description: + "Merlin is an assistant for editing OCaml code. It aims to provide the features available in modern IDEs: error reporting, auto completion, source browsing and much more." +post-messages: [ + "merlin installed. + +Quick setup for VIM +------------------- +Append this to your .vimrc to add merlin to vim's runtime-path: + let g:opamshare = substitute(system('opam var share'),'\\n$','','''') + execute \"set rtp+=\" . g:opamshare . \"/merlin/vim\" + +Also run the following line in vim to index the documentation: + :execute \"helptags \" . g:opamshare . \"/merlin/vim/doc\" + +Quick setup for EMACS +------------------- +Add opam emacs directory to your load-path by appending this to your .emacs: + (let ((opam-share (ignore-errors (car (process-lines \"opam\" \"var\" \"share\"))))) + (when (and opam-share (file-directory-p opam-share)) + ;; Register Merlin + (add-to-list 'load-path (expand-file-name \"emacs/site-lisp\" opam-share)) + (autoload 'merlin-mode \"merlin\" nil t nil) + ;; Automatically start it in OCaml buffers + (add-hook 'tuareg-mode-hook 'merlin-mode t) + (add-hook 'caml-mode-hook 'merlin-mode t) + ;; Use opam switch to lookup ocamlmerlin binary + (setq merlin-command 'opam) + ;; To easily change opam switches within a given Emacs session, you can + ;; install the minor mode https://github.com/ProofGeneral/opam-switch-mode + ;; and use one of its \"OPSW\" menus. + )) +Take a look at https://github.com/ocaml/merlin for more information + +Quick setup with opam-user-setup +-------------------------------- + +Opam-user-setup support Merlin. + + $ opam user-setup install + +should take care of basic setup. +See https://github.com/OCamlPro/opam-user-setup +" + {success & !user-setup:installed} +] +url { + src: + "https://github.com/ocaml/merlin/releases/download/v4.12-501/merlin-4.12-501.tbz" + checksum: [ + "sha256=cccc33235497403590f4f68a2f8a3727a265463984b3b9645ebc1abb2f9088c0" + "sha512=95ece87b42316824cc5c847bada2bb1f2131a2b75b00a79d561f1ff801d107146df6d2732cf340d5000a0de373a03d09714a35f75b0ec1e6ab869b2cdaf065e8" + ] +} +x-commit-hash: "fcc3157ab0b2ecccf6ac530d8add326fdbf9fb1c" diff --git a/rtop.esy.lock/opam/mew.0.1.0/opam b/rtop.esy.lock/opam/mew.0.1.0/opam new file mode 100644 index 000000000..20aee1ea9 --- /dev/null +++ b/rtop.esy.lock/opam/mew.0.1.0/opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "zandoye@gmail.com" +authors: [ "ZAN DoYe" ] +homepage: "https://github.com/kandu/mew" +bug-reports: "https://github.com/kandu/mew/issues" +license: "MIT" +dev-repo: "git+https://github.com/kandu/mew.git" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "result" + "trie" {>= "1.0.0"} + "dune" {>= "1.1.0"} +] + +synopsis: "Modal editing witch" +description: """ +This is the core module of mew, a general modal editing engine generator.""" + +url { + src: "https://github.com/kandu/mew/archive/0.1.0.tar.gz" + checksum: "md5=2298149d1415cd804ab4e01f01ea10a0" +} diff --git a/rtop.esy.lock/opam/mew_vi.0.5.0/opam b/rtop.esy.lock/opam/mew_vi.0.5.0/opam new file mode 100644 index 000000000..033b9fd71 --- /dev/null +++ b/rtop.esy.lock/opam/mew_vi.0.5.0/opam @@ -0,0 +1,25 @@ +opam-version: "2.0" +maintainer: "zandoye@gmail.com" +authors: [ "ZAN DoYe" ] +homepage: "https://github.com/kandu/mew_vi" +bug-reports: "https://github.com/kandu/mew_vi/issues" +license: "MIT" +dev-repo: "git+https://github.com/kandu/mew_vi.git" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02.3"} + "mew" {>= "0.1.0" & < "0.2"} + "react" + "dune" {>= "1.1.0"} +] + +synopsis: "Modal editing witch, VI interpreter" +description: """ +A vi-like modal editing engine generator.""" + +url { + src: "https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz" + checksum: "md5=341e9a9a20383641015bf503952906bc" +} diff --git a/rtop.esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam b/rtop.esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam new file mode 100644 index 000000000..14c9f7537 --- /dev/null +++ b/rtop.esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam @@ -0,0 +1,39 @@ +opam-version: "2.0" +synopsis: "OCaml compiler libraries repackaged" +description: """ +This packages exposes the OCaml compiler libraries repackages under +the toplevel names Ocaml_common, Ocaml_bytecomp, Ocaml_optcomp, ...""" +maintainer: ["Jane Street developers"] +authors: ["Jane Street Group, LLC"] +license: "MIT" +homepage: "https://github.com/janestreet/ocaml-compiler-libs" +bug-reports: "https://github.com/janestreet/ocaml-compiler-libs/issues" +depends: [ + "dune" {>= "2.8"} + "ocaml" {>= "4.04.1"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/janestreet/ocaml-compiler-libs.git" +url { + src: + "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.4/ocaml-compiler-libs-v0.12.4.tbz" + checksum: [ + "sha256=4ec9c9ec35cc45c18c7a143761154ef1d7663036a29297f80381f47981a07760" + "sha512=978dba8dfa61f98fa24fda7a9c26c2e837081f37d1685fe636dc19cfc3278a940cf01a10293504b185c406706bc1008bc54313d50f023bcdea6d5ac6c0788b35" + ] +} +x-commit-hash: "8cd12f18bb7171c2b67d661868c4271fae528d93" diff --git a/rtop.esy.lock/opam/ocamlbuild.0.14.2+win/opam b/rtop.esy.lock/opam/ocamlbuild.0.14.2+win/opam new file mode 100644 index 000000000..19651dfbc --- /dev/null +++ b/rtop.esy.lock/opam/ocamlbuild.0.14.2+win/opam @@ -0,0 +1,38 @@ +opam-version: "2.0" +synopsis: + "OCamlbuild is a build system with builtin rules to easily build most OCaml projects" +maintainer: "Gabriel Scherer " +authors: ["Nicolas Pouillard" "Berke Durak"] +license: "LGPL-2.0-or-later WITH OCaml-LGPL-linking-exception" +homepage: "https://github.com/ocaml/ocamlbuild/" +doc: "https://github.com/ocaml/ocamlbuild/blob/master/manual/manual.adoc" +bug-reports: "https://github.com/ocaml/ocamlbuild/issues" +depends: [ + "ocaml" {>= "4.03"} +] +conflicts: [ + "base-ocamlbuild" + "ocamlfind" {< "1.6.2"} +] +build: [ + [make "all"] +] +install: [ + [make "install"] + ["mkdir" "-p" "%{lib}%/ocamlbuild"] + ["install" "-m" "0644" "META" "%{lib}%/ocamlbuild"] +] +dev-repo: "git+https://github.com/ocaml/ocamlbuild.git" +url { + src: "https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.2.tar.gz" + checksum: [ + "md5=2f407fadd57b073155a6aead887d9676" + "sha512=f568bf10431a1f701e8bd7554dc662400a0d978411038bbad93d44dceab02874490a8a5886a9b44e017347e7949997f13f5c3752f74e1eb5e273d2beb19a75fd" + ] +} +extra-source "ocamlbuild-0.14.2.patch" { + src: "https://raw.githubusercontent.com/ocaml-opam/opam-repository-mingw/354a87b397856f2a70024c5c83fc5001074935b6/packages/ocamlbuild/ocamlbuild.0.14.2/files/ocamlbuild-0.14.2.patch" + checksum: "sha256=a9b7e1829a3304e5a073d8ddea29d3d8272698e93b7e1ee659ae5e31e5cfb6b9" +} +patches: "ocamlbuild-0.14.2.patch" +available: os = "win32" diff --git a/rtop.esy.lock/opam/ocamlfind.1.9.6/files/0001-Harden-test-for-OCaml-5.patch b/rtop.esy.lock/opam/ocamlfind.1.9.6/files/0001-Harden-test-for-OCaml-5.patch new file mode 100644 index 000000000..8011238cd --- /dev/null +++ b/rtop.esy.lock/opam/ocamlfind.1.9.6/files/0001-Harden-test-for-OCaml-5.patch @@ -0,0 +1,12 @@ +diff a/configure b/configure +--- a/configure ++++ b/configure +@@ -294,7 +294,7 @@ + # If findlib has been configured -sitelib $(ocamlc -where) then there's + # nothing to do, but otherwise we need to put OCaml's Standard Library + # into the path setting. +- if [ ! -e "${ocaml_sitelib}/stdlib/META" ]; then ++ if [ ! -e "${ocaml_sitelib}/stdlib.cmi" ]; then + ocamlpath="${ocaml_core_stdlib}${path_sep}${ocamlpath}" + fi + fi diff --git a/rtop.esy.lock/opam/ocamlfind.1.9.6/opam b/rtop.esy.lock/opam/ocamlfind.1.9.6/opam new file mode 100644 index 000000000..a81f0c50e --- /dev/null +++ b/rtop.esy.lock/opam/ocamlfind.1.9.6/opam @@ -0,0 +1,48 @@ +opam-version: "2.0" +synopsis: "A library manager for OCaml" +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. +""" +license: "MIT" +maintainer: "Thomas Gazagnaire " +authors: "Gerd Stolpmann " +homepage: "http://projects.camlcity.org/projects/findlib.html" +bug-reports: "https://github.com/ocaml/ocamlfind/issues" +depends: [ + "ocaml" {>= "3.08.0"} +] +depopts: ["graphics"] +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} +] +extra-files: ["0001-Harden-test-for-OCaml-5.patch" "md5=3cddbf72164c29d4e50e077a92a37c6c"] +# See https://github.com/ocaml/ocamlfind/pull/61 +patches: ["0001-Harden-test-for-OCaml-5.patch"] +dev-repo: "git+https://github.com/ocaml/ocamlfind.git" +url { + src: "http://download.camlcity.org/download/findlib-1.9.6.tar.gz" + checksum: [ + "md5=96c6ee50a32cca9ca277321262dbec57" + "sha512=cfaf1872d6ccda548f07d32cc6b90c3aafe136d2aa6539e03143702171ee0199add55269bba894c77115535dc46a5835901a5d7c75768999e72db503bfd83027" + ] +} +available: os != "win32" diff --git a/rtop.esy.lock/opam/ocplib-endian.1.2/opam b/rtop.esy.lock/opam/ocplib-endian.1.2/opam new file mode 100644 index 000000000..05c0a38d4 --- /dev/null +++ b/rtop.esy.lock/opam/ocplib-endian.1.2/opam @@ -0,0 +1,40 @@ +opam-version: "2.0" +license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" +synopsis: + "Optimised functions to read and write int16/32/64 from strings and bigarrays" +description: """\ +The library implements three modules: +* [EndianString](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianString.mli) works directly on strings, and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts; +* [EndianBytes](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianBytes.mli) works directly on bytes, and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts; +* [EndianBigstring](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianBigstring.mli) works on bigstrings (Bigarrays of chars), and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts.""" +maintainer: "pierre.chambart@ocamlpro.com" +authors: "Pierre Chambart" +homepage: "https://github.com/OCamlPro/ocplib-endian" +doc: "https://ocamlpro.github.io/ocplib-endian/ocplib-endian/" +bug-reports: "https://github.com/OCamlPro/ocplib-endian/issues" +depends: [ + "base-bytes" + "ocaml" {>= "4.03.0"} + "cppo" {>= "1.1.0" & build} + "dune" {>= "1.0"} +] +build: [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} +] +dev-repo: "git+https://github.com/OCamlPro/ocplib-endian.git" +url { + src: + "https://github.com/OCamlPro/ocplib-endian/archive/refs/tags/1.2.tar.gz" + checksum: [ + "md5=8d5492eeb7c6815ade72a7415ea30949" + "sha512=2e70be5f3d6e377485c60664a0e235c3b9b24a8d6b6a03895d092c6e40d53810bfe1f292ee69e5181ce6daa8a582bfe3d59f3af889f417134f658812be5b8b85" + ] +} diff --git a/rtop.esy.lock/opam/ppx_derivers.1.2.1/opam b/rtop.esy.lock/opam/ppx_derivers.1.2.1/opam new file mode 100644 index 000000000..484b2654f --- /dev/null +++ b/rtop.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+https://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/rtop.esy.lock/opam/ppxlib.0.31.0/opam b/rtop.esy.lock/opam/ppxlib.0.31.0/opam new file mode 100644 index 000000000..c60173886 --- /dev/null +++ b/rtop.esy.lock/opam/ppxlib.0.31.0/opam @@ -0,0 +1,61 @@ +opam-version: "2.0" +synopsis: "Standard infrastructure for ppx rewriters" +description: """ +Ppxlib is the standard infrastructure for ppx rewriters +and other programs that manipulate the in-memory representation of +OCaml programs, a.k.a the "Parsetree". + +It also comes bundled with two ppx rewriters that are commonly used to +write tools that manipulate and/or generate Parsetree values; +`ppxlib.metaquot` which allows to construct Parsetree values using the +OCaml syntax directly and `ppxlib.traverse` which provides various +ways of automatically traversing values of a given type, in particular +allowing to inject a complex structured value into generated code. +""" +maintainer: ["opensource@janestreet.com"] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml-ppx/ppxlib" +doc: "https://ocaml-ppx.github.io/ppxlib/" +bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" +depends: [ + "dune" {>= "2.7"} + "ocaml" {>= "4.04.1" & < "5.2.0" & != "5.1.0~alpha1"} + "ocaml-compiler-libs" {>= "v0.11.0"} + "ppx_derivers" {>= "1.0"} + "sexplib0" {>= "v0.12"} + "sexplib0" {with-test & >= "v0.15"} + "stdlib-shims" + "ocamlfind" {with-test} + "re" {with-test & >= "1.9.0"} + "cinaps" {with-test & >= "v0.12.1"} + "odoc" {with-doc} +] +conflicts: [ + "ocaml-migrate-parsetree" {< "2.0.0"} + "base-effects" +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-ppx/ppxlib.git" +url { + src: + "https://github.com/ocaml-ppx/ppxlib/releases/download/0.31.0/ppxlib-0.31.0.tbz" + checksum: [ + "sha256=d21676654e57faa12d7895caffe8703b64521d66efcf152491871a55b2ae41d8" + "sha512=63f2d327cfc5382476f812670d304aade91b3ea8f10420d6fc9e7078112368d99dbf43dfda9c2c2cf91341b71c37c45c1fe1d54fecde2348560f9d3c48571603" + ] +} +x-commit-hash: "e765a30151347f8044ce077d103d3828db8d5409" diff --git a/rtop.esy.lock/opam/react.1.2.2/opam b/rtop.esy.lock/opam/react.1.2.2/opam new file mode 100644 index 000000000..cbbdc8f3f --- /dev/null +++ b/rtop.esy.lock/opam/react.1.2.2/opam @@ -0,0 +1,34 @@ +opam-version: "2.0" +synopsis: "Declarative events and signals for OCaml" +description: """\ +Release %%VERSION%% + +React is an OCaml module for functional reactive programming (FRP). It +provides support to program with time varying values : declarative +events and signals. React doesn't define any primitive event or +signal, it lets the client chooses the concrete timeline. + +React is made of a single, independent, module and distributed under +the ISC license. + +Homepage: """ +maintainer: "Daniel Bünzli " +authors: "The react programmers" +license: "ISC" +tags: ["reactive" "declarative" "signal" "event" "frp" "org:erratique"] +homepage: "https://erratique.ch/software/react" +doc: "https://erratique.ch/software/react/doc/" +bug-reports: "https://github.com/dbuenzli/react/issues" +depends: [ + "ocaml" {>= "4.08.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build & >= "1.0.3"} +] +build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"] +dev-repo: "git+https://erratique.ch/repos/react.git" +url { + src: "https://erratique.ch/software/react/releases/react-1.2.2.tbz" + checksum: + "sha512=18cdd544d484222ba02db6bd9351571516532e7a1c107b59bbe39193837298f5c745eab6754f8bc6ff125b387be7018c6d6e6ac99f91925a5e4f53af688522b1" +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/reason.3.10.0/opam b/rtop.esy.lock/opam/reason.3.10.0/opam new file mode 100644 index 000000000..1f7544673 --- /dev/null +++ b/rtop.esy.lock/opam/reason.3.10.0/opam @@ -0,0 +1,51 @@ +opam-version: "2.0" +synopsis: "Reason: Syntax & Toolchain for OCaml" +description: """ +Reason gives OCaml a new syntax that is remniscient of languages like +JavaScript. It's also the umbrella project for a set of tools for the OCaml & +JavaScript ecosystem.""" +maintainer: [ + "Jordan Walke " + "Antonio Nuno Monteiro " +] +authors: ["Jordan Walke "] +license: "MIT" +homepage: "https://reasonml.github.io/" +bug-reports: "https://github.com/reasonml/reason/issues" +depends: [ + "dune" {>= "2.9"} + "ocaml" {>= "4.03"} + "ocamlfind" {build} + "dune-build-info" {>= "2.9.3"} + "menhir" {>= "20180523"} + "merlin-extend" {>= "0.6"} + "fix" + "ppx_derivers" + "ppxlib" {>= "0.28.0"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "--promote-install-files=false" + "@install" + "@doc" {with-doc} + ] + ["dune" "install" "-p" name "--create-install-files" name] +] +dev-repo: "git+https://github.com/reasonml/reason.git" +url { + src: + "https://github.com/reasonml/reason/releases/download/3.10.0/reason-3.10.0.tbz" + checksum: [ + "sha256=17ead4c2864af7273f56d0ad62c4564be2eade76d3da87b1d381ed5b44f466cb" + "sha512=31c1c0752c426e3a55a9f8eceb157de3536e5a72385a645112236129f2f1ac04e4df42ba2c82616eacc339b4627725e1472903fd4c56c44024cba7635f2602cb" + ] +} +x-commit-hash: "a3545e5f40bf90f20214a878bd3072b2365d6504" diff --git a/rtop.esy.lock/opam/result.1.5/opam b/rtop.esy.lock/opam/result.1.5/opam new file mode 100644 index 000000000..6b7b68d72 --- /dev/null +++ b/rtop.esy.lock/opam/result.1.5/opam @@ -0,0 +1,22 @@ +opam-version: "2.0" +maintainer: "Jane Street developers" +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/rtop.esy.lock/opam/seq.base/files/META.seq b/rtop.esy.lock/opam/seq.base/files/META.seq new file mode 100644 index 000000000..06b95eff3 --- /dev/null +++ b/rtop.esy.lock/opam/seq.base/files/META.seq @@ -0,0 +1,4 @@ +name="seq" +version="[distributed with OCaml 4.07 or above]" +description="dummy backward-compatibility package for iterators" +requires="" diff --git a/rtop.esy.lock/opam/seq.base/files/seq.install b/rtop.esy.lock/opam/seq.base/files/seq.install new file mode 100644 index 000000000..c4d70206e --- /dev/null +++ b/rtop.esy.lock/opam/seq.base/files/seq.install @@ -0,0 +1,3 @@ +lib:[ + "META.seq" {"META"} +] diff --git a/rtop.esy.lock/opam/seq.base/opam b/rtop.esy.lock/opam/seq.base/opam new file mode 100644 index 000000000..b33d8c7da --- /dev/null +++ b/rtop.esy.lock/opam/seq.base/opam @@ -0,0 +1,15 @@ +opam-version: "2.0" +maintainer: " " +authors: " " +homepage: " " +depends: [ + "ocaml" {>= "4.07.0"} +] +dev-repo: "git+https://github.com/ocaml/ocaml.git" +bug-reports: "https://caml.inria.fr/mantis/main_page.php" +synopsis: + "Compatibility package for OCaml's standard iterator type starting from 4.07." +extra-files: [ + ["seq.install" "md5=026b31e1df290373198373d5aaa26e42"] + ["META.seq" "md5=b33c8a1a6c7ed797816ce27df4855107"] +] diff --git a/rtop.esy.lock/opam/sexplib0.v0.16.0/opam b/rtop.esy.lock/opam/sexplib0.v0.16.0/opam new file mode 100644 index 000000000..d9c5f049d --- /dev/null +++ b/rtop.esy.lock/opam/sexplib0.v0.16.0/opam @@ -0,0 +1,26 @@ +opam-version: "2.0" +maintainer: "Jane Street developers" +authors: ["Jane Street Group, LLC"] +homepage: "https://github.com/janestreet/sexplib0" +bug-reports: "https://github.com/janestreet/sexplib0/issues" +dev-repo: "git+https://github.com/janestreet/sexplib0.git" +doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/sexplib0/index.html" +license: "MIT" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.08.0"} + "dune" {>= "2.0.0"} +] +synopsis: "Library containing the definition of S-expressions and some base converters" +description: " +Part of Jane Street's Core library +The Core suite of libraries is an industrial strength alternative to +OCaml's standard library that was developed by Jane Street, the +largest industrial user of OCaml. +" +url { +src: "https://ocaml.janestreet.com/ocaml-core/v0.16/files/sexplib0-v0.16.0.tar.gz" +checksum: "sha256=86dba26468194512f789f2fb709063515a9cb4e5c4461c021c239a369590701d" +} diff --git a/rtop.esy.lock/opam/stdlib-shims.0.3.0/opam b/rtop.esy.lock/opam/stdlib-shims.0.3.0/opam new file mode 100644 index 000000000..8c9695710 --- /dev/null +++ b/rtop.esy.lock/opam/stdlib-shims.0.3.0/opam @@ -0,0 +1,31 @@ +opam-version: "2.0" +maintainer: "The stdlib-shims programmers" +authors: "The stdlib-shims programmers" +homepage: "https://github.com/ocaml/stdlib-shims" +doc: "https://ocaml.github.io/stdlib-shims/" +dev-repo: "git+https://github.com/ocaml/stdlib-shims.git" +bug-reports: "https://github.com/ocaml/stdlib-shims/issues" +tags: ["stdlib" "compatibility" "org:ocaml"] +license: ["LGPL-2.1-only WITH OCaml-LGPL-linking-exception"] +depends: [ + "dune" + "ocaml" {>= "4.02.3"} +] +build: [ "dune" "build" "-p" name "-j" jobs ] +synopsis: "Backport some of the new stdlib features to older compiler" +description: """ +Backport some of the new stdlib features to older compiler, +such as the Stdlib module. + +This allows projects that require compatibility with older compiler to +use these new features in their code. +""" +x-commit-hash: "fb6815e5d745f07fd567c11671149de6ef2e74c8" +url { + src: + "https://github.com/ocaml/stdlib-shims/releases/download/0.3.0/stdlib-shims-0.3.0.tbz" + checksum: [ + "sha256=babf72d3917b86f707885f0c5528e36c63fccb698f4b46cf2bab5c7ccdd6d84a" + "sha512=1151d7edc8923516e9a36995a3f8938d323aaade759ad349ed15d6d8501db61ffbe63277e97c4d86149cf371306ac23df0f581ec7e02611f58335126e1870980" + ] +} diff --git a/rtop.esy.lock/opam/topkg.1.0.7/opam b/rtop.esy.lock/opam/topkg.1.0.7/opam new file mode 100644 index 000000000..83fc06f49 --- /dev/null +++ b/rtop.esy.lock/opam/topkg.1.0.7/opam @@ -0,0 +1,47 @@ +opam-version: "2.0" +synopsis: "The transitory OCaml software packager" +description: """\ +Topkg is a packager for distributing OCaml software. It provides an +API to describe the files a package installs in a given build +configuration and to specify information about the package's +distribution, creation and publication procedures. + +The optional topkg-care package provides the `topkg` command line tool +which helps with various aspects of a package's life cycle: creating +and linting a distribution, releasing it on the WWW, publish its +documentation, add it to the OCaml opam repository, etc. + +Topkg is distributed under the ISC license and has **no** +dependencies. This is what your packages will need as a *build* +dependency. + +Topkg-care is distributed under the ISC license it depends on +[fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], +[webbrowser][webbrowser] and `opam-format`. + +[fmt]: http://erratique.ch/software/fmt +[logs]: http://erratique.ch/software/logs +[bos]: http://erratique.ch/software/bos +[cmdliner]: http://erratique.ch/software/cmdliner +[webbrowser]: http://erratique.ch/software/webbrowser + +Home page: http://erratique.ch/software/topkg""" +maintainer: "Daniel Bünzli " +authors: "The topkg programmers" +license: "ISC" +tags: ["packaging" "ocamlbuild" "org:erratique"] +homepage: "https://erratique.ch/software/topkg" +doc: "https://erratique.ch/software/topkg/doc" +bug-reports: "https://github.com/dbuenzli/topkg/issues" +depends: [ + "ocaml" {>= "4.05.0"} + "ocamlfind" {build & >= "1.6.1"} + "ocamlbuild" +] +build: ["ocaml" "pkg/pkg.ml" "build" "--pkg-name" name "--dev-pkg" "%{dev}%"] +dev-repo: "git+https://erratique.ch/repos/topkg.git" +url { + src: "https://erratique.ch/software/topkg/releases/topkg-1.0.7.tbz" + checksum: + "sha512=09e59f1759bf4db8471f02d0aefd8db602b44932a291c05c312b1423796e7a15d1598d3c62a0cec7f083eff8e410fac09363533dc4bd2120914bb9664efea535" +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/trie.1.0.0/opam b/rtop.esy.lock/opam/trie.1.0.0/opam new file mode 100644 index 000000000..29442d7dd --- /dev/null +++ b/rtop.esy.lock/opam/trie.1.0.0/opam @@ -0,0 +1,19 @@ +opam-version: "2.0" +maintainer: "zandoye@gmail.com" +authors: [ "ZAN DoYe" ] +homepage: "https://github.com/kandu/trie/" +bug-reports: "https://github.com/kandu/trie/issues" +license: "MIT" +dev-repo: "git+https://github.com/kandu/trie.git" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" {>= "4.02"} + "dune" {>= "1.0"} +] +synopsis: "Strict impure trie tree" +url { + src: "https://github.com/kandu/trie/archive/1.0.0.tar.gz" + checksum: "md5=84519b5f8bd92490bfc68a52f706ba14" +} diff --git a/rtop.esy.lock/opam/uchar.0.0.2/opam b/rtop.esy.lock/opam/uchar.0.0.2/opam new file mode 100644 index 000000000..4310af436 --- /dev/null +++ b/rtop.esy.lock/opam/uchar.0.0.2/opam @@ -0,0 +1,36 @@ +opam-version: "2.0" +maintainer: "Daniel Bünzli " +authors: ["Daniel Bünzli "] +homepage: "http://ocaml.org" +doc: "https://ocaml.github.io/uchar/" +dev-repo: "git+https://github.com/ocaml/uchar.git" +bug-reports: "https://github.com/ocaml/uchar/issues" +tags: [ "text" "character" "unicode" "compatibility" "org:ocaml.org" ] +license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" +depends: [ + "ocaml" {>= "3.12.0"} + "ocamlbuild" {build} +] +build: [ + ["ocaml" "pkg/git.ml"] + [ + "ocaml" + "pkg/build.ml" + "native=%{ocaml:native}%" + "native-dynlink=%{ocaml:native-dynlink}%" + ] +] +synopsis: "Compatibility library for OCaml's Uchar module" +description: """ +The `uchar` package provides a compatibility library for the +[`Uchar`][1] module introduced in OCaml 4.03. + +The `uchar` package is distributed under the license of the OCaml +compiler. See [LICENSE](LICENSE) for details. + +[1]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Uchar.html""" +url { + src: + "https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz" + checksum: "md5=c9ba2c738d264c420c642f7bb1cf4a36" +} diff --git a/rtop.esy.lock/opam/utop.2.13.1/opam b/rtop.esy.lock/opam/utop.2.13.1/opam new file mode 100644 index 000000000..88b623820 --- /dev/null +++ b/rtop.esy.lock/opam/utop.2.13.1/opam @@ -0,0 +1,50 @@ +opam-version: "2.0" +synopsis: "Universal toplevel for OCaml" +description: + "utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for OCaml. It can run in a terminal or in Emacs. It supports line edition, history, real-time and context sensitive completion, colors, and more. It integrates with the Tuareg mode in Emacs." +maintainer: ["jeremie@dimino.org"] +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/utop" +doc: "https://ocaml-community.github.io/utop/" +bug-reports: "https://github.com/ocaml-community/utop/issues" +depends: [ + "dune" {>= "2.0"} + "ocaml" {>= "4.11.0"} + "base-unix" + "base-threads" + "ocamlfind" {>= "1.7.2"} + "lambda-term" {>= "3.1.0" & < "4.0"} + "logs" + "lwt" + "lwt_react" + "zed" {>= "3.2.0"} + "react" {>= "1.0.0"} + "cppo" {>= "1.1.2"} + "alcotest" {with-test} + "xdg" {>= "3.9.0"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/utop.git" +url { + src: + "https://github.com/ocaml-community/utop/releases/download/2.13.1/utop-2.13.1.tbz" + checksum: [ + "sha256=b04ec2a394d1a6a28a79444c58f66eab77b7f74401f4714aa6e6f1c2125a6ffd" + "sha512=37b116f408a8d8448e5faf99805e3c26a8bc0c149a64e2be75d261b1de9aca176982e95fb0d128e5072f22da99375d0691d23093d4b21d5fb9a26b034c262c51" + ] +} +x-commit-hash: "5b98d2845bf8e46a253593578cf0371d773f6da0" diff --git a/rtop.esy.lock/opam/uucp.15.1.0/opam b/rtop.esy.lock/opam/uucp.15.1.0/opam new file mode 100644 index 000000000..f3abfcad2 --- /dev/null +++ b/rtop.esy.lock/opam/uucp.15.1.0/opam @@ -0,0 +1,51 @@ +opam-version: "2.0" +synopsis: "Unicode character properties for OCaml" +description: """\ +Uucp is an OCaml library providing efficient access to a selection of +character properties of the [Unicode character database]. + +Uucp is distributed under the ISC license. It has no dependency. + +Home page: + +[Unicode character database]: http://www.unicode.org/reports/tr44/""" +maintainer: "Daniel Bünzli " +authors: "The uucp programmers" +license: "ISC" +tags: ["unicode" "text" "character" "org:erratique"] +homepage: "https://erratique.ch/software/uucp" +doc: "https://erratique.ch/software/uucp/doc/" +bug-reports: "https://github.com/dbuenzli/uucp/issues" +depends: [ + "ocaml" {>= "4.14.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build & >= "1.0.3"} + "uucd" {with-test & dev & >= "15.1.0" & < "16.0.0"} + "uunf" {with-test} +] +depopts: ["uunf" "cmdliner"] +conflicts: [ + "uunf" {< "15.1.0" | >= "16.0.0"} + "cmdliner" {< "1.1.0"} +] +build: [ + "ocaml" + "pkg/pkg.ml" + "build" + "--dev-pkg" + "%{dev}%" + "--with-uunf" + "%{uunf:installed}%" + "--with-cmdliner" + "%{cmdliner:installed}%" +] +post-messages: + "If the build fails with \"ocamlopt.opt got signal and exited\", issue 'ulimit -s unlimited' and retry." + {failure & (arch = "ppc64" | arch = "arm64")} +dev-repo: "git+https://erratique.ch/repos/uucp.git" +url { + src: "https://erratique.ch/software/uucp/releases/uucp-15.1.0.tbz" + checksum: + "sha512=998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364" +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/uuseg.15.1.0/opam b/rtop.esy.lock/opam/uuseg.15.1.0/opam new file mode 100644 index 000000000..c1a872035 --- /dev/null +++ b/rtop.esy.lock/opam/uuseg.15.1.0/opam @@ -0,0 +1,55 @@ +opam-version: "2.0" +synopsis: "Unicode text segmentation for OCaml" +description: """\ +Uuseg is an OCaml library for segmenting Unicode text. It implements +the locale independent [Unicode text segmentation algorithms][1] to +detect grapheme cluster, word and sentence boundaries and the [Unicode +line breaking algorithm][2] to detect line break opportunities. + +The library is independent from any IO mechanism or Unicode text data +structure and it can process text without a complete in-memory +representation. + +Uuseg is distributed under the ISC license. It depends on [Uucp]. + +[1]: http://www.unicode.org/reports/tr29/ +[2]: http://www.unicode.org/reports/tr14/ +[Uucp]: http://erratique.ch/software/uucp + +Homepage: """ +maintainer: "Daniel Bünzli " +authors: "The uuseg programmers" +license: "ISC" +tags: ["unicode" "text" "segmentation" "org:erratique"] +homepage: "https://erratique.ch/software/uuseg" +doc: "https://erratique.ch/software/uuseg/doc/" +bug-reports: "https://github.com/dbuenzli/uuseg/issues" +depends: [ + "ocaml" {>= "4.14.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build & >= "1.0.3"} + "uucp" {>= "15.1.0" & < "16.0.0"} +] +depopts: ["uutf" "cmdliner"] +conflicts: [ + "uutf" {< "1.0.0"} + "cmdliner" {< "1.1.0"} +] +build: [ + "ocaml" + "pkg/pkg.ml" + "build" + "--dev-pkg" + "%{dev}%" + "--with-uutf" + "%{uutf:installed}%" + "--with-cmdliner" + "%{cmdliner:installed}%" +] +dev-repo: "git+https://erratique.ch/repos/uuseg.git" +url { + src: "https://erratique.ch/software/uuseg/releases/uuseg-15.1.0.tbz" + checksum: + "sha512=1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a" +} \ No newline at end of file diff --git a/rtop.esy.lock/opam/uutf.1.0.3/opam b/rtop.esy.lock/opam/uutf.1.0.3/opam new file mode 100644 index 000000000..e96cc4a4d --- /dev/null +++ b/rtop.esy.lock/opam/uutf.1.0.3/opam @@ -0,0 +1,36 @@ +opam-version: "2.0" +synopsis: """Non-blocking streaming Unicode codec for OCaml""" +maintainer: ["Daniel Bünzli "] +authors: ["The uutf programmers"] +homepage: "https://erratique.ch/software/uutf" +doc: "https://erratique.ch/software/uutf/doc/" +dev-repo: "git+https://erratique.ch/repos/uutf.git" +bug-reports: "https://github.com/dbuenzli/uutf/issues" +license: ["ISC"] +tags: ["unicode" "text" "utf-8" "utf-16" "codec" "org:erratique"] +depends: ["ocaml" {>= "4.03.0"} + "ocamlfind" {build} + "ocamlbuild" {build} + "topkg" {build & >= "1.0.3"}] +depopts: ["cmdliner"] +conflicts: ["cmdliner" {< "0.9.8"}] +build: [["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%" + "--with-cmdliner" "%{cmdliner:installed}%"]] +url { + src: "https://erratique.ch/software/uutf/releases/uutf-1.0.3.tbz" + checksum: "sha512=50cc4486021da46fb08156e9daec0d57b4ca469b07309c508d5a9a41e9dbcf1f32dec2ed7be027326544453dcaf9c2534919395fd826dc7768efc6cc4bfcc9f8"} +description: """ +Uutf is a non-blocking streaming codec to decode and encode the UTF-8, +UTF-16, UTF-16LE and UTF-16BE encoding schemes. It can efficiently +work character by character without blocking on IO. Decoders perform +character position tracking and support newline normalization. + +Functions are also provided to fold over the characters of UTF encoded +OCaml string values and to directly encode characters in OCaml +Buffer.t values. **Note** that since OCaml 4.14, that functionality +can be found in the Stdlib and you are encouraged to migrate to it. + +Uutf has no dependency and is distributed under the ISC license. + +Home page: http://erratique.ch/software/uutf +Contact: Daniel Bünzli ``""" \ No newline at end of file diff --git a/rtop.esy.lock/opam/xdg.3.11.1/opam b/rtop.esy.lock/opam/xdg.3.11.1/opam new file mode 100644 index 000000000..9a6a17d03 --- /dev/null +++ b/rtop.esy.lock/opam/xdg.3.11.1/opam @@ -0,0 +1,40 @@ +opam-version: "2.0" +synopsis: "XDG Base Directory Specification" +description: + "https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html" +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" +depends: [ + "dune" {>= "3.5"} + "ocaml" {>= "4.08"} + "odoc" {with-doc} +] +dev-repo: "git+https://github.com/ocaml/dune.git" +build: [ + ["dune" "subst"] {dev} + ["rm" "-rf" "vendor/csexp"] + ["rm" "-rf" "vendor/pp"] + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@doc" {with-doc} + ] +] +url { + src: + "https://github.com/ocaml/dune/releases/download/3.11.1/dune-3.11.1.tbz" + checksum: [ + "sha256=866f2307adadaf7604f3bf9d98bb4098792baa046953a6726c96c40fc5ed3f71" + "sha512=c888153b204a16bcfed2636de776bbd5f9ca84484e716cc1e9ef3ba3c904e9dd15a2609ae943cddb6097912623ec54618c58386d6730ff742d746850400fb3cc" + ] +} +x-commit-hash: "7cbb0e7277c6cacd1ccf7941cac5a03c25fc63cf" diff --git a/rtop.esy.lock/opam/yojson.2.1.1/opam b/rtop.esy.lock/opam/yojson.2.1.1/opam new file mode 100644 index 000000000..0703d53bf --- /dev/null +++ b/rtop.esy.lock/opam/yojson.2.1.1/opam @@ -0,0 +1,48 @@ +opam-version: "2.0" +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. + +ydump is a pretty-printing command-line program provided with the +yojson package.""" +maintainer: [ + "paul-elliot@tarides.com" "nathan@tarides.com" "marek@tarides.com" +] +authors: ["Martin Jambon"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/yojson" +doc: "https://ocaml-community.github.io/yojson" +bug-reports: "https://github.com/ocaml-community/yojson/issues" +depends: [ + "dune" {>= "2.7"} + "ocaml" {>= "4.02.3"} + "cppo" {build} + "alcotest" {with-test & >= "0.8.5"} + "seq" {>= "0.2.2"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/yojson.git" +url { + src: + "https://github.com/ocaml-community/yojson/releases/download/2.1.1/yojson-2.1.1.tbz" + checksum: [ + "sha256=d58183207b198dc065866239066e074c34f9e139c0d9c4175a38809790e88173" + "sha512=f7b8529900acb29bc6236d8312d3ebcadbcb3f9d361c8acaed9f7fc7e30527b41a1f3cff80382dde445e6da18a4edc5a9c6758af24affce1022d0741dbd9daeb" + ] +} +x-commit-hash: "57bc8ca0eaf5bdb423fcdece49ea0d1c2866f90c" diff --git a/rtop.esy.lock/opam/zed.3.2.3/opam b/rtop.esy.lock/opam/zed.3.2.3/opam new file mode 100644 index 000000000..bc1a7e370 --- /dev/null +++ b/rtop.esy.lock/opam/zed.3.2.3/opam @@ -0,0 +1,48 @@ +opam-version: "2.0" +synopsis: "Abstract engine for text edition in OCaml" +description: """ +Zed is an abstract engine for text edition. It can be used to write text +editors, edition widgets, readlines, ... Zed uses Camomile to fully support the +Unicode specification, and implements an UTF-8 encoded string type with +validation, and a rope datastructure to achieve efficient operations on large +Unicode buffers. Zed also features a regular expression search on ropes. To +support efficient text edition capabilities, Zed provides macro recording and +cursor management facilities.""" +maintainer: ["ZAN DoYe "] +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/zed" +bug-reports: "https://github.com/ocaml-community/zed/issues" +depends: [ + "dune" {>= "3.0"} + "ocaml" {>= "4.02.3"} + "react" + "result" + "uchar" + "uutf" + "uucp" {>= "2.0.0"} + "uuseg" + "alcotest" {with-test} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/zed.git" +url { + src: "https://github.com/ocaml-community/zed/archive/refs/tags/3.2.3.tar.gz" + checksum: [ + "sha512=637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b" + ] +} diff --git a/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/ocamlbuild-0.14.2.patch b/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/ocamlbuild-0.14.2.patch new file mode 100644 index 000000000..e69de29bb diff --git a/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/winpatch.patch b/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/winpatch.patch new file mode 100644 index 000000000..bba9929fe --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/files/winpatch.patch @@ -0,0 +1,11 @@ +--- ./Makefile ++++ ./Makefile +@@ -271,7 +271,7 @@ + echo ' "ocamlbuild.byte" {"ocamlbuild.byte"}' >> ocamlbuild.install + ifeq ($(OCAML_NATIVE), true) + echo ' "ocamlbuild.native" {"ocamlbuild.native"}' >> ocamlbuild.install +- echo ' "ocamlbuild.native" {"ocamlbuild"}' >> ocamlbuild.install ++ echo " \"ocamlbuild.native\" {\"ocamlbuild${EXE}\"}" >> ocamlbuild.install + else + echo ' "ocamlbuild.byte" {"ocamlbuild"}' >> ocamlbuild.install + endif diff --git a/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/package.json b/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/package.json new file mode 100644 index 000000000..b57a42cc2 --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2+win_opam_override/package.json @@ -0,0 +1,29 @@ +{ + "build": [ + [ + "bash", + "-c", + "#{os == 'windows' ? 'patch -p1 < winpatch.patch' : 'true'}" + ], + [ + "make", + "-f", + "configure.make", + "all", + "OCAMLBUILD_PREFIX=#{self.install}", + "OCAMLBUILD_BINDIR=#{self.bin}", + "OCAMLBUILD_LIBDIR=#{self.lib}", + "OCAMLBUILD_MANDIR=#{self.man}", + "OCAMLBUILD_NATIVE=true", + "OCAMLBUILD_NATIVE_TOOLS=true", + "EXE=#{os == 'windows' ? '.exe': ''}" + ], + [ + "make", + "check-if-preinstalled", + "all", + "EXE=#{os == 'windows' ? '.exe': ''}", + "opam-install" + ] + ] +} diff --git a/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch b/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch new file mode 100644 index 000000000..d545632af --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch @@ -0,0 +1,11 @@ +--- ./Makefile ++++ ./Makefile +@@ -55,7 +55,7 @@ + export USE_CYGPATH; \ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' | \ +- $(SH) tools/patch '@FINDLIB_PATH@' '$(FINDLIB_PATH)' -p >findlib.conf ++ $(SH) tools/patch '@FINDLIB_PATH@' '$(FINDLIB_PATH)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ + echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ + fi diff --git a/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json b/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json new file mode 100644 index 000000000..bf169e50d --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json @@ -0,0 +1,61 @@ +{ + "build": [ + [ + "bash", + "-c", + "#{os == 'windows' ? 'patch -p1 < findlib.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/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/files/winpatch.patch b/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/files/winpatch.patch new file mode 100644 index 000000000..347e84160 --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/files/winpatch.patch @@ -0,0 +1,11 @@ +--- ./pkg/topkg.ml ++++ ./pkg/topkg.ml +@@ -344,7 +344,7 @@ + let build ccomp btool bdir pkg mvs = + let ext_to_string = Exts.ext_to_string ccomp in + let install, exec = build_strings btool bdir ext_to_string mvs in +- let e = Sys.command exec in ++ let e = Sys.command ("bash -c '" ^ exec ^ "'") in + if e <> 0 then exit e else + let install_file = pkg ^ ".install" in + try diff --git a/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/package.json b/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/package.json new file mode 100644 index 000000000..dc79f7593 --- /dev/null +++ b/rtop.esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override/package.json @@ -0,0 +1,11 @@ +{ + "build": [ + [ + "bash", + "-c", + "#{os == 'windows' ? 'patch -p1 < winpatch.patch' : 'true' }" + ], + "ocaml pkg/git.ml", + "ocaml pkg/build.ml native=true native-dynlink=true" + ] +} diff --git a/rtop.json b/rtop.json index 447d3708b..f5412b8aa 100644 --- a/rtop.json +++ b/rtop.json @@ -12,13 +12,13 @@ "@opam/dune": ">= 2.9.3", "@opam/reason": "^3.8.0", "@opam/utop": " >= 1.17.0", - "ocaml": ">= 4.3.0 < 5.1.0" + "ocaml": ">= 4.3.0 < 5.2.0" }, "devDependencies": { "@opam/merlin": "*", - "ocaml": "~4.14.0" + "ocaml": "5.x" }, "esy": { - "build": [ [ "dune", "build", "-p", "reason", "--disable-promotion" ] ] + "build": [["dune", "build", "-p", "reason", "--disable-promotion"]] } } diff --git a/rtop.opam b/rtop.opam index 79dd15be2..8998ee2da 100644 --- a/rtop.opam +++ b/rtop.opam @@ -14,7 +14,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.1"} + "ocaml" {>= "4.03" & < "5.2"} "reason" {= version} "utop" {>= "2.0"} "odoc" {with-doc} From d93d0c417b83ca2560d630765e27cd812cd4a5ad Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 17 Feb 2024 13:23:02 -0800 Subject: [PATCH 17/64] feat: support OCaml 5.2 (#2734) * feat: support OCaml 5.2 * chore: add changelog entry --- CHANGES.md | 1 + src/reason-parser-tests/testOprint.cppo.ml | 9 +- src/reason-parser/dune | 2 + src/reason-parser/ocaml_util.ml-5.2 | 11 + src/vendored-omp/src/ast_408_helper.ml | 24 -- src/vendored-omp/src/ast_409_helper.ml | 24 -- src/vendored-omp/src/ast_52.ml | 201 ++++++++++ src/vendored-omp/src/cinaps_helpers | 18 +- .../src/compiler-functions/ge_52.ml | 28 ++ src/vendored-omp/src/config/gen.ml | 5 +- .../src/migrate_parsetree_51_52.ml | 2 + .../src/migrate_parsetree_51_52_migrate.ml | 339 +++++++++++++++++ .../src/migrate_parsetree_52_51.ml | 2 + .../src/migrate_parsetree_52_51_migrate.ml | 344 ++++++++++++++++++ .../src/migrate_parsetree_versions.ml | 10 + .../src/migrate_parsetree_versions.mli | 2 + src/vendored-omp/src/reason_omp.ml | 3 + test/lib/outcometreePrinter.cppo.ml | 9 +- 18 files changed, 966 insertions(+), 68 deletions(-) create mode 100644 src/reason-parser/ocaml_util.ml-5.2 delete mode 100644 src/vendored-omp/src/ast_408_helper.ml delete mode 100644 src/vendored-omp/src/ast_409_helper.ml create mode 100644 src/vendored-omp/src/ast_52.ml create mode 100644 src/vendored-omp/src/compiler-functions/ge_52.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_51_52.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_52_51.ml create mode 100644 src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml diff --git a/CHANGES.md b/CHANGES.md index 7cb4853de..19e49c883 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ [#2723](https://github.com/reasonml/reason/pull/2723)) - Print wrapped type constraint on record patterns (@anmonteiro, [#2725](https://github.com/reasonml/reason/pull/2725)) +- Support OCaml 5.2 (@anmonteiro, [#2734](https://github.com/reasonml/reason/pull/2734)) ## 3.10.0 diff --git a/src/reason-parser-tests/testOprint.cppo.ml b/src/reason-parser-tests/testOprint.cppo.ml index 233c2deb4..4d7c7ed7b 100644 --- a/src/reason-parser-tests/testOprint.cppo.ml +++ b/src/reason-parser-tests/testOprint.cppo.ml @@ -46,7 +46,14 @@ let main () = #else let (typedtree, _) = #endif - Typemod.type_implementation modulename modulename modulename env ast in + Typemod.type_implementation +#if OCAML_VERSION >= (5,2,0) + (Unit_info.make ~source_file:modulename modulename) +#else + modulename modulename modulename +#endif + env ast + in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in let phrase = (Ast.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) diff --git a/src/reason-parser/dune b/src/reason-parser/dune index e5c67fe6f..883b6bfa6 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -7,6 +7,7 @@ (targets ocaml_util.ml) (deps ../generate/select.exe + ocaml_util.ml-5.2 ocaml_util.ml-5.1 ocaml_util.ml-5.0 ocaml_util.ml-5.00 @@ -25,6 +26,7 @@ %{targets} (run ../generate/select.exe + ocaml_util.ml-5.2 ocaml_util.ml-5.1 ocaml_util.ml-5.0 ocaml_util.ml-5.00 diff --git a/src/reason-parser/ocaml_util.ml-5.2 b/src/reason-parser/ocaml_util.ml-5.2 new file mode 100644 index 000000000..d46adf43f --- /dev/null +++ b/src/reason-parser/ocaml_util.ml-5.2 @@ -0,0 +1,11 @@ +let warn_latin1 lexbuf = + Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" +;; + +let print_loc ppf loc = + Location.print_loc ppf loc + + +let print_error loc f ppf x = + let error = Location.error_of_printer ~loc f x in + Location.print_report ppf error diff --git a/src/vendored-omp/src/ast_408_helper.ml b/src/vendored-omp/src/ast_408_helper.ml deleted file mode 100644 index 02763de78..000000000 --- a/src/vendored-omp/src/ast_408_helper.ml +++ /dev/null @@ -1,24 +0,0 @@ -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-omp/src/ast_409_helper.ml b/src/vendored-omp/src/ast_409_helper.ml deleted file mode 100644 index 02763de78..000000000 --- a/src/vendored-omp/src/ast_409_helper.ml +++ /dev/null @@ -1,24 +0,0 @@ -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-omp/src/ast_52.ml b/src/vendored-omp/src/ast_52.ml new file mode 100644 index 000000000..95991a643 --- /dev/null +++ b/src/vendored-omp/src/ast_52.ml @@ -0,0 +1,201 @@ +module Asttypes = struct + type constant (*IF_CURRENT = Asttypes.constant *) = + Const_int of int + | Const_char of char + | Const_string of string * Location.t * string option + | Const_float of string + | Const_int32 of int32 + | Const_int64 of int64 + | Const_nativeint of nativeint + + type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive + + type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto + + (* Order matters, used in polymorphic comparison *) + type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public + + type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable + + type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete + + type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh + + type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open + + type label = string + + type arg_label (*IF_CURRENT = Asttypes.arg_label *) = + Nolabel + | Labelled of string (** [label:T -> ...] *) + | Optional of string (** [?label:T -> ...] *) + + type 'a loc = 'a Location.loc = { + txt : 'a; + loc : Location.t; + } + + type variance (*IF_CURRENT = Asttypes.variance *) = + | Covariant + | Contravariant + | NoVariance + + type injectivity (*IF_CURRENT = Asttypes.injectivity *) = + | Injective + | NoInjectivity +end + +module 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 + | Oval_lazy of out_value + + type out_type_param (*IF_CURRENT = Outcometree.out_type_param *) = { + ot_non_gen: bool; + ot_name: string; + ot_variance: Asttypes.variance * Asttypes.injectivity + } + + type out_type (*IF_CURRENT = Outcometree.out_type *) = + | Otyp_abstract + | Otyp_open + | Otyp_alias of {non_gen:bool; aliased:out_type; alias:string} + | Otyp_arrow of Asttypes.arg_label * out_type * out_type + | Otyp_class of out_ident * out_type list + | Otyp_constr of out_ident * out_type list + | Otyp_manifest of out_type * out_type + | Otyp_object of { fields: (string * out_type) list; open_row:bool} + | Otyp_record of (string * bool * out_type) list + | Otyp_stuff of string + | Otyp_sum of out_constructor list + | Otyp_tuple of out_type list + | Otyp_var of bool * string + | Otyp_variant of out_variant * bool * (string list) option + | Otyp_poly of string list * out_type + | Otyp_module of out_ident * (string * out_type) list + | Otyp_attribute of out_type * out_attribute + + and out_constructor (*IF_CURRENT = Outcometree.out_constructor *) = { + ocstr_name: string; + ocstr_args: out_type list; + ocstr_return_type: out_type option; + } + + 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 Asttypes.arg_label * 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 * out_type_param list * out_class_type * + out_rec_status + | Osig_class_type of + bool * string * out_type_param 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: out_type_param 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: out_constructor 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 diff --git a/src/vendored-omp/src/cinaps_helpers b/src/vendored-omp/src/cinaps_helpers index 0968e5401..810790e9c 100644 --- a/src/vendored-omp/src/cinaps_helpers +++ b/src/vendored-omp/src/cinaps_helpers @@ -21,22 +21,10 @@ let supported_versions = [ ("414", "4.14"); ("5.0", "5.0"); ("5.1", "5.1"); + ("5.2", "5.2"); ] let qualified_types = [ - "Parsetree", - [ "structure" - ; "signature" - ; "toplevel_phrase" - ; "core_type" - ; "expression" - ; "pattern" - ; "case" - ; "type_declaration" - ; "type_extension" - ; "extension_constructor" - ]; - "Outcometree", [ "out_value" ; "out_type" @@ -46,10 +34,6 @@ let qualified_types = [ ; "out_type_extension" ; "out_phrase" ]; - - "Ast_mapper", - [ "mapper" - ]; ] let all_types = List.concat (List.map ~f:snd qualified_types) diff --git a/src/vendored-omp/src/compiler-functions/ge_52.ml b/src/vendored-omp/src/compiler-functions/ge_52.ml new file mode 100644 index 000000000..cc7c45890 --- /dev/null +++ b/src/vendored-omp/src/compiler-functions/ge_52.ml @@ -0,0 +1,28 @@ +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 = + let auto_include find_in_dir fn = + if !Clflags.no_std_include then + raise Not_found + else + let alert = Location.auto_include_alert in + Load_path.auto_include_otherlibs alert find_in_dir fn + in + Load_path.init ~auto_include ~visible:l ~hidden:[] + +let get_unboxed_types () = + !Clflags.unboxed_types + +let set_unboxed_types b = + Clflags.unboxed_types := b + +let may_map = Option.map + +let bad_docstring t = Warnings.Unexpected_docstring t diff --git a/src/vendored-omp/src/config/gen.ml b/src/vendored-omp/src/config/gen.ml index f09d05fbc..4922a5b0a 100644 --- a/src/vendored-omp/src/config/gen.ml +++ b/src/vendored-omp/src/config/gen.ml @@ -25,6 +25,7 @@ let () = | (4, 14) -> "414" | (5, 0) -> "500" | (5, 1) -> "51" + | (5, 2) -> "52" | _ -> Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str; exit 1); @@ -39,6 +40,8 @@ let () = "ge_410_and_lt_412.ml" else if ocaml_version < (5, 00) then "ge_412.ml" - else + else if ocaml_version < (5, 2) then "ge_50.ml" + else + "ge_52.ml" ) diff --git a/src/vendored-omp/src/migrate_parsetree_51_52.ml b/src/vendored-omp/src/migrate_parsetree_51_52.ml new file mode 100644 index 000000000..b5eada334 --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_51_52.ml @@ -0,0 +1,2 @@ + +include Migrate_parsetree_51_52_migrate diff --git a/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml b/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml new file mode 100644 index 000000000..d2d31a076 --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml @@ -0,0 +1,339 @@ +open Stdlib0 +module From = Ast_51 +module To = Ast_52 +let rec copy_out_type_extension : + Ast_51.Outcometree.out_type_extension -> + Ast_52.Outcometree.out_type_extension + = + fun + { Ast_51.Outcometree.otyext_name = otyext_name; + Ast_51.Outcometree.otyext_params = otyext_params; + Ast_51.Outcometree.otyext_constructors = otyext_constructors; + Ast_51.Outcometree.otyext_private = otyext_private } + -> + { + Ast_52.Outcometree.otyext_name = otyext_name; + Ast_52.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_52.Outcometree.otyext_constructors = + (List.map copy_out_constructor otyext_constructors); + Ast_52.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_51.Outcometree.out_phrase -> Ast_52.Outcometree.out_phrase = + function + | Ast_51.Outcometree.Ophr_eval (x0, x1) -> + Ast_52.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_51.Outcometree.Ophr_signature x0 -> + Ast_52.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_51.Outcometree.Ophr_exception x0 -> + Ast_52.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_51.Outcometree.out_sig_item -> Ast_52.Outcometree.out_sig_item = + function + | Ast_51.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_52.Outcometree.Osig_class + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_51.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_52.Outcometree.Osig_class_type + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_51.Outcometree.Osig_typext (x0, x1) -> + Ast_52.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_51.Outcometree.Osig_modtype (x0, x1) -> + Ast_52.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_51.Outcometree.Osig_module (x0, x1, x2) -> + Ast_52.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_51.Outcometree.Osig_type (x0, x1) -> + Ast_52.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_51.Outcometree.Osig_value x0 -> + Ast_52.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_51.Outcometree.Osig_ellipsis -> Ast_52.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_51.Outcometree.out_val_decl -> Ast_52.Outcometree.out_val_decl = + fun + { Ast_51.Outcometree.oval_name = oval_name; + Ast_51.Outcometree.oval_type = oval_type; + Ast_51.Outcometree.oval_prims = oval_prims; + Ast_51.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_52.Outcometree.oval_name = oval_name; + Ast_52.Outcometree.oval_type = (copy_out_type oval_type); + Ast_52.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_52.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_51.Outcometree.out_type_decl -> Ast_52.Outcometree.out_type_decl = + fun + { Ast_51.Outcometree.otype_name = otype_name; + Ast_51.Outcometree.otype_params = otype_params; + Ast_51.Outcometree.otype_type = otype_type; + Ast_51.Outcometree.otype_private = otype_private; + Ast_51.Outcometree.otype_immediate = otype_immediate; + Ast_51.Outcometree.otype_unboxed = otype_unboxed; + Ast_51.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_52.Outcometree.otype_name = otype_name; + Ast_52.Outcometree.otype_params = + (List.map copy_out_type_param otype_params); + Ast_52.Outcometree.otype_type = (copy_out_type otype_type); + Ast_52.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_52.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_52.Outcometree.otype_unboxed = otype_unboxed; + Ast_52.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_51.Type_immediacy.t -> Ast_52.Type_immediacy.t = + function + | Ast_51.Type_immediacy.Unknown -> Ast_52.Type_immediacy.Unknown + | Ast_51.Type_immediacy.Always -> Ast_52.Type_immediacy.Always + | Ast_51.Type_immediacy.Always_on_64bits -> + Ast_52.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_51.Outcometree.out_module_type -> Ast_52.Outcometree.out_module_type = + function + | Ast_51.Outcometree.Omty_abstract -> Ast_52.Outcometree.Omty_abstract + | Ast_51.Outcometree.Omty_functor (x0, x1) -> + Ast_52.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_51.Outcometree.Omty_ident x0 -> + Ast_52.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_51.Outcometree.Omty_signature x0 -> + Ast_52.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_51.Outcometree.Omty_alias x0 -> + Ast_52.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_51.Outcometree.out_ext_status -> Ast_52.Outcometree.out_ext_status = + function + | Ast_51.Outcometree.Oext_first -> Ast_52.Outcometree.Oext_first + | Ast_51.Outcometree.Oext_next -> Ast_52.Outcometree.Oext_next + | Ast_51.Outcometree.Oext_exception -> Ast_52.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_51.Outcometree.out_extension_constructor -> + Ast_52.Outcometree.out_extension_constructor + = + fun + { Ast_51.Outcometree.oext_name = oext_name; + Ast_51.Outcometree.oext_type_name = oext_type_name; + Ast_51.Outcometree.oext_type_params = oext_type_params; + Ast_51.Outcometree.oext_args = oext_args; + Ast_51.Outcometree.oext_ret_type = oext_ret_type; + Ast_51.Outcometree.oext_private = oext_private } + -> + { + Ast_52.Outcometree.oext_name = oext_name; + Ast_52.Outcometree.oext_type_name = oext_type_name; + Ast_52.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_52.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_52.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_52.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_private_flag : + Ast_51.Asttypes.private_flag -> Ast_52.Asttypes.private_flag = + function + | Ast_51.Asttypes.Private -> Ast_52.Asttypes.Private + | Ast_51.Asttypes.Public -> Ast_52.Asttypes.Public +and copy_out_rec_status : + Ast_51.Outcometree.out_rec_status -> Ast_52.Outcometree.out_rec_status = + function + | Ast_51.Outcometree.Orec_not -> Ast_52.Outcometree.Orec_not + | Ast_51.Outcometree.Orec_first -> Ast_52.Outcometree.Orec_first + | Ast_51.Outcometree.Orec_next -> Ast_52.Outcometree.Orec_next +and copy_out_class_type : + Ast_51.Outcometree.out_class_type -> Ast_52.Outcometree.out_class_type = + function + | Ast_51.Outcometree.Octy_constr (x0, x1) -> + Ast_52.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_52.Outcometree.Octy_arrow + ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_class_type x2)) + | Ast_51.Outcometree.Octy_signature (x0, x1) -> + Ast_52.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_51.Outcometree.out_class_sig_item -> + Ast_52.Outcometree.out_class_sig_item + = + function + | Ast_51.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_52.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_51.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_52.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_51.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_52.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type_param : + Ast_51.Outcometree.out_type_param -> Ast_52.Outcometree.out_type_param = + fun x -> + let (x0, x1) = x in + { + ot_non_gen = true; + ot_name= x0; + ot_variance = + let (x0, x1) = x1 + in ((copy_variance x0), (copy_injectivity x1)); + } + +and copy_injectivity : + Ast_51.Asttypes.injectivity -> Ast_52.Asttypes.injectivity = + function + | Ast_51.Asttypes.Injective -> Ast_52.Asttypes.Injective + | Ast_51.Asttypes.NoInjectivity -> Ast_52.Asttypes.NoInjectivity +and copy_variance : Ast_51.Asttypes.variance -> Ast_52.Asttypes.variance = + function + | Ast_51.Asttypes.Covariant -> Ast_52.Asttypes.Covariant + | Ast_51.Asttypes.Contravariant -> Ast_52.Asttypes.Contravariant + | Ast_51.Asttypes.NoVariance -> Ast_52.Asttypes.NoVariance +and copy_out_type : + Ast_51.Outcometree.out_type -> Ast_52.Outcometree.out_type = + function + | Ast_51.Outcometree.Otyp_abstract -> Ast_52.Outcometree.Otyp_abstract + | Otyp_alias {non_gen; aliased; alias} -> + Ast_52.Outcometree.Otyp_alias {non_gen;aliased=(copy_out_type aliased);alias} + | Ast_51.Outcometree.Otyp_open -> Ast_52.Outcometree.Otyp_open + | Ast_51.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_52.Outcometree.Otyp_arrow + ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_type x2)) + | Ast_51.Outcometree.Otyp_class (x0, x1) -> + Ast_52.Outcometree.Otyp_class + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Otyp_constr (x0, x1) -> + Ast_52.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_51.Outcometree.Otyp_object { fields; open_row} -> + Ast_52.Outcometree.Otyp_object + {fields=(List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) fields); + open_row} + | Ast_51.Outcometree.Otyp_manifest (x0, x1) -> + Ast_52.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_51.Outcometree.Otyp_record x0 -> + Ast_52.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_51.Outcometree.Otyp_stuff x0 -> Ast_52.Outcometree.Otyp_stuff x0 + | Ast_51.Outcometree.Otyp_sum x0 -> + Ast_52.Outcometree.Otyp_sum (List.map copy_out_constructor x0) + | Ast_51.Outcometree.Otyp_tuple x0 -> + Ast_52.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_51.Outcometree.Otyp_var (x0, x1) -> + Ast_52.Outcometree.Otyp_var (x0, x1) + | Ast_51.Outcometree.Otyp_variant (x0, x1, x2) -> + Ast_52.Outcometree.Otyp_variant + ((copy_out_variant x0), x1, + (Option.map (fun x -> List.map (fun x -> x) x) x2)) + | Ast_51.Outcometree.Otyp_poly (x0, x1) -> + Ast_52.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_51.Outcometree.Otyp_module (x0, x1) -> + Ast_52.Outcometree.Otyp_module + ((copy_out_ident x0), + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) + | Ast_51.Outcometree.Otyp_attribute (x0, x1) -> + Ast_52.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_51.Outcometree.out_attribute -> Ast_52.Outcometree.out_attribute = + fun { Ast_51.Outcometree.oattr_name = oattr_name } -> + { Ast_52.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_51.Outcometree.out_variant -> Ast_52.Outcometree.out_variant = + function + | Ast_51.Outcometree.Ovar_fields x0 -> + Ast_52.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_51.Outcometree.Ovar_typ x0 -> + Ast_52.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_constructor : + Ast_51.Outcometree.out_constructor -> Ast_52.Outcometree.out_constructor = + fun + { Ast_51.Outcometree.ocstr_name = ocstr_name; + Ast_51.Outcometree.ocstr_args = ocstr_args; + Ast_51.Outcometree.ocstr_return_type = ocstr_return_type } + -> + { + Ast_52.Outcometree.ocstr_name = ocstr_name; + Ast_52.Outcometree.ocstr_args = (List.map copy_out_type ocstr_args); + Ast_52.Outcometree.ocstr_return_type = + (Option.map copy_out_type ocstr_return_type) + } +and copy_out_value : + Ast_51.Outcometree.out_value -> Ast_52.Outcometree.out_value = + function + | Ast_51.Outcometree.Oval_array x0 -> + Ast_52.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_char x0 -> Ast_52.Outcometree.Oval_char x0 + | Ast_51.Outcometree.Oval_constr (x0, x1) -> + Ast_52.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_51.Outcometree.Oval_ellipsis -> Ast_52.Outcometree.Oval_ellipsis + | Ast_51.Outcometree.Oval_float x0 -> Ast_52.Outcometree.Oval_float x0 + | Ast_51.Outcometree.Oval_int x0 -> Ast_52.Outcometree.Oval_int x0 + | Ast_51.Outcometree.Oval_int32 x0 -> Ast_52.Outcometree.Oval_int32 x0 + | Ast_51.Outcometree.Oval_int64 x0 -> Ast_52.Outcometree.Oval_int64 x0 + | Ast_51.Outcometree.Oval_nativeint x0 -> + Ast_52.Outcometree.Oval_nativeint x0 + | Ast_51.Outcometree.Oval_list x0 -> + Ast_52.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_printer x0 -> Ast_52.Outcometree.Oval_printer x0 + | Ast_51.Outcometree.Oval_record x0 -> + Ast_52.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_51.Outcometree.Oval_string (x0, x1, x2) -> + Ast_52.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_51.Outcometree.Oval_stuff x0 -> Ast_52.Outcometree.Oval_stuff x0 + | Ast_51.Outcometree.Oval_tuple x0 -> + Ast_52.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_51.Outcometree.Oval_variant (x0, x1) -> + Ast_52.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) +and copy_out_string : + Ast_51.Outcometree.out_string -> Ast_52.Outcometree.out_string = + function + | Ast_51.Outcometree.Ostr_string -> Ast_52.Outcometree.Ostr_string + | Ast_51.Outcometree.Ostr_bytes -> Ast_52.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_51.Outcometree.out_ident -> Ast_52.Outcometree.out_ident = + function + | Ast_51.Outcometree.Oide_apply (x0, x1) -> + Ast_52.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_51.Outcometree.Oide_dot (x0, x1) -> + Ast_52.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_51.Outcometree.Oide_ident x0 -> + Ast_52.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_51.Outcometree.out_name -> Ast_52.Outcometree.out_name = + fun { Ast_51.Outcometree.printed_name = printed_name } -> + { Ast_52.Outcometree.printed_name = printed_name } diff --git a/src/vendored-omp/src/migrate_parsetree_52_51.ml b/src/vendored-omp/src/migrate_parsetree_52_51.ml new file mode 100644 index 000000000..bddc7cd3d --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_52_51.ml @@ -0,0 +1,2 @@ + +include Migrate_parsetree_52_51_migrate diff --git a/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml b/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml new file mode 100644 index 000000000..cce254369 --- /dev/null +++ b/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml @@ -0,0 +1,344 @@ +open Stdlib0 +module From = Ast_52 +module To = Ast_51 +let rec copy_out_type_extension : + Ast_52.Outcometree.out_type_extension -> + Ast_51.Outcometree.out_type_extension + = + fun + { Ast_52.Outcometree.otyext_name = otyext_name; + Ast_52.Outcometree.otyext_params = otyext_params; + Ast_52.Outcometree.otyext_constructors = otyext_constructors; + Ast_52.Outcometree.otyext_private = otyext_private } + -> + { + Ast_51.Outcometree.otyext_name = otyext_name; + Ast_51.Outcometree.otyext_params = + (List.map (fun x -> x) otyext_params); + Ast_51.Outcometree.otyext_constructors = + (List.map copy_out_constructor otyext_constructors); + Ast_51.Outcometree.otyext_private = (copy_private_flag otyext_private) + } +and copy_out_phrase : + Ast_52.Outcometree.out_phrase -> Ast_51.Outcometree.out_phrase = + function + | Ast_52.Outcometree.Ophr_eval (x0, x1) -> + Ast_51.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) + | Ast_52.Outcometree.Ophr_signature x0 -> + Ast_51.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_52.Outcometree.Ophr_exception x0 -> + Ast_51.Outcometree.Ophr_exception + (let (x0, x1) = x0 in (x0, (copy_out_value x1))) +and copy_out_sig_item : + Ast_52.Outcometree.out_sig_item -> Ast_51.Outcometree.out_sig_item = + function + | Ast_52.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> + Ast_51.Outcometree.Osig_class + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_52.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> + Ast_51.Outcometree.Osig_class_type + (x0, x1, (List.map copy_out_type_param x2), (copy_out_class_type x3), + (copy_out_rec_status x4)) + | Ast_52.Outcometree.Osig_typext (x0, x1) -> + Ast_51.Outcometree.Osig_typext + ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) + | Ast_52.Outcometree.Osig_modtype (x0, x1) -> + Ast_51.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) + | Ast_52.Outcometree.Osig_module (x0, x1, x2) -> + Ast_51.Outcometree.Osig_module + (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) + | Ast_52.Outcometree.Osig_type (x0, x1) -> + Ast_51.Outcometree.Osig_type + ((copy_out_type_decl x0), (copy_out_rec_status x1)) + | Ast_52.Outcometree.Osig_value x0 -> + Ast_51.Outcometree.Osig_value (copy_out_val_decl x0) + | Ast_52.Outcometree.Osig_ellipsis -> Ast_51.Outcometree.Osig_ellipsis +and copy_out_val_decl : + Ast_52.Outcometree.out_val_decl -> Ast_51.Outcometree.out_val_decl = + fun + { Ast_52.Outcometree.oval_name = oval_name; + Ast_52.Outcometree.oval_type = oval_type; + Ast_52.Outcometree.oval_prims = oval_prims; + Ast_52.Outcometree.oval_attributes = oval_attributes } + -> + { + Ast_51.Outcometree.oval_name = oval_name; + Ast_51.Outcometree.oval_type = (copy_out_type oval_type); + Ast_51.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); + Ast_51.Outcometree.oval_attributes = + (List.map copy_out_attribute oval_attributes) + } +and copy_out_type_decl : + Ast_52.Outcometree.out_type_decl -> Ast_51.Outcometree.out_type_decl = + fun + { Ast_52.Outcometree.otype_name = otype_name; + Ast_52.Outcometree.otype_params = otype_params; + Ast_52.Outcometree.otype_type = otype_type; + Ast_52.Outcometree.otype_private = otype_private; + Ast_52.Outcometree.otype_immediate = otype_immediate; + Ast_52.Outcometree.otype_unboxed = otype_unboxed; + Ast_52.Outcometree.otype_cstrs = otype_cstrs } + -> + { + Ast_51.Outcometree.otype_name = otype_name; + Ast_51.Outcometree.otype_params = + (List.map copy_out_type_param otype_params); + Ast_51.Outcometree.otype_type = (copy_out_type otype_type); + Ast_51.Outcometree.otype_private = (copy_private_flag otype_private); + Ast_51.Outcometree.otype_immediate = + (copy_Type_immediacy_t otype_immediate); + Ast_51.Outcometree.otype_unboxed = otype_unboxed; + Ast_51.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_52.Type_immediacy.t -> Ast_51.Type_immediacy.t = + function + | Ast_52.Type_immediacy.Unknown -> Ast_51.Type_immediacy.Unknown + | Ast_52.Type_immediacy.Always -> Ast_51.Type_immediacy.Always + | Ast_52.Type_immediacy.Always_on_64bits -> + Ast_51.Type_immediacy.Always_on_64bits +and copy_out_module_type : + Ast_52.Outcometree.out_module_type -> Ast_51.Outcometree.out_module_type = + function + | Ast_52.Outcometree.Omty_abstract -> Ast_51.Outcometree.Omty_abstract + | Ast_52.Outcometree.Omty_functor (x0, x1) -> + Ast_51.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_52.Outcometree.Omty_ident x0 -> + Ast_51.Outcometree.Omty_ident (copy_out_ident x0) + | Ast_52.Outcometree.Omty_signature x0 -> + Ast_51.Outcometree.Omty_signature (List.map copy_out_sig_item x0) + | Ast_52.Outcometree.Omty_alias x0 -> + Ast_51.Outcometree.Omty_alias (copy_out_ident x0) +and copy_out_ext_status : + Ast_52.Outcometree.out_ext_status -> Ast_51.Outcometree.out_ext_status = + function + | Ast_52.Outcometree.Oext_first -> Ast_51.Outcometree.Oext_first + | Ast_52.Outcometree.Oext_next -> Ast_51.Outcometree.Oext_next + | Ast_52.Outcometree.Oext_exception -> Ast_51.Outcometree.Oext_exception +and copy_out_extension_constructor : + Ast_52.Outcometree.out_extension_constructor -> + Ast_51.Outcometree.out_extension_constructor + = + fun + { Ast_52.Outcometree.oext_name = oext_name; + Ast_52.Outcometree.oext_type_name = oext_type_name; + Ast_52.Outcometree.oext_type_params = oext_type_params; + Ast_52.Outcometree.oext_args = oext_args; + Ast_52.Outcometree.oext_ret_type = oext_ret_type; + Ast_52.Outcometree.oext_private = oext_private } + -> + { + Ast_51.Outcometree.oext_name = oext_name; + Ast_51.Outcometree.oext_type_name = oext_type_name; + Ast_51.Outcometree.oext_type_params = + (List.map (fun x -> x) oext_type_params); + Ast_51.Outcometree.oext_args = (List.map copy_out_type oext_args); + Ast_51.Outcometree.oext_ret_type = + (Option.map copy_out_type oext_ret_type); + Ast_51.Outcometree.oext_private = (copy_private_flag oext_private) + } +and copy_private_flag : + Ast_52.Asttypes.private_flag -> Ast_51.Asttypes.private_flag = + function + | Ast_52.Asttypes.Private -> Ast_51.Asttypes.Private + | Ast_52.Asttypes.Public -> Ast_51.Asttypes.Public +and copy_out_rec_status : + Ast_52.Outcometree.out_rec_status -> Ast_51.Outcometree.out_rec_status = + function + | Ast_52.Outcometree.Orec_not -> Ast_51.Outcometree.Orec_not + | Ast_52.Outcometree.Orec_first -> Ast_51.Outcometree.Orec_first + | Ast_52.Outcometree.Orec_next -> Ast_51.Outcometree.Orec_next +and copy_out_class_type : + Ast_52.Outcometree.out_class_type -> Ast_51.Outcometree.out_class_type = + function + | Ast_52.Outcometree.Octy_constr (x0, x1) -> + Ast_51.Outcometree.Octy_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_52.Outcometree.Octy_arrow (x0, x1, x2) -> + Ast_51.Outcometree.Octy_arrow + ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_class_type x2)) + | Ast_52.Outcometree.Octy_signature (x0, x1) -> + Ast_51.Outcometree.Octy_signature + ((Option.map copy_out_type x0), + (List.map copy_out_class_sig_item x1)) +and copy_out_class_sig_item : + Ast_52.Outcometree.out_class_sig_item -> + Ast_51.Outcometree.out_class_sig_item + = + function + | Ast_52.Outcometree.Ocsg_constraint (x0, x1) -> + Ast_51.Outcometree.Ocsg_constraint + ((copy_out_type x0), (copy_out_type x1)) + | Ast_52.Outcometree.Ocsg_method (x0, x1, x2, x3) -> + Ast_51.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) + | Ast_52.Outcometree.Ocsg_value (x0, x1, x2, x3) -> + Ast_51.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) +and copy_out_type_param : + Ast_52.Outcometree.out_type_param -> Ast_51.Outcometree.out_type_param = + fun + { Ast_52.Outcometree.ot_non_gen = _; + Ast_52.Outcometree.ot_name = ot_name; + Ast_52.Outcometree.ot_variance = ot_variance } + -> + ot_name, + (let (x0, x1) = ot_variance in + ((copy_variance x0), (copy_injectivity x1))) +and copy_injectivity : + Ast_52.Asttypes.injectivity -> Ast_51.Asttypes.injectivity = + function + | Ast_52.Asttypes.Injective -> Ast_51.Asttypes.Injective + | Ast_52.Asttypes.NoInjectivity -> Ast_51.Asttypes.NoInjectivity +and copy_variance : Ast_52.Asttypes.variance -> Ast_51.Asttypes.variance = + function + | Ast_52.Asttypes.Covariant -> Ast_51.Asttypes.Covariant + | Ast_52.Asttypes.Contravariant -> Ast_51.Asttypes.Contravariant + | Ast_52.Asttypes.NoVariance -> Ast_51.Asttypes.NoVariance +and copy_out_type : + Ast_52.Outcometree.out_type -> Ast_51.Outcometree.out_type = + function + | Ast_52.Outcometree.Otyp_abstract -> Ast_51.Outcometree.Otyp_abstract + | Ast_52.Outcometree.Otyp_open -> Ast_51.Outcometree.Otyp_open + | Ast_52.Outcometree.Otyp_alias {non_gen; aliased=x0; alias=x1} -> + Ast_51.Outcometree.Otyp_alias {non_gen; aliased=(copy_out_type x0); alias=x1} + | Ast_52.Outcometree.Otyp_arrow (x0, x1, x2) -> + Ast_51.Outcometree.Otyp_arrow + ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_type x2)) + | Ast_52.Outcometree.Otyp_class (x0, x1) -> + Ast_51.Outcometree.Otyp_class + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_52.Outcometree.Otyp_constr (x0, x1) -> + Ast_51.Outcometree.Otyp_constr + ((copy_out_ident x0), (List.map copy_out_type x1)) + | Ast_52.Outcometree.Otyp_manifest (x0, x1) -> + Ast_51.Outcometree.Otyp_manifest + ((copy_out_type x0), (copy_out_type x1)) + | Ast_52.Outcometree.Otyp_object {fields=x0; open_row=x1} -> + Ast_51.Outcometree.Otyp_object + { fields = (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0); + open_row = x1 } + | Ast_52.Outcometree.Otyp_record x0 -> + Ast_51.Outcometree.Otyp_record + (List.map + (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) + | Ast_52.Outcometree.Otyp_stuff x0 -> Ast_51.Outcometree.Otyp_stuff x0 + | Ast_52.Outcometree.Otyp_sum x0 -> + Ast_51.Outcometree.Otyp_sum (List.map copy_out_constructor x0) + | Ast_52.Outcometree.Otyp_tuple x0 -> + Ast_51.Outcometree.Otyp_tuple (List.map copy_out_type x0) + | Ast_52.Outcometree.Otyp_var (x0, x1) -> + Ast_51.Outcometree.Otyp_var (x0, x1) + | Ast_52.Outcometree.Otyp_variant (x0, x1, x2) -> + Ast_51.Outcometree.Otyp_variant + ((copy_out_variant x0), x1, + (Option.map (fun x -> List.map (fun x -> x) x) x2)) + | Ast_52.Outcometree.Otyp_poly (x0, x1) -> + Ast_51.Outcometree.Otyp_poly + ((List.map (fun x -> x) x0), (copy_out_type x1)) + | Ast_52.Outcometree.Otyp_module (x0, x1) -> + Ast_51.Outcometree.Otyp_module + ((copy_out_ident x0), + (List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) + x1)) + | Ast_52.Outcometree.Otyp_attribute (x0, x1) -> + Ast_51.Outcometree.Otyp_attribute + ((copy_out_type x0), (copy_out_attribute x1)) +and copy_out_attribute : + Ast_52.Outcometree.out_attribute -> Ast_51.Outcometree.out_attribute = + fun { Ast_52.Outcometree.oattr_name = oattr_name } -> + { Ast_51.Outcometree.oattr_name = oattr_name } +and copy_out_variant : + Ast_52.Outcometree.out_variant -> Ast_51.Outcometree.out_variant = + function + | Ast_52.Outcometree.Ovar_fields x0 -> + Ast_51.Outcometree.Ovar_fields + (List.map + (fun x -> + let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) + x0) + | Ast_52.Outcometree.Ovar_typ x0 -> + Ast_51.Outcometree.Ovar_typ (copy_out_type x0) +and copy_out_constructor : + Ast_52.Outcometree.out_constructor -> Ast_51.Outcometree.out_constructor = + fun + { Ast_52.Outcometree.ocstr_name = ocstr_name; + Ast_52.Outcometree.ocstr_args = ocstr_args; + Ast_52.Outcometree.ocstr_return_type = ocstr_return_type } + -> + { + Ast_51.Outcometree.ocstr_name = ocstr_name; + Ast_51.Outcometree.ocstr_args = (List.map copy_out_type ocstr_args); + Ast_51.Outcometree.ocstr_return_type = + (Option.map copy_out_type ocstr_return_type) + } +and copy_arg_label : Ast_52.Asttypes.arg_label -> Ast_51.Asttypes.arg_label = + function + | Ast_52.Asttypes.Nolabel -> Ast_51.Asttypes.Nolabel + | Ast_52.Asttypes.Labelled x0 -> Ast_51.Asttypes.Labelled x0 + | Ast_52.Asttypes.Optional x0 -> Ast_51.Asttypes.Optional x0 +and copy_out_value : + Ast_52.Outcometree.out_value -> Ast_51.Outcometree.out_value = + function + | Ast_52.Outcometree.Oval_array x0 -> + Ast_51.Outcometree.Oval_array (List.map copy_out_value x0) + | Ast_52.Outcometree.Oval_char x0 -> Ast_51.Outcometree.Oval_char x0 + | Ast_52.Outcometree.Oval_constr (x0, x1) -> + Ast_51.Outcometree.Oval_constr + ((copy_out_ident x0), (List.map copy_out_value x1)) + | Ast_52.Outcometree.Oval_ellipsis -> Ast_51.Outcometree.Oval_ellipsis + | Ast_52.Outcometree.Oval_float x0 -> Ast_51.Outcometree.Oval_float x0 + | Ast_52.Outcometree.Oval_int x0 -> Ast_51.Outcometree.Oval_int x0 + | Ast_52.Outcometree.Oval_int32 x0 -> Ast_51.Outcometree.Oval_int32 x0 + | Ast_52.Outcometree.Oval_int64 x0 -> Ast_51.Outcometree.Oval_int64 x0 + | Ast_52.Outcometree.Oval_nativeint x0 -> + Ast_51.Outcometree.Oval_nativeint x0 + | Ast_52.Outcometree.Oval_list x0 -> + Ast_51.Outcometree.Oval_list (List.map copy_out_value x0) + | Ast_52.Outcometree.Oval_printer x0 -> Ast_51.Outcometree.Oval_printer x0 + | Ast_52.Outcometree.Oval_record x0 -> + Ast_51.Outcometree.Oval_record + (List.map + (fun x -> + let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) + x0) + | Ast_52.Outcometree.Oval_string (x0, x1, x2) -> + Ast_51.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) + | Ast_52.Outcometree.Oval_stuff x0 -> Ast_51.Outcometree.Oval_stuff x0 + | Ast_52.Outcometree.Oval_tuple x0 -> + Ast_51.Outcometree.Oval_tuple (List.map copy_out_value x0) + | Ast_52.Outcometree.Oval_variant (x0, x1) -> + Ast_51.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) + | Ast_52.Outcometree.Oval_lazy x0 -> + Ast_51.Outcometree.Oval_constr (Oide_ident { printed_name = "lazy"}, [copy_out_value x0]) +and copy_out_string : + Ast_52.Outcometree.out_string -> Ast_51.Outcometree.out_string = + function + | Ast_52.Outcometree.Ostr_string -> Ast_51.Outcometree.Ostr_string + | Ast_52.Outcometree.Ostr_bytes -> Ast_51.Outcometree.Ostr_bytes +and copy_out_ident : + Ast_52.Outcometree.out_ident -> Ast_51.Outcometree.out_ident = + function + | Ast_52.Outcometree.Oide_apply (x0, x1) -> + Ast_51.Outcometree.Oide_apply + ((copy_out_ident x0), (copy_out_ident x1)) + | Ast_52.Outcometree.Oide_dot (x0, x1) -> + Ast_51.Outcometree.Oide_dot ((copy_out_ident x0), x1) + | Ast_52.Outcometree.Oide_ident x0 -> + Ast_51.Outcometree.Oide_ident (copy_out_name x0) +and copy_out_name : + Ast_52.Outcometree.out_name -> Ast_51.Outcometree.out_name = + fun { Ast_52.Outcometree.printed_name = printed_name } -> + { Ast_51.Outcometree.printed_name = printed_name } diff --git a/src/vendored-omp/src/migrate_parsetree_versions.ml b/src/vendored-omp/src/migrate_parsetree_versions.ml index 45f42e9ce..bde5b6506 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.ml +++ b/src/vendored-omp/src/migrate_parsetree_versions.ml @@ -500,6 +500,13 @@ module OCaml_51 = struct let string_version = "5.1" end let ocaml_51 : OCaml_51.types ocaml_version = (module OCaml_51) +module OCaml_52 = struct + module Ast = Ast_52 + include Make_witness(Ast_52) + let version = 520 + let string_version = "5.2" +end +let ocaml_52 : OCaml_52.types ocaml_version = (module OCaml_52) (*$*) let all_versions : (module OCaml_version) list = [ @@ -520,6 +527,7 @@ let all_versions : (module OCaml_version) list = [ (module OCaml_414 : OCaml_version); (module OCaml_500 : OCaml_version); (module OCaml_51 : OCaml_version); + (module OCaml_52 : OCaml_version); (*$*) ] @@ -556,6 +564,8 @@ include Register_migration(OCaml_414)(OCaml_500) (Migrate_parsetree_414_500)(Migrate_parsetree_500_414) include Register_migration(OCaml_500)(OCaml_51) (Migrate_parsetree_500_51)(Migrate_parsetree_51_500) +include Register_migration(OCaml_51)(OCaml_52) + (Migrate_parsetree_51_52)(Migrate_parsetree_52_51) (*$*) module OCaml_current = OCaml_OCAML_VERSION diff --git a/src/vendored-omp/src/migrate_parsetree_versions.mli b/src/vendored-omp/src/migrate_parsetree_versions.mli index 5b4e4c156..679e630fe 100644 --- a/src/vendored-omp/src/migrate_parsetree_versions.mli +++ b/src/vendored-omp/src/migrate_parsetree_versions.mli @@ -163,6 +163,8 @@ module OCaml_500 : OCaml_version with module Ast = Ast_500 val ocaml_500 : OCaml_500.types ocaml_version module OCaml_51 : OCaml_version with module Ast = Ast_51 val ocaml_51 : OCaml_51.types ocaml_version +module OCaml_52 : OCaml_version with module Ast = Ast_52 +val ocaml_52 : OCaml_52.types ocaml_version (*$*) (* An alias to the current compiler version *) diff --git a/src/vendored-omp/src/reason_omp.ml b/src/vendored-omp/src/reason_omp.ml index 53df0c218..e3275aabc 100644 --- a/src/vendored-omp/src/reason_omp.ml +++ b/src/vendored-omp/src/reason_omp.ml @@ -39,6 +39,7 @@ module Ast_413 = Ast_413 module Ast_414 = Ast_414 module Ast_500 = Ast_500 module Ast_51 = Ast_51 +module Ast_52 = Ast_52 (*$*) (* Manual migration between versions *) @@ -74,6 +75,8 @@ module Migrate_414_500 = Migrate_parsetree_414_500 module Migrate_500_414 = Migrate_parsetree_500_414 module Migrate_500_51 = Migrate_parsetree_500_51 module Migrate_51_500 = Migrate_parsetree_51_500 +module Migrate_51_52 = Migrate_parsetree_51_52 +module Migrate_52_51 = Migrate_parsetree_52_51 (*$*) (* An abstraction of OCaml compiler versions *) diff --git a/test/lib/outcometreePrinter.cppo.ml b/test/lib/outcometreePrinter.cppo.ml index 233c2deb4..4d7c7ed7b 100644 --- a/test/lib/outcometreePrinter.cppo.ml +++ b/test/lib/outcometreePrinter.cppo.ml @@ -46,7 +46,14 @@ let main () = #else let (typedtree, _) = #endif - Typemod.type_implementation modulename modulename modulename env ast in + Typemod.type_implementation +#if OCAML_VERSION >= (5,2,0) + (Unit_info.make ~source_file:modulename modulename) +#else + modulename modulename modulename +#endif + env ast + in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in let phrase = (Ast.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) From 3930092ac1cc04b7f3c62c71956592cf158ef8bb Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 25 Feb 2024 14:07:27 -0800 Subject: [PATCH 18/64] prep 3.11 release (#2735) --- CHANGES.md | 2 +- flake.lock | 26 +++++++++++++------------- nix/shell.nix | 8 ++------ 3 files changed, 16 insertions(+), 20 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 19e49c883..d66d84a4a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## Unreleased +## 3.11.0 - Print structure items extension nodes correctly inside modules (@anmonteiro, [#2723](https://github.com/reasonml/reason/pull/2723)) diff --git a/flake.lock b/flake.lock index 1f84b9ff7..ff9502fa0 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1694529238, - "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", + "lastModified": 1705309234, + "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", "owner": "numtide", "repo": "flake-utils", - "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", + "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1694857738, - "narHash": "sha256-bxxNyLHjhu0N8T3REINXQ2ZkJco0ABFPn6PIe2QUfqo=", + "lastModified": 1705332318, + "narHash": "sha256-kcw1yFeJe9N4PjQji9ZeX47jg0p9A0DuU4djKvg1a7I=", "owner": "numtide", "repo": "nix-filter", - "rev": "41fd48e00c22b4ced525af521ead8792402de0ea", + "rev": "3449dc925982ad46246cfc36469baf66e1b64f17", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1696357929, - "narHash": "sha256-FJ8SgB4rgAXD1qjplpWAr14mudSSnOrShjbuhC9w2M0=", + "lastModified": 1708894150, + "narHash": "sha256-amV4DC5QFAT+e3JaixEz8bHtMPkGJhzvyGPXzWF4hCM=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "6fe39115c01d42e452f837ed38ae7a244a78f699", + "rev": "d13d05740e729e02dc5da17814caac57387fb3af", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1696303624, - "narHash": "sha256-mL5k0klTRO3/59HCI8U1QujzGsnyL0GtQI+5XABXDNA=", + "lastModified": 1708494689, + "narHash": "sha256-7AVzwWeIC2rG6CdqRbbu3ON8EP5of6q5fGyg8MvbXmg=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "4d29250d5b55fe14280906afad7afacd910850b8", + "rev": "79597053bebcbccd1991157c3292c3705307220c", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "4d29250d5b55fe14280906afad7afacd910850b8", + "rev": "79597053bebcbccd1991157c3292c3705307220c", "type": "github" } }, diff --git a/nix/shell.nix b/nix/shell.nix index 0bb704648..613f20524 100644 --- a/nix/shell.nix +++ b/nix/shell.nix @@ -11,14 +11,10 @@ mkShell { inputsFrom = [ reason ]; - buildInputs = with ocamlPackages; [ - utop - merlin - ] - ++ (if release-mode then [ + buildInputs = with ocamlPackages; [ utop merlin ] ++ (if release-mode then [ cacert curl - ocamlPackages.dune-release + dune-release git ] else [ ]) ; From b75b08c99f21704d85b934df5f8cd371c2282cac Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 22 Jun 2024 20:18:11 -0700 Subject: [PATCH 19/64] update nix flakes/files --- flake.lock | 26 +++++++++++++------------- flake.nix | 14 ++++++++------ nix/default.nix | 22 +++++++++++----------- 3 files changed, 32 insertions(+), 30 deletions(-) diff --git a/flake.lock b/flake.lock index ff9502fa0..2247a4a29 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1705309234, - "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", + "lastModified": 1710146030, + "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", "owner": "numtide", "repo": "flake-utils", - "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", + "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", "type": "github" }, "original": { @@ -20,11 +20,11 @@ }, "nix-filter": { "locked": { - "lastModified": 1705332318, - "narHash": "sha256-kcw1yFeJe9N4PjQji9ZeX47jg0p9A0DuU4djKvg1a7I=", + "lastModified": 1710156097, + "narHash": "sha256-1Wvk8UP7PXdf8bCCaEoMnOT1qe5/Duqgj+rL8sRQsSM=", "owner": "numtide", "repo": "nix-filter", - "rev": "3449dc925982ad46246cfc36469baf66e1b64f17", + "rev": "3342559a24e85fc164b295c3444e8a139924675b", "type": "github" }, "original": { @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1708894150, - "narHash": "sha256-amV4DC5QFAT+e3JaixEz8bHtMPkGJhzvyGPXzWF4hCM=", + "lastModified": 1719112266, + "narHash": "sha256-Q44wAz9e1lcRC+znQ8jTSAL2GlVKJoagCUC0GcOECEQ=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "d13d05740e729e02dc5da17814caac57387fb3af", + "rev": "ad7cca561d85291a7f994c57017256ee4ef99e7b", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1708494689, - "narHash": "sha256-7AVzwWeIC2rG6CdqRbbu3ON8EP5of6q5fGyg8MvbXmg=", + "lastModified": 1719082008, + "narHash": "sha256-jHJSUH619zBQ6WdC21fFAlDxHErKVDJ5fpN0Hgx4sjs=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "79597053bebcbccd1991157c3292c3705307220c", + "rev": "9693852a2070b398ee123a329e68f0dab5526681", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "79597053bebcbccd1991157c3292c3705307220c", + "rev": "9693852a2070b398ee123a329e68f0dab5526681", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 7885e8eab..2056c8d3f 100644 --- a/flake.nix +++ b/flake.nix @@ -3,26 +3,28 @@ inputs.nix-filter.url = "github:numtide/nix-filter"; inputs.flake-utils.url = "github:numtide/flake-utils"; - inputs.nixpkgs.url = "github:nix-ocaml/nix-overlays"; - inputs.nixpkgs.inputs.flake-utils.follows = "flake-utils"; + inputs.nixpkgs = { + url = "github:nix-ocaml/nix-overlays"; + inputs.flake-utils.follows = "flake-utils"; + }; outputs = { self, nixpkgs, flake-utils, nix-filter }: flake-utils.lib.eachDefaultSystem (system: let pkgs = nixpkgs.legacyPackages."${system}".extend (self: super: { - ocamlPackages = super.ocaml-ng.ocamlPackages_5_1; + ocamlPackages = super.ocaml-ng.ocamlPackages_5_2; }); in - rec { + { packages.default = pkgs.callPackage ./nix { nix-filter = nix-filter.lib; }; devShells = { default = pkgs.callPackage ./nix/shell.nix { - reason = packages.default; + reason = self.packages.${system}.default; }; release = pkgs.callPackage ./nix/shell.nix { - reason = packages.default; + reason = self.packages.${system}.default; release-mode = true; }; }; diff --git a/nix/default.nix b/nix/default.nix index bb502f9dd..44637b92c 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -1,9 +1,4 @@ -{ pkgs, nix-filter }: - -let - inherit (pkgs) stdenv lib ocamlPackages; - -in +{ ocamlPackages, nix-filter }: ocamlPackages.buildDunePackage { pname = "reason"; @@ -11,17 +6,22 @@ ocamlPackages.buildDunePackage { src = nix-filter.filter { root = ./..; - include = [ "dune" "dune-project" "reason.opam" "rtop.opam" "scripts" "src" "test" ]; + include = [ + "dune" + "dune-project" + "reason.opam" + "rtop.opam" + "scripts" + "src" + "test" + ]; }; - useDune2 = true; - + nativeBuildInputs = with ocamlPackages; [ cppo menhir ]; propagatedBuildInputs = with ocamlPackages; [ merlin-extend - menhir menhirSdk menhirLib - cppo fix ppx_derivers ppxlib From d8a868c633badf056c26f6f1c030772d80238bf2 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 22 Jun 2024 21:54:26 -0700 Subject: [PATCH 20/64] fix: macOS CI (#2739) * fix: macOS CI * lock esy? * wip * macos-13 for esy --- .github/workflows/esy-ci.yml | 2 +- .github/workflows/opam-ci.yml | 6 +- esy.json | 9 +- esy.lock/index.json | 1196 +++++++++-------- esy.lock/opam/astring.0.8.5/opam | 7 +- .../opam | 11 +- .../{cmdliner.1.2.0 => cmdliner.1.3.0}/opam | 4 +- esy.lock/opam/crunch.3.3.1/opam | 53 + .../opam/{csexp.1.5.1 => csexp.1.5.2}/opam | 16 +- .../opam | 11 +- .../opam | 11 +- .../opam/{dune.3.7.1 => dune.3.16.0}/opam | 19 +- esy.lock/opam/fiber.3.6.2/opam | 41 - esy.lock/opam/fiber.3.7.0/opam | 39 + .../opam/{fix.20220121 => fix.20230505}/opam | 6 +- esy.lock/opam/fpath.0.7.3/opam | 7 +- .../opam | 9 +- esy.lock/opam/logs.0.7.0/opam | 7 +- esy.lock/opam/{lwt.5.6.1 => lwt.5.7.0}/opam | 6 +- .../{menhir.20230415 => menhir.20231231}/opam | 7 +- esy.lock/opam/menhirCST.20231231/opam | 29 + .../opam | 6 +- .../opam | 6 +- esy.lock/opam/mew.0.1.0/opam | 5 +- esy.lock/opam/mew_vi.0.5.0/opam | 5 +- .../opam/ocaml-compiler-libs.v0.12.4/opam | 2 +- .../opam | 33 +- ...en-installing-with-a-system-compiler.patch | 26 - .../{ocamlfind.1.9.5 => ocamlfind.1.9.6}/opam | 22 +- .../opam | 22 +- esy.lock/opam/octavius.1.2.2/opam | 5 +- esy.lock/opam/odoc-parser.2.0.0/opam | 47 - esy.lock/opam/odoc-parser.2.4.2/opam | 45 + esy.lock/opam/odoc.2.2.0/opam | 61 - esy.lock/opam/odoc.2.4.2/opam | 84 ++ esy.lock/opam/omd.1.3.2/opam | 2 +- esy.lock/opam/{pp.1.1.2 => pp.1.2.0}/opam | 13 +- esy.lock/opam/ppx_derivers.1.2.1/opam | 5 +- .../opam | 6 +- .../{ppxlib.0.29.1 => ppxlib.0.32.1}/opam | 22 +- esy.lock/opam/ptime.1.1.0/opam | 41 + esy.lock/opam/{re.1.10.4 => re.1.11.0}/opam | 10 +- esy.lock/opam/result.1.5/opam | 5 +- esy.lock/opam/seq.base/files/META.seq | 4 - esy.lock/opam/seq.base/files/seq.install | 3 - esy.lock/opam/seq.base/opam | 20 +- .../opam | 13 +- esy.lock/opam/trie.1.0.0/opam | 5 +- .../opam/{tyxml.4.5.0 => tyxml.4.6.0}/opam | 15 +- esy.lock/opam/uchar.0.0.2/opam | 5 +- esy.lock/opam/utop.2.12.0/opam | 43 - esy.lock/opam/utop.2.14.0/opam | 50 + .../opam/{uucp.15.0.0 => uucp.15.1.0}/opam | 24 +- .../opam/{uuseg.15.0.0 => uuseg.15.1.0}/opam | 20 +- esy.lock/opam/{xdg.3.7.1 => xdg.3.16.0}/opam | 11 +- .../opam/{yojson.2.0.2 => yojson.2.2.1}/opam | 57 +- esy.lock/opam/{zed.3.2.1 => zed.3.2.3}/opam | 10 +- .../files/darwin.patch | 26 + .../package.json | 27 + .../files/winpatch.patch | 0 .../package.json | 0 .../files/findlib.patch | 485 ------- .../files/findlib.patch | 11 + .../package.json | 0 .../package.json | 3 + 65 files changed, 1341 insertions(+), 1460 deletions(-) rename esy.lock/opam/{chrome-trace.3.7.1 => chrome-trace.3.16.0}/opam (66%) rename esy.lock/opam/{cmdliner.1.2.0 => cmdliner.1.3.0}/opam (90%) create mode 100644 esy.lock/opam/crunch.3.3.1/opam rename esy.lock/opam/{csexp.1.5.1 => csexp.1.5.2}/opam (70%) rename esy.lock/opam/{dune-build-info.3.7.1 => dune-build-info.3.16.0}/opam (73%) rename esy.lock/opam/{dune-configurator.3.7.1 => dune-configurator.3.16.0}/opam (73%) rename esy.lock/opam/{dune.3.7.1 => dune.3.16.0}/opam (69%) delete mode 100644 esy.lock/opam/fiber.3.6.2/opam create mode 100644 esy.lock/opam/fiber.3.7.0/opam rename esy.lock/opam/{fix.20220121 => fix.20230505}/opam (67%) rename esy.lock/opam/{lambda-term.3.3.1 => lambda-term.3.3.2}/opam (74%) rename esy.lock/opam/{lwt.5.6.1 => lwt.5.7.0}/opam (83%) rename esy.lock/opam/{menhir.20230415 => menhir.20231231}/opam (69%) create mode 100644 esy.lock/opam/menhirCST.20231231/opam rename esy.lock/opam/{menhirLib.20230415 => menhirLib.20231231}/opam (73%) rename esy.lock/opam/{menhirSdk.20230415 => menhirSdk.20231231}/opam (73%) rename esy.lock/opam/{ocamlbuild.0.14.2 => ocamlbuild.0.14.3+win}/opam (50%) delete mode 100644 esy.lock/opam/ocamlfind.1.9.5/files/0001-Fix-bug-when-installing-with-a-system-compiler.patch rename esy.lock/opam/{ocamlfind.1.9.5 => ocamlfind.1.9.6}/opam (61%) rename esy.lock/opam/{ocamlformat-rpc-lib.0.25.1 => ocamlformat-rpc-lib.0.26.2}/opam (54%) delete mode 100644 esy.lock/opam/odoc-parser.2.0.0/opam create mode 100644 esy.lock/opam/odoc-parser.2.4.2/opam delete mode 100644 esy.lock/opam/odoc.2.2.0/opam create mode 100644 esy.lock/opam/odoc.2.4.2/opam rename esy.lock/opam/{pp.1.1.2 => pp.1.2.0}/opam (76%) rename esy.lock/opam/{ppx_yojson_conv_lib.v0.15.0 => ppx_yojson_conv_lib.v0.16.0}/opam (75%) rename esy.lock/opam/{ppxlib.0.29.1 => ppxlib.0.32.1}/opam (65%) create mode 100644 esy.lock/opam/ptime.1.1.0/opam rename esy.lock/opam/{re.1.10.4 => re.1.11.0}/opam (69%) delete mode 100644 esy.lock/opam/seq.base/files/META.seq delete mode 100644 esy.lock/opam/seq.base/files/seq.install rename esy.lock/opam/{sexplib0.v0.15.1 => sexplib0.v0.17.0}/opam (65%) rename esy.lock/opam/{tyxml.4.5.0 => tyxml.4.6.0}/opam (72%) delete mode 100644 esy.lock/opam/utop.2.12.0/opam create mode 100644 esy.lock/opam/utop.2.14.0/opam rename esy.lock/opam/{uucp.15.0.0 => uucp.15.1.0}/opam (61%) rename esy.lock/opam/{uuseg.15.0.0 => uuseg.15.1.0}/opam (64%) rename esy.lock/opam/{xdg.3.7.1 => xdg.3.16.0}/opam (66%) rename esy.lock/opam/{yojson.2.0.2 => yojson.2.2.1}/opam (55%) rename esy.lock/opam/{zed.3.2.1 => zed.3.2.3}/opam (73%) create mode 100644 esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/files/darwin.patch create mode 100644 esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/package.json rename esy.lock/overrides/{opam__s__ocamlbuild_opam__c__0.14.2_opam_override => opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override}/files/winpatch.patch (100%) rename esy.lock/overrides/{opam__s__ocamlbuild_opam__c__0.14.2_opam_override => opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override}/package.json (100%) delete mode 100644 esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/files/findlib.patch create mode 100644 esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch rename esy.lock/overrides/{opam__s__ocamlfind_opam__c__1.9.5_opam_override => opam__s__ocamlfind_opam__c__1.9.6_opam_override}/package.json (100%) create mode 100644 esy.lock/overrides/opam__s__ptime_opam__c__1.1.0_opam_override/package.json diff --git a/.github/workflows/esy-ci.yml b/.github/workflows/esy-ci.yml index 74161d7bd..03e6eba4a 100644 --- a/.github/workflows/esy-ci.yml +++ b/.github/workflows/esy-ci.yml @@ -22,7 +22,7 @@ jobs: matrix: os: - ubuntu-latest - - macos-latest + - macos-13 - windows-latest ocaml-compiler: diff --git a/.github/workflows/opam-ci.yml b/.github/workflows/opam-ci.yml index 9f3da004c..719d3e0ae 100644 --- a/.github/workflows/opam-ci.yml +++ b/.github/workflows/opam-ci.yml @@ -18,7 +18,7 @@ jobs: matrix: os: - ubuntu-latest - - macos-latest + - macos-13 - windows-latest ocaml-compiler: @@ -33,7 +33,7 @@ jobs: steps: - name: Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Use OCaml ${{ matrix.ocaml-compiler }} uses: ocaml/setup-ocaml@v2 @@ -48,7 +48,7 @@ jobs: with: path: ~/.opam key: opam-${{ matrix.os }}-${{ matrix.ocaml-compiler }}-${{ hashFiles('**.opam') }} - + - name: Load opam cache when Windows if: runner.os == 'Windows' id: opam-cache-windows diff --git a/esy.json b/esy.json index 50fb41c02..81ab5e279 100644 --- a/esy.json +++ b/esy.json @@ -1,7 +1,6 @@ { "name": "reason-cli", - "notes": - "This is just the dev package config (also built as globally installable reason-cli). See ./refmt.json ./rtop.json for individual release package configs.", + "notes": "This is just the dev package config (also built as globally installable reason-cli). See ./refmt.json ./rtop.json for individual release package configs.", "license": "MIT", "version": "3.8.2", "dependencies": { @@ -9,9 +8,9 @@ "@opam/dune-build-info": "> 3.0.0", "@opam/fix": "*", "@opam/menhir": " >= 20180523.0.0", - "@opam/merlin-extend": " >= 0.6", - "@opam/ocamlfind": "1.9.5", - "@opam/ppx_derivers": "< 2.0.0", + "@opam/merlin-extend": " >= 0.6.1", + "@opam/ocamlfind": "*", + "@opam/ppx_derivers": "*", "@opam/ppxlib": "> 0.28.x", "@opam/utop": " >= 1.17.0", "ocaml": " >= 4.3.0 < 4.15.0" diff --git a/esy.lock/index.json b/esy.lock/index.json index e16b24647..a3cc2f4c8 100644 --- a/esy.lock/index.json +++ b/esy.lock/index.json @@ -1,5 +1,5 @@ { - "checksum": "c3c0ec4dc1dab9c4069b9ff27b904076", + "checksum": "5fc22f3e9fff961bc82c2d59fdfbdd0d", "root": "reason-cli@link-dev:./esy.json", "node": { "reason-cli@link-dev:./esy.json": { @@ -9,117 +9,116 @@ "source": { "type": "link-dev", "path": ".", "manifest": "esy.json" }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/utop@opam:2.12.0@41cf0331", - "@opam/ppxlib@opam:0.29.1@8414c948", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocamlfind@opam:1.9.5@e83abf74", + "ocaml@4.14.1000@d41d8cd9", "@opam/utop@opam:2.14.0@5f65a713", + "@opam/ppxlib@opam:0.32.1@9897cafd", + "@opam/ppx_derivers@opam:1.2.1@d78727cd", + "@opam/ocamlfind@opam:1.9.6@923e2274", "@opam/merlin-extend@opam:0.6.1@7d979feb", - "@opam/menhir@opam:20230415@ce1c9ac7", - "@opam/fix@opam:20220121@17b9a1a4", - "@opam/dune-build-info@opam:3.7.1@adf0d411", - "@opam/dune@opam:3.7.1@40db2f22" + "@opam/menhir@opam:20231231@f35eae6a", + "@opam/fix@opam:20230505@941a65ff", + "@opam/dune-build-info@opam:3.16.0@5123b882", + "@opam/dune@opam:3.16.0@33c4c9fe" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/odoc@opam:2.2.0@020767ad", + "ocaml@4.14.1000@d41d8cd9", "@opam/odoc@opam:2.4.2@12b68179", "@opam/ocaml-lsp-server@opam:1.15.1-4.14@76510e53" ] }, - "ocaml@4.14.0@d41d8cd9": { - "id": "ocaml@4.14.0@d41d8cd9", + "ocaml@4.14.1000@d41d8cd9": { + "id": "ocaml@4.14.1000@d41d8cd9", "name": "ocaml", - "version": "4.14.0", + "version": "4.14.1000", "source": { "type": "install", "source": [ - "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.14.0.tgz#sha1:619afaeabcc8732cc1f4014a7251403927f44021" + "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.14.1000.tgz#sha1:e38fabe6bcf42774bd2340e67a8803ee7cebdb9f" ] }, "overrides": [], "dependencies": [], "devDependencies": [] }, - "@opam/zed@opam:3.2.1@276736c0": { - "id": "@opam/zed@opam:3.2.1@276736c0", + "@opam/zed@opam:3.2.3@57ab913c": { + "id": "@opam/zed@opam:3.2.3@57ab913c", "name": "@opam/zed", - "version": "opam:3.2.1", + "version": "opam:3.2.3", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/14/141091d21a03e92eed0efd96ece150c08c619bfbcd1b153a42d8a261b2b57f53#sha256:141091d21a03e92eed0efd96ece150c08c619bfbcd1b153a42d8a261b2b57f53", - "archive:https://github.com/ocaml-community/zed/releases/download/3.2.1/zed-3.2.1.tbz#sha256:141091d21a03e92eed0efd96ece150c08c619bfbcd1b153a42d8a261b2b57f53" + "archive:https://opam.ocaml.org/cache/sha512/63/637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b#sha512:637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b", + "archive:https://github.com/ocaml-community/zed/archive/refs/tags/3.2.3.tar.gz#sha512:637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b" ], "opam": { "name": "zed", - "version": "3.2.1", - "path": "esy.lock/opam/zed.3.2.1" + "version": "3.2.3", + "path": "esy.lock/opam/zed.3.2.3" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/uuseg@opam:15.0.0@14085231", - "@opam/uucp@opam:15.0.0@55460339", "@opam/uchar@opam:0.0.2@aedf91f9", - "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uuseg@opam:15.1.0@af4a84a3", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/uchar@opam:0.0.2@3e1919ed", + "@opam/result@opam:1.5@5a755845", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/uuseg@opam:15.0.0@14085231", - "@opam/uucp@opam:15.0.0@55460339", "@opam/uchar@opam:0.0.2@aedf91f9", - "@opam/result@opam:1.5@1c6a6533", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uuseg@opam:15.1.0@af4a84a3", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/uchar@opam:0.0.2@3e1919ed", + "@opam/result@opam:1.5@5a755845", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/yojson@opam:2.0.2@eb65f292": { - "id": "@opam/yojson@opam:2.0.2@eb65f292", + "@opam/yojson@opam:2.2.1@3eedaf6a": { + "id": "@opam/yojson@opam:2.2.1@3eedaf6a", "name": "@opam/yojson", - "version": "opam:2.0.2", + "version": "opam:2.2.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/87/876bb6f38af73a84a29438a3da35e4857c60a14556a606525b148c6fdbe5461b#sha256:876bb6f38af73a84a29438a3da35e4857c60a14556a606525b148c6fdbe5461b", - "archive:https://github.com/ocaml-community/yojson/releases/download/2.0.2/yojson-2.0.2.tbz#sha256:876bb6f38af73a84a29438a3da35e4857c60a14556a606525b148c6fdbe5461b" + "archive:https://opam.ocaml.org/cache/sha256/cd/cd3c1d94f695899a026dff72696989bdb10dc1632934bb9cbe6f4598d4afa6d4#sha256:cd3c1d94f695899a026dff72696989bdb10dc1632934bb9cbe6f4598d4afa6d4", + "archive:https://github.com/ocaml-community/yojson/releases/download/2.2.1/yojson-2.2.1.tbz#sha256:cd3c1d94f695899a026dff72696989bdb10dc1632934bb9cbe6f4598d4afa6d4" ], "opam": { "name": "yojson", - "version": "2.0.2", - "path": "esy.lock/opam/yojson.2.0.2" + "version": "2.2.1", + "path": "esy.lock/opam/yojson.2.2.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", - "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/seq@opam:base@5ed5af70", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/seq@opam:base@5ed5af70", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/xdg@opam:3.7.1@387cb889": { - "id": "@opam/xdg@opam:3.7.1@387cb889", + "@opam/xdg@opam:3.16.0@fccd8d01": { + "id": "@opam/xdg@opam:3.16.0@fccd8d01", "name": "@opam/xdg", - "version": "opam:3.7.1", + "version": "opam:3.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", - "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "archive:https://opam.ocaml.org/cache/sha256/54/5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6", + "archive:https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" ], "opam": { "name": "xdg", - "version": "3.7.1", - "path": "esy.lock/opam/xdg.3.7.1" + "version": "3.16.0", + "path": "esy.lock/opam/xdg.3.16.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/uutf@opam:1.0.3@47c95a18": { @@ -140,120 +139,119 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.2.0@b0c6143c", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/uuseg@opam:15.0.0@14085231": { - "id": "@opam/uuseg@opam:15.0.0@14085231", + "@opam/uuseg@opam:15.1.0@af4a84a3": { + "id": "@opam/uuseg@opam:15.1.0@af4a84a3", "name": "@opam/uuseg", - "version": "opam:15.0.0", + "version": "opam:15.1.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha512/37/37ea83b582dd779a026cfae11f08f5d67ef79fce65a2cf03f2a9aabc7eb5de60c8e812524fa7531e4ff6e22a3b18228e3438a0143ce43be95f23237cc283576f#sha512:37ea83b582dd779a026cfae11f08f5d67ef79fce65a2cf03f2a9aabc7eb5de60c8e812524fa7531e4ff6e22a3b18228e3438a0143ce43be95f23237cc283576f", - "archive:https://erratique.ch/software/uuseg/releases/uuseg-15.0.0.tbz#sha512:37ea83b582dd779a026cfae11f08f5d67ef79fce65a2cf03f2a9aabc7eb5de60c8e812524fa7531e4ff6e22a3b18228e3438a0143ce43be95f23237cc283576f" + "archive:https://opam.ocaml.org/cache/sha512/1e/1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a#sha512:1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a", + "archive:https://erratique.ch/software/uuseg/releases/uuseg-15.1.0.tbz#sha512:1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a" ], "opam": { "name": "uuseg", - "version": "15.0.0", - "path": "esy.lock/opam/uuseg.15.0.0" + "version": "15.1.0", + "path": "esy.lock/opam/uuseg.15.1.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/uucp@opam:15.0.0@55460339", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.2.0@b0c6143c", + "ocaml@4.14.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/uucp@opam:15.1.0@ef3e0a4e", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uucp@opam:15.0.0@55460339" + "ocaml@4.14.1000@d41d8cd9", "@opam/uucp@opam:15.1.0@ef3e0a4e" ] }, - "@opam/uucp@opam:15.0.0@55460339": { - "id": "@opam/uucp@opam:15.0.0@55460339", + "@opam/uucp@opam:15.1.0@ef3e0a4e": { + "id": "@opam/uucp@opam:15.1.0@ef3e0a4e", "name": "@opam/uucp", - "version": "opam:15.0.0", + "version": "opam:15.1.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha512/ee/ee4acff5666961766321e85e287fb9d5b8d50533319f22bf6f4eceb943242df2d0e0f4e775c4a140f68ca142837938eaa5926e22362215a3365ffe7f8768923b#sha512:ee4acff5666961766321e85e287fb9d5b8d50533319f22bf6f4eceb943242df2d0e0f4e775c4a140f68ca142837938eaa5926e22362215a3365ffe7f8768923b", - "archive:https://erratique.ch/software/uucp/releases/uucp-15.0.0.tbz#sha512:ee4acff5666961766321e85e287fb9d5b8d50533319f22bf6f4eceb943242df2d0e0f4e775c4a140f68ca142837938eaa5926e22362215a3365ffe7f8768923b" + "archive:https://opam.ocaml.org/cache/sha512/99/998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364#sha512:998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364", + "archive:https://erratique.ch/software/uucp/releases/uucp-15.1.0.tbz#sha512:998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364" ], "opam": { "name": "uucp", - "version": "15.0.0", - "path": "esy.lock/opam/uucp.15.0.0" + "version": "15.1.0", + "path": "esy.lock/opam/uucp.15.1.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.2.0@b0c6143c", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/utop@opam:2.12.0@41cf0331": { - "id": "@opam/utop@opam:2.12.0@41cf0331", + "@opam/utop@opam:2.14.0@5f65a713": { + "id": "@opam/utop@opam:2.14.0@5f65a713", "name": "@opam/utop", - "version": "opam:2.12.0", + "version": "opam:2.14.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea#sha256:ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea", - "archive:https://github.com/ocaml-community/utop/releases/download/2.12.0/utop-2.12.0.tbz#sha256:ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea" + "archive:https://opam.ocaml.org/cache/sha256/0f/0fd5a9bc5b458524a71463a1fe0cd16f9b7be13673ae303118b7216e0d273ba9#sha256:0fd5a9bc5b458524a71463a1fe0cd16f9b7be13673ae303118b7216e0d273ba9", + "archive:https://github.com/ocaml-community/utop/releases/download/2.14.0/utop-2.14.0.tbz#sha256:0fd5a9bc5b458524a71463a1fe0cd16f9b7be13673ae303118b7216e0d273ba9" ], "opam": { "name": "utop", - "version": "2.12.0", - "path": "esy.lock/opam/utop.2.12.0" + "version": "2.14.0", + "path": "esy.lock/opam/utop.2.14.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/zed@opam:3.2.1@276736c0", - "@opam/react@opam:1.2.2@e0f4480e", - "@opam/ocamlfind@opam:1.9.5@e83abf74", + "ocaml@4.14.1000@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/ocamlfind@opam:1.9.6@923e2274", "@opam/lwt_react@opam:1.2.0@4253a145", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/lambda-term@opam:3.3.1@ee145aff", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@a2c1229c", + "@opam/lambda-term@opam:3.3.2@0f91853c", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/zed@opam:3.2.1@276736c0", - "@opam/react@opam:1.2.2@e0f4480e", - "@opam/ocamlfind@opam:1.9.5@e83abf74", + "ocaml@4.14.1000@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/ocamlfind@opam:1.9.6@923e2274", "@opam/lwt_react@opam:1.2.0@4253a145", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/lambda-term@opam:3.3.1@ee145aff", - "@opam/dune@opam:3.7.1@40db2f22", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@a2c1229c", + "@opam/lambda-term@opam:3.3.2@0f91853c", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084" ] }, - "@opam/uchar@opam:0.0.2@aedf91f9": { - "id": "@opam/uchar@opam:0.0.2@aedf91f9", + "@opam/uchar@opam:0.0.2@3e1919ed": { + "id": "@opam/uchar@opam:0.0.2@3e1919ed", "name": "@opam/uchar", "version": "opam:0.0.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/c9/c9ba2c738d264c420c642f7bb1cf4a36#md5:c9ba2c738d264c420c642f7bb1cf4a36", - "archive:https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz#md5:c9ba2c738d264c420c642f7bb1cf4a36" + "archive:https://opam.ocaml.org/cache/sha256/47/47397f316cbe76234af53c74a1f9452154ba3bdb54fced5caac959f50f575af0#sha256:47397f316cbe76234af53c74a1f9452154ba3bdb54fced5caac959f50f575af0", + "archive:https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz#sha256:47397f316cbe76234af53c74a1f9452154ba3bdb54fced5caac959f50f575af0" ], "opam": { "name": "uchar", @@ -263,53 +261,53 @@ }, "overrides": [ { - "opamoverride": - "esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override" + "opamoverride": "esy.lock/overrides/opam__s__uchar_opam__c__0.0.2_opam_override" } ], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocamlbuild@opam:0.14.2@c6163b28", + "ocaml@4.14.1000@d41d8cd9", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/tyxml@opam:4.5.0@0a609297": { - "id": "@opam/tyxml@opam:4.5.0@0a609297", + "@opam/tyxml@opam:4.6.0@5ced2c2c": { + "id": "@opam/tyxml@opam:4.6.0@5ced2c2c", "name": "@opam/tyxml", - "version": "opam:4.5.0", + "version": "opam:4.6.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/c6/c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068#sha256:c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068", - "archive:https://github.com/ocsigen/tyxml/releases/download/4.5.0/tyxml-4.5.0.tbz#sha256:c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068" + "archive:https://opam.ocaml.org/cache/sha256/bf/bfeb673c6b4e120a4eca4c48448add47dc3f8d02c2b40f63ffdccc4e91c902dd#sha256:bfeb673c6b4e120a4eca4c48448add47dc3f8d02c2b40f63ffdccc4e91c902dd", + "archive:https://github.com/ocsigen/tyxml/releases/download/4.6.0/tyxml-4.6.0.tbz#sha256:bfeb673c6b4e120a4eca4c48448add47dc3f8d02c2b40f63ffdccc4e91c902dd" ], "opam": { "name": "tyxml", - "version": "4.5.0", - "path": "esy.lock/opam/tyxml.4.5.0" + "version": "4.6.0", + "path": "esy.lock/opam/tyxml.4.6.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/seq@opam:base@5ed5af70", "@opam/re@opam:1.11.0@87deb463", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", - "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/uutf@opam:1.0.3@47c95a18", + "@opam/seq@opam:base@5ed5af70", "@opam/re@opam:1.11.0@87deb463", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/trie@opam:1.0.0@f4e510e2": { - "id": "@opam/trie@opam:1.0.0@f4e510e2", + "@opam/trie@opam:1.0.0@628cebcc": { + "id": "@opam/trie@opam:1.0.0@628cebcc", "name": "@opam/trie", "version": "opam:1.0.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/84/84519b5f8bd92490bfc68a52f706ba14#md5:84519b5f8bd92490bfc68a52f706ba14", - "archive:https://github.com/kandu/trie/archive/1.0.0.tar.gz#md5:84519b5f8bd92490bfc68a52f706ba14" + "archive:https://opam.ocaml.org/cache/sha256/c2/c2f8054ea44216e6a3a961b28f7630e0e3dbfbd1b504ae741be230cbe32498ea#sha256:c2f8054ea44216e6a3a961b28f7630e0e3dbfbd1b504ae741be230cbe32498ea", + "archive:https://github.com/kandu/trie/archive/1.0.0.tar.gz#sha256:c2f8054ea44216e6a3a961b28f7630e0e3dbfbd1b504ae741be230cbe32498ea" ], "opam": { "name": "trie", @@ -319,11 +317,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/topkg@opam:1.0.7@7ee47d76": { @@ -344,12 +342,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", + "ocaml@4.14.1000@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocamlbuild@opam:0.14.2@c6163b28" + "ocaml@4.14.1000@d41d8cd9", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46" ] }, "@opam/stdune@opam:3.6.2@47d75c4b": { @@ -370,18 +369,18 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", + "ocaml@4.14.1000@d41d8cd9", "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", + "ocaml@4.14.1000@d41d8cd9", "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@opam/base-unix@opam:base@87d0b2eb" ] }, @@ -403,11 +402,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/spawn@opam:v0.15.1@85e9d6f1": { @@ -428,40 +427,40 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/sexplib0@opam:v0.15.1@51111c0c": { - "id": "@opam/sexplib0@opam:v0.15.1@51111c0c", + "@opam/sexplib0@opam:v0.17.0@21847769": { + "id": "@opam/sexplib0@opam:v0.17.0@21847769", "name": "@opam/sexplib0", - "version": "opam:v0.15.1", + "version": "opam:v0.17.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/ab/ab8fd6273f35a792cad48cbb3024a7f9#md5:ab8fd6273f35a792cad48cbb3024a7f9", - "archive:https://github.com/janestreet/sexplib0/archive/refs/tags/v0.15.1.tar.gz#md5:ab8fd6273f35a792cad48cbb3024a7f9" + "archive:https://opam.ocaml.org/cache/md5/ab/abafe8fd1d6302e55a315f4d78960d2a#md5:abafe8fd1d6302e55a315f4d78960d2a", + "archive:https://github.com/janestreet/sexplib0/archive/refs/tags/v0.17.0.tar.gz#md5:abafe8fd1d6302e55a315f4d78960d2a" ], "opam": { "name": "sexplib0", - "version": "v0.15.1", - "path": "esy.lock/opam/sexplib0.v0.15.1" + "version": "v0.17.0", + "path": "esy.lock/opam/sexplib0.v0.17.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/seq@opam:base@d8d7de1d": { - "id": "@opam/seq@opam:base@d8d7de1d", + "@opam/seq@opam:base@5ed5af70": { + "id": "@opam/seq@opam:base@5ed5af70", "name": "@opam/seq", "version": "opam:base", "source": { @@ -475,19 +474,31 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ], + "extraSources": [ + { + "checksum": "sha256:e95062b4d0519ef8335c02f7d0f1952d11b814c7ab7e6d566a206116162fa2be", + "url": "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/seq/META.seq", + "relativePath": "META.seq" + }, + { + "checksum": "sha256:fff926c2c4d5a82b6c94c60c4c35eb06e3d39975893ebe6b1f0e6557cbe34904", + "url": "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/seq/seq.install", + "relativePath": "seq.install" + } + ] }, - "@opam/result@opam:1.5@1c6a6533": { - "id": "@opam/result@opam:1.5@1c6a6533", + "@opam/result@opam:1.5@5a755845": { + "id": "@opam/result@opam:1.5@5a755845", "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" + "archive:https://opam.ocaml.org/cache/sha256/7c/7c3a5e238558f4c1a4f5acca816bc705a0e12f68dc0005c61ddbf2e6cab8ee32#sha256:7c3a5e238558f4c1a4f5acca816bc705a0e12f68dc0005c61ddbf2e6cab8ee32", + "archive:https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz#sha256:7c3a5e238558f4c1a4f5acca816bc705a0e12f68dc0005c61ddbf2e6cab8ee32" ], "opam": { "name": "result", @@ -497,11 +508,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/react@opam:1.2.2@e0f4480e": { @@ -522,106 +533,135 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/re@opam:1.10.4@c4910ba6": { - "id": "@opam/re@opam:1.10.4@c4910ba6", + "@opam/re@opam:1.11.0@87deb463": { + "id": "@opam/re@opam:1.11.0@87deb463", "name": "@opam/re", - "version": "opam:1.10.4", + "version": "opam:1.11.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/83/83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c#sha256:83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c", - "archive:https://github.com/ocaml/ocaml-re/releases/download/1.10.4/re-1.10.4.tbz#sha256:83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c" + "archive:https://opam.ocaml.org/cache/sha256/01/01fc244780c0f6be72ae796b1fb750f367de18624fd75d07ee79782ed6df8d4f#sha256:01fc244780c0f6be72ae796b1fb750f367de18624fd75d07ee79782ed6df8d4f", + "archive:https://github.com/ocaml/ocaml-re/releases/download/1.11.0/re-1.11.0.tbz#sha256:01fc244780c0f6be72ae796b1fb750f367de18624fd75d07ee79782ed6df8d4f" ], "opam": { "name": "re", - "version": "1.10.4", - "path": "esy.lock/opam/re.1.10.4" + "version": "1.11.0", + "path": "esy.lock/opam/re.1.11.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/seq@opam:base@5ed5af70", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/seq@opam:base@5ed5af70", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/ppxlib@opam:0.29.1@8414c948": { - "id": "@opam/ppxlib@opam:0.29.1@8414c948", + "@opam/ptime@opam:1.1.0@d6f12219": { + "id": "@opam/ptime@opam:1.1.0@d6f12219", + "name": "@opam/ptime", + "version": "opam:1.1.0", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha512/30/309b8383f61b58840e58a82802ec8fbc61b7cc95a4590d38ad427e484cbaaf66f03fa8e6484b5b6855468a87e745aed103bf6f1041ec05062230a9fa5fb86cc6#sha512:309b8383f61b58840e58a82802ec8fbc61b7cc95a4590d38ad427e484cbaaf66f03fa8e6484b5b6855468a87e745aed103bf6f1041ec05062230a9fa5fb86cc6", + "archive:https://erratique.ch/software/ptime/releases/ptime-1.1.0.tbz#sha512:309b8383f61b58840e58a82802ec8fbc61b7cc95a4590d38ad427e484cbaaf66f03fa8e6484b5b6855468a87e745aed103bf6f1041ec05062230a9fa5fb86cc6" + ], + "opam": { + "name": "ptime", + "version": "1.1.0", + "path": "esy.lock/opam/ptime.1.1.0" + } + }, + "overrides": [ + { + "opamoverride": "esy.lock/overrides/opam__s__ptime_opam__c__1.1.0_opam_override" + } + ], + "dependencies": [ + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] + }, + "@opam/ppxlib@opam:0.32.1@9897cafd": { + "id": "@opam/ppxlib@opam:0.32.1@9897cafd", "name": "@opam/ppxlib", - "version": "opam:0.29.1", + "version": "opam:0.32.1", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/c8/c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79#sha256:c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79", - "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.29.1/ppxlib-0.29.1.tbz#sha256:c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79" + "archive:https://opam.ocaml.org/cache/sha256/9d/9dbad8bcb1c8b4f3df3f58bca60a5ed23d86531f0da34b4196c86bd585c09d7f#sha256:9dbad8bcb1c8b4f3df3f58bca60a5ed23d86531f0da34b4196c86bd585c09d7f", + "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.32.1/ppxlib-0.32.1.tbz#sha256:9dbad8bcb1c8b4f3df3f58bca60a5ed23d86531f0da34b4196c86bd585c09d7f" ], "opam": { "name": "ppxlib", - "version": "0.29.1", - "path": "esy.lock/opam/ppxlib.0.29.1" + "version": "0.32.1", + "path": "esy.lock/opam/ppxlib.0.32.1" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/sexplib0@opam:v0.15.1@51111c0c", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.17.0@21847769", + "@opam/ppx_derivers@opam:1.2.1@d78727cd", + "@opam/ocaml-compiler-libs@opam:v0.12.4@57a85ad1", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", - "@opam/sexplib0@opam:v0.15.1@51111c0c", - "@opam/ppx_derivers@opam:1.2.1@e2cbad12", - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/stdlib-shims@opam:0.3.0@72c7bc98", + "@opam/sexplib0@opam:v0.17.0@21847769", + "@opam/ppx_derivers@opam:1.2.1@d78727cd", + "@opam/ocaml-compiler-libs@opam:v0.12.4@57a85ad1", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7": { - "id": "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", + "@opam/ppx_yojson_conv_lib@opam:v0.16.0@33740c3c": { + "id": "@opam/ppx_yojson_conv_lib@opam:v0.16.0@33740c3c", "name": "@opam/ppx_yojson_conv_lib", - "version": "opam:v0.15.0", + "version": "opam:v0.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/f9/f9d2c5eff4566ec1f1f379b186ed22c8ddd6be0909a160bc5a9ac7abc6a6b684#sha256:f9d2c5eff4566ec1f1f379b186ed22c8ddd6be0909a160bc5a9ac7abc6a6b684", - "archive:https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_yojson_conv_lib-v0.15.0.tar.gz#sha256:f9d2c5eff4566ec1f1f379b186ed22c8ddd6be0909a160bc5a9ac7abc6a6b684" + "archive:https://opam.ocaml.org/cache/sha256/55/557c43c88d365b4cbb514d809f1eecc54d7b9976b0669bc55b02169e6c86ec7d#sha256:557c43c88d365b4cbb514d809f1eecc54d7b9976b0669bc55b02169e6c86ec7d", + "archive:https://ocaml.janestreet.com/ocaml-core/v0.16/files/ppx_yojson_conv_lib-v0.16.0.tar.gz#sha256:557c43c88d365b4cbb514d809f1eecc54d7b9976b0669bc55b02169e6c86ec7d" ], "opam": { "name": "ppx_yojson_conv_lib", - "version": "v0.15.0", - "path": "esy.lock/opam/ppx_yojson_conv_lib.v0.15.0" + "version": "v0.16.0", + "path": "esy.lock/opam/ppx_yojson_conv_lib.v0.16.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/yojson@opam:2.2.1@3eedaf6a", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/yojson@opam:2.2.1@3eedaf6a", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/ppx_derivers@opam:1.2.1@e2cbad12": { - "id": "@opam/ppx_derivers@opam:1.2.1@e2cbad12", + "@opam/ppx_derivers@opam:1.2.1@d78727cd": { + "id": "@opam/ppx_derivers@opam:1.2.1@d78727cd", "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" + "archive:https://opam.ocaml.org/cache/sha256/b6/b6595ee187dea792b31fc54a0e1524ab1e48bc6068d3066c45215a138cc73b95#sha256:b6595ee187dea792b31fc54a0e1524ab1e48bc6068d3066c45215a138cc73b95", + "archive:https://github.com/ocaml-ppx/ppx_derivers/archive/1.2.1.tar.gz#sha256:b6595ee187dea792b31fc54a0e1524ab1e48bc6068d3066c45215a138cc73b95" ], "opam": { "name": "ppx_derivers", @@ -631,36 +671,36 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/pp@opam:1.1.2@89ad03b5": { - "id": "@opam/pp@opam:1.1.2@89ad03b5", + "@opam/pp@opam:1.2.0@16430027": { + "id": "@opam/pp@opam:1.2.0@16430027", "name": "@opam/pp", - "version": "opam:1.1.2", + "version": "opam:1.2.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e4/e4a4e98d96b1bb76950fcd6da4e938c86d989df4d7e48f02f7a44595f5af1d56#sha256:e4a4e98d96b1bb76950fcd6da4e938c86d989df4d7e48f02f7a44595f5af1d56", - "archive:https://github.com/ocaml-dune/pp/releases/download/1.1.2/pp-1.1.2.tbz#sha256:e4a4e98d96b1bb76950fcd6da4e938c86d989df4d7e48f02f7a44595f5af1d56" + "archive:https://opam.ocaml.org/cache/sha256/a5/a5e822573c55afb42db29ec56eacd1f2acd8f65cf2df2878e291de374ce6909c#sha256:a5e822573c55afb42db29ec56eacd1f2acd8f65cf2df2878e291de374ce6909c", + "archive:https://github.com/ocaml-dune/pp/releases/download/1.2.0/pp-1.2.0.tbz#sha256:a5e822573c55afb42db29ec56eacd1f2acd8f65cf2df2878e291de374ce6909c" ], "opam": { "name": "pp", - "version": "1.1.2", - "path": "esy.lock/opam/pp.1.1.2" + "version": "1.2.0", + "path": "esy.lock/opam/pp.1.2.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/ordering@opam:3.6.2@37bc3093": { @@ -681,22 +721,22 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/omd@opam:1.3.2@511d53d2": { - "id": "@opam/omd@opam:1.3.2@511d53d2", + "@opam/omd@opam:1.3.2@f6edb8b8": { + "id": "@opam/omd@opam:1.3.2@f6edb8b8", "name": "@opam/omd", "version": "opam:1.3.2", "source": { "type": "install", "source": [ "archive:https://opam.ocaml.org/cache/sha256/60/6023e1642631f08f678eb5725820879ed7bb5a3ffee777cdedebc28c1f85fadb#sha256:6023e1642631f08f678eb5725820879ed7bb5a3ffee777cdedebc28c1f85fadb", - "archive:https://github.com/ocaml/omd/releases/download/1.3.2/omd-1.3.2.tbz#sha256:6023e1642631f08f678eb5725820879ed7bb5a3ffee777cdedebc28c1f85fadb" + "archive:https://github.com/ocaml/opam-source-archives/raw/main/omd-1.3.2.tbz#sha256:6023e1642631f08f678eb5725820879ed7bb5a3ffee777cdedebc28c1f85fadb" ], "opam": { "name": "omd", @@ -706,94 +746,96 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/base-bytes@opam:base@19d0c2ff", "@opam/base-bigarray@opam:base@b03491b0", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/base-bytes@opam:base@19d0c2ff", "@opam/base-bigarray@opam:base@b03491b0" ] }, - "@opam/odoc-parser@opam:2.0.0@a08011a0": { - "id": "@opam/odoc-parser@opam:2.0.0@a08011a0", + "@opam/odoc-parser@opam:2.4.2@1c1f2555": { + "id": "@opam/odoc-parser@opam:2.4.2@1c1f2555", "name": "@opam/odoc-parser", - "version": "opam:2.0.0", + "version": "opam:2.4.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/40/407919fbb0eb95761d6fc6ec6777628d94aa1907343bdca678b1880bafb33922#sha256:407919fbb0eb95761d6fc6ec6777628d94aa1907343bdca678b1880bafb33922", - "archive:https://github.com/ocaml-doc/odoc-parser/releases/download/2.0.0/odoc-parser-2.0.0.tbz#sha256:407919fbb0eb95761d6fc6ec6777628d94aa1907343bdca678b1880bafb33922" + "archive:https://opam.ocaml.org/cache/sha256/56/563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b#sha256:563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b", + "archive:https://github.com/ocaml/odoc/releases/download/2.4.2/odoc-2.4.2.tbz#sha256:563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b" ], "opam": { "name": "odoc-parser", - "version": "2.0.0", - "path": "esy.lock/opam/odoc-parser.2.0.0" + "version": "2.4.2", + "path": "esy.lock/opam/odoc-parser.2.4.2" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/result@opam:1.5@5a755845", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/camlp-streams@opam:5.0.1@daaa0f94", - "@opam/astring@opam:0.8.5@1300cee8", + "@opam/astring@opam:0.8.5@6db2b8c5", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/result@opam:1.5@1c6a6533", - "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/result@opam:1.5@5a755845", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/camlp-streams@opam:5.0.1@daaa0f94", - "@opam/astring@opam:0.8.5@1300cee8" + "@opam/astring@opam:0.8.5@6db2b8c5" ] }, - "@opam/odoc@opam:2.2.0@020767ad": { - "id": "@opam/odoc@opam:2.2.0@020767ad", + "@opam/odoc@opam:2.4.2@12b68179": { + "id": "@opam/odoc@opam:2.4.2@12b68179", "name": "@opam/odoc", - "version": "opam:2.2.0", + "version": "opam:2.4.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/68/6818c971fc0c3eed9d3d143389f80739b1618af70b9fdb443b35bd7f0121740c#sha256:6818c971fc0c3eed9d3d143389f80739b1618af70b9fdb443b35bd7f0121740c", - "archive:https://github.com/ocaml/odoc/releases/download/2.2.0/odoc-2.2.0.tbz#sha256:6818c971fc0c3eed9d3d143389f80739b1618af70b9fdb443b35bd7f0121740c" + "archive:https://opam.ocaml.org/cache/sha256/56/563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b#sha256:563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b", + "archive:https://github.com/ocaml/odoc/releases/download/2.4.2/odoc-2.4.2.tbz#sha256:563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b" ], "opam": { "name": "odoc", - "version": "2.2.0", - "path": "esy.lock/opam/odoc.2.2.0" + "version": "2.4.2", + "path": "esy.lock/opam/odoc.2.4.2" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/tyxml@opam:4.5.0@0a609297", - "@opam/result@opam:1.5@1c6a6533", - "@opam/odoc-parser@opam:2.0.0@a08011a0", - "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", - "@opam/cmdliner@opam:1.2.0@b0c6143c", - "@opam/astring@opam:0.8.5@1300cee8", + "ocaml@4.14.1000@d41d8cd9", "@opam/tyxml@opam:4.6.0@5ced2c2c", + "@opam/result@opam:1.5@5a755845", + "@opam/odoc-parser@opam:2.4.2@1c1f2555", + "@opam/fpath@opam:0.7.3@ba8dd432", "@opam/fmt@opam:0.9.0@87213963", + "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/crunch@opam:3.3.1@e6228a2b", "@opam/cppo@opam:1.6.9@db929a12", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", + "@opam/astring@opam:0.8.5@6db2b8c5", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/tyxml@opam:4.5.0@0a609297", - "@opam/result@opam:1.5@1c6a6533", - "@opam/odoc-parser@opam:2.0.0@a08011a0", - "@opam/fpath@opam:0.7.3@674d8125", "@opam/fmt@opam:0.9.0@87213963", - "@opam/dune@opam:3.7.1@40db2f22", - "@opam/cmdliner@opam:1.2.0@b0c6143c", - "@opam/astring@opam:0.8.5@1300cee8" + "ocaml@4.14.1000@d41d8cd9", "@opam/tyxml@opam:4.6.0@5ced2c2c", + "@opam/result@opam:1.5@5a755845", + "@opam/odoc-parser@opam:2.4.2@1c1f2555", + "@opam/fpath@opam:0.7.3@ba8dd432", "@opam/fmt@opam:0.9.0@87213963", + "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/crunch@opam:3.3.1@e6228a2b", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", + "@opam/astring@opam:0.8.5@6db2b8c5" ] }, - "@opam/octavius@opam:1.2.2@2205cc65": { - "id": "@opam/octavius@opam:1.2.2@2205cc65", + "@opam/octavius@opam:1.2.2@558886f0": { + "id": "@opam/octavius@opam:1.2.2@558886f0", "name": "@opam/octavius", "version": "opam:1.2.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/72/72f9e1d996e6c5089fc513cc9218607b#md5:72f9e1d996e6c5089fc513cc9218607b", - "archive:https://github.com/ocaml-doc/octavius/archive/v1.2.2.tar.gz#md5:72f9e1d996e6c5089fc513cc9218607b" + "archive:https://opam.ocaml.org/cache/sha256/ea/eac9104ce0316b69da9c44b9c477700fe0b52a888c89ce4bdf1d2b782a73e0ad#sha256:eac9104ce0316b69da9c44b9c477700fe0b52a888c89ce4bdf1d2b782a73e0ad", + "archive:https://github.com/ocaml-doc/octavius/archive/v1.2.2.tar.gz#sha256:eac9104ce0316b69da9c44b9c477700fe0b52a888c89ce4bdf1d2b782a73e0ad" ], "opam": { "name": "octavius", @@ -803,11 +845,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/ocplib-endian@opam:1.2@008dc942": { @@ -828,68 +870,74 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-bytes@opam:base@19d0c2ff", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/base-bytes@opam:base@19d0c2ff" ] }, - "@opam/ocamlformat-rpc-lib@opam:0.25.1@fb9fa86e": { - "id": "@opam/ocamlformat-rpc-lib@opam:0.25.1@fb9fa86e", + "@opam/ocamlformat-rpc-lib@opam:0.26.2@f94d170f": { + "id": "@opam/ocamlformat-rpc-lib@opam:0.26.2@f94d170f", "name": "@opam/ocamlformat-rpc-lib", - "version": "opam:0.25.1", + "version": "opam:0.26.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/dc/dc8f2a330ca3930b36cacb2623bb360ed8bdf6e4a8acd293dbd9e2241a6fd33d#sha256:dc8f2a330ca3930b36cacb2623bb360ed8bdf6e4a8acd293dbd9e2241a6fd33d", - "archive:https://github.com/ocaml-ppx/ocamlformat/releases/download/0.25.1/ocamlformat-0.25.1.tbz#sha256:dc8f2a330ca3930b36cacb2623bb360ed8bdf6e4a8acd293dbd9e2241a6fd33d" + "archive:https://opam.ocaml.org/cache/sha256/2e/2e4f596bf7aa367a844fe83ba0f6b0bf14b2a65179ddc082363fe9793d0375c5#sha256:2e4f596bf7aa367a844fe83ba0f6b0bf14b2a65179ddc082363fe9793d0375c5", + "archive:https://github.com/ocaml-ppx/ocamlformat/releases/download/0.26.2/ocamlformat-0.26.2.tbz#sha256:2e4f596bf7aa367a844fe83ba0f6b0bf14b2a65179ddc082363fe9793d0375c5" ], "opam": { "name": "ocamlformat-rpc-lib", - "version": "0.25.1", - "path": "esy.lock/opam/ocamlformat-rpc-lib.0.25.1" + "version": "0.26.2", + "path": "esy.lock/opam/ocamlformat-rpc-lib.0.26.2" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4" ] }, - "@opam/ocamlfind@opam:1.9.5@e83abf74": { - "id": "@opam/ocamlfind@opam:1.9.5@e83abf74", + "@opam/ocamlfind@opam:1.9.6@923e2274": { + "id": "@opam/ocamlfind@opam:1.9.6@923e2274", "name": "@opam/ocamlfind", - "version": "opam:1.9.5", + "version": "opam:1.9.6", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/8b/8b893525ce36cb3d4d4952483bcc7cf4#md5:8b893525ce36cb3d4d4952483bcc7cf4", - "archive:http://download.camlcity.org/download/findlib-1.9.5.tar.gz#md5:8b893525ce36cb3d4d4952483bcc7cf4" + "archive:https://opam.ocaml.org/cache/md5/96/96c6ee50a32cca9ca277321262dbec57#md5:96c6ee50a32cca9ca277321262dbec57", + "archive:http://download.camlcity.org/download/findlib-1.9.6.tar.gz#md5:96c6ee50a32cca9ca277321262dbec57" ], "opam": { "name": "ocamlfind", - "version": "1.9.5", - "path": "esy.lock/opam/ocamlfind.1.9.5" + "version": "1.9.6", + "path": "esy.lock/opam/ocamlfind.1.9.6" } }, "overrides": [ { - "opamoverride": - "esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override" + "opamoverride": "esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override" } ], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ], + "extraSources": [ + { + "checksum": "sha256:6fcca5f2f7abf8d6304da6c385348584013ffb8602722a87fb0bacbab5867fe8", + "url": "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/ocamlfind/0001-Harden-test-for-OCaml-5.patch", + "relativePath": "0001-Harden-test-for-OCaml-5.patch" + } + ] }, "@opam/ocamlc-loc@opam:3.6.2@edc950a7": { "id": "@opam/ocamlc-loc@opam:3.6.2@edc950a7", @@ -909,40 +957,46 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dyn@opam:3.6.2@38120dfc", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/ocamlbuild@opam:0.14.2@c6163b28": { - "id": "@opam/ocamlbuild@opam:0.14.2@c6163b28", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46": { + "id": "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", "name": "@opam/ocamlbuild", - "version": "opam:0.14.2", + "version": "opam:0.14.3+win", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/2f/2f407fadd57b073155a6aead887d9676#md5:2f407fadd57b073155a6aead887d9676", - "archive:https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.2.tar.gz#md5:2f407fadd57b073155a6aead887d9676" + "archive:https://opam.ocaml.org/cache/md5/22/220df59060c916e8aac2eb471c870485#md5:220df59060c916e8aac2eb471c870485", + "archive:https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.3.tar.gz#md5:220df59060c916e8aac2eb471c870485" ], "opam": { "name": "ocamlbuild", - "version": "0.14.2", - "path": "esy.lock/opam/ocamlbuild.0.14.2" + "version": "0.14.3+win", + "path": "esy.lock/opam/ocamlbuild.0.14.3+win" } }, "overrides": [ { - "opamoverride": - "esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2_opam_override" + "opamoverride": "esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override" } ], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ], + "extraSources": [ + { + "checksum": "sha256:a9b7e1829a3304e5a073d8ddea29d3d8272698e93b7e1ee659ae5e31e5cfb6b9", + "url": "https://raw.githubusercontent.com/ocaml-opam/opam-repository-mingw/354a87b397856f2a70024c5c83fc5001074935b6/packages/ocamlbuild/ocamlbuild.0.14.2/files/ocamlbuild-0.14.2.patch", + "relativePath": "ocamlbuild-0.14.2.patch" + } + ] }, "@opam/ocaml-lsp-server@opam:1.15.1-4.14@76510e53": { "id": "@opam/ocaml-lsp-server@opam:1.15.1-4.14@76510e53", @@ -962,43 +1016,43 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/xdg@opam:3.7.1@387cb889", "@opam/uutf@opam:1.0.3@47c95a18", + "ocaml@4.14.1000@d41d8cd9", "@opam/yojson@opam:2.2.1@3eedaf6a", + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", - "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/omd@opam:1.3.2@511d53d2", - "@opam/octavius@opam:1.2.2@2205cc65", - "@opam/ocamlformat-rpc-lib@opam:0.25.1@fb9fa86e", + "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.11.0@87deb463", + "@opam/ppx_yojson_conv_lib@opam:v0.16.0@33740c3c", + "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", + "@opam/omd@opam:1.3.2@f6edb8b8", + "@opam/octavius@opam:1.2.2@558886f0", + "@opam/ocamlformat-rpc-lib@opam:0.26.2@f94d170f", "@opam/ocamlc-loc@opam:3.6.2@edc950a7", - "@opam/fiber@opam:3.6.2@349136be", "@opam/dyn@opam:3.6.2@38120dfc", + "@opam/fiber@opam:3.7.0@bf633a34", "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune-rpc@opam:3.6.2@d874b9d2", - "@opam/dune-build-info@opam:3.7.1@adf0d411", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", - "@opam/chrome-trace@opam:3.7.1@92d3c503", + "@opam/dune-build-info@opam:3.16.0@5123b882", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/csexp@opam:1.5.2@46614bf4", + "@opam/chrome-trace@opam:3.16.0@968aeb8c", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/yojson@opam:2.0.2@eb65f292", - "@opam/xdg@opam:3.7.1@387cb889", "@opam/uutf@opam:1.0.3@47c95a18", + "ocaml@4.14.1000@d41d8cd9", "@opam/yojson@opam:2.2.1@3eedaf6a", + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/uutf@opam:1.0.3@47c95a18", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.10.4@c4910ba6", - "@opam/ppx_yojson_conv_lib@opam:v0.15.0@773058a7", - "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/omd@opam:1.3.2@511d53d2", - "@opam/octavius@opam:1.2.2@2205cc65", - "@opam/ocamlformat-rpc-lib@opam:0.25.1@fb9fa86e", + "@opam/spawn@opam:v0.15.1@85e9d6f1", "@opam/re@opam:1.11.0@87deb463", + "@opam/ppx_yojson_conv_lib@opam:v0.16.0@33740c3c", + "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", + "@opam/omd@opam:1.3.2@f6edb8b8", + "@opam/octavius@opam:1.2.2@558886f0", + "@opam/ocamlformat-rpc-lib@opam:0.26.2@f94d170f", "@opam/ocamlc-loc@opam:3.6.2@edc950a7", - "@opam/fiber@opam:3.6.2@349136be", "@opam/dyn@opam:3.6.2@38120dfc", + "@opam/fiber@opam:3.7.0@bf633a34", "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune-rpc@opam:3.6.2@d874b9d2", - "@opam/dune-build-info@opam:3.7.1@adf0d411", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/csexp@opam:1.5.1@8a8fb3a7", - "@opam/chrome-trace@opam:3.7.1@92d3c503" + "@opam/dune-build-info@opam:3.16.0@5123b882", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/csexp@opam:1.5.2@46614bf4", + "@opam/chrome-trace@opam:3.16.0@968aeb8c" ] }, - "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882": { - "id": "@opam/ocaml-compiler-libs@opam:v0.12.4@41979882", + "@opam/ocaml-compiler-libs@opam:v0.12.4@57a85ad1": { + "id": "@opam/ocaml-compiler-libs@opam:v0.12.4@57a85ad1", "name": "@opam/ocaml-compiler-libs", "version": "opam:v0.12.4", "source": { @@ -1015,22 +1069,22 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/mew_vi@opam:0.5.0@cf66c299": { - "id": "@opam/mew_vi@opam:0.5.0@cf66c299", + "@opam/mew_vi@opam:0.5.0@d256e562": { + "id": "@opam/mew_vi@opam:0.5.0@d256e562", "name": "@opam/mew_vi", "version": "opam:0.5.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/34/341e9a9a20383641015bf503952906bc#md5:341e9a9a20383641015bf503952906bc", - "archive:https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz#md5:341e9a9a20383641015bf503952906bc" + "archive:https://opam.ocaml.org/cache/sha256/a6/a692fa7cdcc9e80fd9387c4f61677776b9fc15f9f7175b4220fcd1a73d1bafda#sha256:a692fa7cdcc9e80fd9387c4f61677776b9fc15f9f7175b4220fcd1a73d1bafda", + "archive:https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz#sha256:a692fa7cdcc9e80fd9387c4f61677776b9fc15f9f7175b4220fcd1a73d1bafda" ], "opam": { "name": "mew_vi", @@ -1040,24 +1094,24 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew@opam:0.1.0@87cdf6f8", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew@opam:0.1.0@65011d4b", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/mew@opam:0.1.0@87cdf6f8", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/mew@opam:0.1.0@65011d4b": { - "id": "@opam/mew@opam:0.1.0@65011d4b", + "@opam/mew@opam:0.1.0@87cdf6f8": { + "id": "@opam/mew@opam:0.1.0@87cdf6f8", "name": "@opam/mew", "version": "opam:0.1.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/22/2298149d1415cd804ab4e01f01ea10a0#md5:2298149d1415cd804ab4e01f01ea10a0", - "archive:https://github.com/kandu/mew/archive/0.1.0.tar.gz#md5:2298149d1415cd804ab4e01f01ea10a0" + "archive:https://opam.ocaml.org/cache/sha256/64/64d38ceb52ef574cb314bdd693f7e4a9c9e483e80a58595db22f2df76a8a59e6#sha256:64d38ceb52ef574cb314bdd693f7e4a9c9e483e80a58595db22f2df76a8a59e6", + "archive:https://github.com/kandu/mew/archive/0.1.0.tar.gz#sha256:64d38ceb52ef574cb314bdd693f7e4a9c9e483e80a58595db22f2df76a8a59e6" ], "opam": { "name": "mew", @@ -1067,13 +1121,13 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/trie@opam:1.0.0@628cebcc", + "@opam/result@opam:1.5@5a755845", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/trie@opam:1.0.0@f4e510e2", - "@opam/result@opam:1.5@1c6a6533", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/trie@opam:1.0.0@628cebcc", + "@opam/result@opam:1.5@5a755845", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/merlin-extend@opam:0.6.1@7d979feb": { @@ -1094,89 +1148,116 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/menhirSdk@opam:20230415@2aa219cc": { - "id": "@opam/menhirSdk@opam:20230415@2aa219cc", + "@opam/menhirSdk@opam:20231231@b20b8a51": { + "id": "@opam/menhirSdk@opam:20231231@b20b8a51", "name": "@opam/menhirSdk", - "version": "opam:20230415", + "version": "opam:20231231", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" + "archive:https://opam.ocaml.org/cache/md5/79/799748bc3b7a542798a85956c7863865#md5:799748bc3b7a542798a85956c7863865", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz#md5:799748bc3b7a542798a85956c7863865" ], "opam": { "name": "menhirSdk", - "version": "20230415", - "path": "esy.lock/opam/menhirSdk.20230415" + "version": "20231231", + "path": "esy.lock/opam/menhirSdk.20231231" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/menhirLib@opam:20230415@78be630c": { - "id": "@opam/menhirLib@opam:20230415@78be630c", + "@opam/menhirLib@opam:20231231@14d79986": { + "id": "@opam/menhirLib@opam:20231231@14d79986", "name": "@opam/menhirLib", - "version": "opam:20230415", + "version": "opam:20231231", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" + "archive:https://opam.ocaml.org/cache/md5/79/799748bc3b7a542798a85956c7863865#md5:799748bc3b7a542798a85956c7863865", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz#md5:799748bc3b7a542798a85956c7863865" ], "opam": { "name": "menhirLib", - "version": "20230415", - "path": "esy.lock/opam/menhirLib.20230415" + "version": "20231231", + "path": "esy.lock/opam/menhirLib.20231231" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/menhir@opam:20230415@ce1c9ac7": { - "id": "@opam/menhir@opam:20230415@ce1c9ac7", + "@opam/menhirCST@opam:20231231@0f42b5d1": { + "id": "@opam/menhirCST@opam:20231231@0f42b5d1", + "name": "@opam/menhirCST", + "version": "opam:20231231", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/md5/79/799748bc3b7a542798a85956c7863865#md5:799748bc3b7a542798a85956c7863865", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz#md5:799748bc3b7a542798a85956c7863865" + ], + "opam": { + "name": "menhirCST", + "version": "20231231", + "path": "esy.lock/opam/menhirCST.20231231" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" + ] + }, + "@opam/menhir@opam:20231231@f35eae6a": { + "id": "@opam/menhir@opam:20231231@f35eae6a", "name": "@opam/menhir", - "version": "opam:20230415", + "version": "opam:20231231", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/7c/7c4b51e1b666711af04f7832ebc90618#md5:7c4b51e1b666711af04f7832ebc90618", - "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz#md5:7c4b51e1b666711af04f7832ebc90618" + "archive:https://opam.ocaml.org/cache/md5/79/799748bc3b7a542798a85956c7863865#md5:799748bc3b7a542798a85956c7863865", + "archive:https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz#md5:799748bc3b7a542798a85956c7863865" ], "opam": { "name": "menhir", - "version": "20230415", - "path": "esy.lock/opam/menhir.20230415" + "version": "20231231", + "path": "esy.lock/opam/menhir.20231231" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20230415@2aa219cc", - "@opam/menhirLib@opam:20230415@78be630c", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@opam/menhirSdk@opam:20231231@b20b8a51", + "@opam/menhirLib@opam:20231231@14d79986", + "@opam/menhirCST@opam:20231231@0f42b5d1", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/menhirSdk@opam:20230415@2aa219cc", - "@opam/menhirLib@opam:20230415@78be630c", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/menhirSdk@opam:20231231@b20b8a51", + "@opam/menhirLib@opam:20231231@14d79986", + "@opam/menhirCST@opam:20231231@0f42b5d1", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/lwt_react@opam:1.2.0@4253a145": { @@ -1197,55 +1278,55 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/react@opam:1.2.2@e0f4480e", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/lwt@opam:5.6.1@2a9902ab": { - "id": "@opam/lwt@opam:5.6.1@2a9902ab", + "@opam/lwt@opam:5.7.0@4a33823d": { + "id": "@opam/lwt@opam:5.7.0@4a33823d", "name": "@opam/lwt", - "version": "opam:5.6.1", + "version": "opam:5.7.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/27/279024789a0ec84a9d97d98bad847f97#md5:279024789a0ec84a9d97d98bad847f97", - "archive:https://github.com/ocsigen/lwt/archive/5.6.1.tar.gz#md5:279024789a0ec84a9d97d98bad847f97" + "archive:https://opam.ocaml.org/cache/md5/73/737039d29d45b2d2b35db6931c8d75c6#md5:737039d29d45b2d2b35db6931c8d75c6", + "archive:https://github.com/ocsigen/lwt/archive/refs/tags/5.7.0.tar.gz#md5:737039d29d45b2d2b35db6931c8d75c6" ], "opam": { "name": "lwt", - "version": "5.6.1", - "path": "esy.lock/opam/lwt.5.6.1" + "version": "5.7.0", + "path": "esy.lock/opam/lwt.5.7.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", - "@opam/dune-configurator@opam:3.7.1@32ab7c21", - "@opam/dune@opam:3.7.1@40db2f22", "@opam/cppo@opam:1.6.9@db929a12", + "ocaml@4.14.1000@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", + "@opam/dune-configurator@opam:3.16.0@29bae660", + "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/cppo@opam:1.6.9@db929a12", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", - "@opam/dune-configurator@opam:3.7.1@32ab7c21", - "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/ocplib-endian@opam:1.2@008dc942", + "@opam/dune-configurator@opam:3.16.0@29bae660", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/logs@opam:0.7.0@46a3dffc": { - "id": "@opam/logs@opam:0.7.0@46a3dffc", + "@opam/logs@opam:0.7.0@a2c1229c": { + "id": "@opam/logs@opam:0.7.0@a2c1229c", "name": "@opam/logs", "version": "opam:0.7.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/2b/2bf021ca13331775e33cf34ab60246f7#md5:2bf021ca13331775e33cf34ab60246f7", - "archive:https://erratique.ch/software/logs/releases/logs-0.7.0.tbz#md5:2bf021ca13331775e33cf34ab60246f7" + "archive:https://opam.ocaml.org/cache/sha256/86/86f4a02807eb1a297aae44977d9f61e419c31458a5d7b23c6f55575e8e69d5ca#sha256:86f4a02807eb1a297aae44977d9f61e419c31458a5d7b23c6f55575e8e69d5ca", + "archive:https://erratique.ch/software/logs/releases/logs-0.7.0.tbz#sha256:86f4a02807eb1a297aae44977d9f61e419c31458a5d7b23c6f55575e8e69d5ca" ], "opam": { "name": "logs", @@ -1255,59 +1336,59 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/fmt@opam:0.9.0@87213963", - "@opam/cmdliner@opam:1.2.0@b0c6143c", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/fmt@opam:0.9.0@87213963", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/lambda-term@opam:3.3.1@ee145aff": { - "id": "@opam/lambda-term@opam:3.3.1@ee145aff", + "@opam/lambda-term@opam:3.3.2@0f91853c": { + "id": "@opam/lambda-term@opam:3.3.2@0f91853c", "name": "@opam/lambda-term", - "version": "opam:3.3.1", + "version": "opam:3.3.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/5b/5b77cbe096d56ae9157cb1fb55fb4e9028c89e841b1d2bfad4f13d8a1395db3c#sha256:5b77cbe096d56ae9157cb1fb55fb4e9028c89e841b1d2bfad4f13d8a1395db3c", - "archive:https://github.com/ocaml-community/lambda-term/releases/download/3.3.1/lambda-term-3.3.1.tbz#sha256:5b77cbe096d56ae9157cb1fb55fb4e9028c89e841b1d2bfad4f13d8a1395db3c" + "archive:https://opam.ocaml.org/cache/sha512/78/78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766#sha512:78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766", + "archive:https://github.com/ocaml-community/lambda-term/archive/refs/tags/3.3.2.tar.gz#sha512:78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766" ], "opam": { "name": "lambda-term", - "version": "3.3.1", - "path": "esy.lock/opam/lambda-term.3.3.1" + "version": "3.3.2", + "path": "esy.lock/opam/lambda-term.3.3.2" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/zed@opam:3.2.1@276736c0", + "ocaml@4.14.1000@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew_vi@opam:0.5.0@cf66c299", + "@opam/mew_vi@opam:0.5.0@d256e562", "@opam/lwt_react@opam:1.2.0@4253a145", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@a2c1229c", + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/zed@opam:3.2.1@276736c0", + "ocaml@4.14.1000@d41d8cd9", "@opam/zed@opam:3.2.3@57ab913c", "@opam/react@opam:1.2.2@e0f4480e", - "@opam/mew_vi@opam:0.5.0@cf66c299", + "@opam/mew_vi@opam:0.5.0@d256e562", "@opam/lwt_react@opam:1.2.0@4253a145", - "@opam/lwt@opam:5.6.1@2a9902ab", "@opam/logs@opam:0.7.0@46a3dffc", - "@opam/dune@opam:3.7.1@40db2f22" + "@opam/lwt@opam:5.7.0@4a33823d", "@opam/logs@opam:0.7.0@a2c1229c", + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/fpath@opam:0.7.3@674d8125": { - "id": "@opam/fpath@opam:0.7.3@674d8125", + "@opam/fpath@opam:0.7.3@ba8dd432": { + "id": "@opam/fpath@opam:0.7.3@ba8dd432", "name": "@opam/fpath", "version": "opam:0.7.3", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/07/0740b530e8fed5b0adc5eee8463cfc2f#md5:0740b530e8fed5b0adc5eee8463cfc2f", - "archive:https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz#md5:0740b530e8fed5b0adc5eee8463cfc2f" + "archive:https://opam.ocaml.org/cache/sha256/12/12b08ff192d037d9b6d69e9ca19d1d385184f20b3237c27231e437ac81ace70f#sha256:12b08ff192d037d9b6d69e9ca19d1d385184f20b3237c27231e437ac81ace70f", + "archive:https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz#sha256:12b08ff192d037d9b6d69e9ca19d1d385184f20b3237c27231e437ac81ace70f" ], "opam": { "name": "fpath", @@ -1317,14 +1398,14 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/astring@opam:0.8.5@1300cee8", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/astring@opam:0.8.5@6db2b8c5", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/astring@opam:0.8.5@1300cee8" + "ocaml@4.14.1000@d41d8cd9", "@opam/astring@opam:0.8.5@6db2b8c5" ] }, "@opam/fmt@opam:0.9.0@87213963": { @@ -1345,65 +1426,65 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", - "@opam/cmdliner@opam:1.2.0@b0c6143c", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/fix@opam:20220121@17b9a1a4": { - "id": "@opam/fix@opam:20220121@17b9a1a4", + "@opam/fix@opam:20230505@941a65ff": { + "id": "@opam/fix@opam:20230505@941a65ff", "name": "@opam/fix", - "version": "opam:20220121", + "version": "opam:20230505", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/48/48d8a5bdff23cf7fbf9288877df2b6aa#md5:48d8a5bdff23cf7fbf9288877df2b6aa", - "archive:https://gitlab.inria.fr/fpottier/fix/-/archive/20220121/archive.tar.gz#md5:48d8a5bdff23cf7fbf9288877df2b6aa" + "archive:https://opam.ocaml.org/cache/md5/2a/2a4afa633128c5010677222f7b3c9451#md5:2a4afa633128c5010677222f7b3c9451", + "archive:https://gitlab.inria.fr/fpottier/fix/-/archive/20230505/archive.tar.gz#md5:2a4afa633128c5010677222f7b3c9451" ], "opam": { "name": "fix", - "version": "20220121", - "path": "esy.lock/opam/fix.20220121" + "version": "20230505", + "path": "esy.lock/opam/fix.20230505" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/fiber@opam:3.6.2@349136be": { - "id": "@opam/fiber@opam:3.6.2@349136be", + "@opam/fiber@opam:3.7.0@bf633a34": { + "id": "@opam/fiber@opam:3.7.0@bf633a34", "name": "@opam/fiber", - "version": "opam:3.6.2", + "version": "opam:3.7.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/b6/b6d4ab848efb04aa2a325d0015d32ed4414ed7130ec7aa12f98158eff445cf3c#sha256:b6d4ab848efb04aa2a325d0015d32ed4414ed7130ec7aa12f98158eff445cf3c", - "archive:https://github.com/ocaml/dune/releases/download/3.6.2/dune-3.6.2.tbz#sha256:b6d4ab848efb04aa2a325d0015d32ed4414ed7130ec7aa12f98158eff445cf3c" + "archive:https://opam.ocaml.org/cache/sha256/86/8648a15ae93fe6942999ce36887429a3913b62829c4714e520cc0e7a1c3b9682#sha256:8648a15ae93fe6942999ce36887429a3913b62829c4714e520cc0e7a1c3b9682", + "archive:https://github.com/ocaml-dune/fiber/releases/download/3.7.0/fiber-lwt-3.7.0.tbz#sha256:8648a15ae93fe6942999ce36887429a3913b62829c4714e520cc0e7a1c3b9682" ], "opam": { "name": "fiber", - "version": "3.6.2", - "path": "esy.lock/opam/fiber.3.6.2" + "version": "3.7.0", + "path": "esy.lock/opam/fiber.3.7.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/dyn@opam:3.6.2@38120dfc": { @@ -1424,14 +1505,14 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", + "ocaml@4.14.1000@d41d8cd9", "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dune@opam:3.7.1@40db2f22", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/pp@opam:1.1.2@89ad03b5", + "ocaml@4.14.1000@d41d8cd9", "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dune@opam:3.7.1@40db2f22" + "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/dune-rpc@opam:3.6.2@d874b9d2": { @@ -1452,122 +1533,155 @@ }, "overrides": [], "dependencies": [ - "@opam/xdg@opam:3.7.1@387cb889", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "@opam/xdg@opam:3.7.1@387cb889", "@opam/stdune@opam:3.6.2@47d75c4b", - "@opam/pp@opam:1.1.2@89ad03b5", "@opam/ordering@opam:3.6.2@37bc3093", - "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7" + "@opam/xdg@opam:3.16.0@fccd8d01", "@opam/stdune@opam:3.6.2@47d75c4b", + "@opam/pp@opam:1.2.0@16430027", "@opam/ordering@opam:3.6.2@37bc3093", + "@opam/dyn@opam:3.6.2@38120dfc", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4" ] }, - "@opam/dune-configurator@opam:3.7.1@32ab7c21": { - "id": "@opam/dune-configurator@opam:3.7.1@32ab7c21", + "@opam/dune-configurator@opam:3.16.0@29bae660": { + "id": "@opam/dune-configurator@opam:3.16.0@29bae660", "name": "@opam/dune-configurator", - "version": "opam:3.7.1", + "version": "opam:3.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", - "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "archive:https://opam.ocaml.org/cache/sha256/54/5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6", + "archive:https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" ], "opam": { "name": "dune-configurator", - "version": "3.7.1", - "path": "esy.lock/opam/dune-configurator.3.7.1" + "version": "3.16.0", + "path": "esy.lock/opam/dune-configurator.3.16.0" } }, - "overrides": [], + "overrides": [ + { + "opamoverride": "esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override" + } + ], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", - "@opam/csexp@opam:1.5.1@8a8fb3a7", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/csexp@opam:1.5.2@46614bf4", "@opam/base-unix@opam:base@87d0b2eb" ] }, - "@opam/dune-build-info@opam:3.7.1@adf0d411": { - "id": "@opam/dune-build-info@opam:3.7.1@adf0d411", + "@opam/dune-build-info@opam:3.16.0@5123b882": { + "id": "@opam/dune-build-info@opam:3.16.0@5123b882", "name": "@opam/dune-build-info", - "version": "opam:3.7.1", + "version": "opam:3.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", - "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "archive:https://opam.ocaml.org/cache/sha256/54/5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6", + "archive:https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" ], "opam": { "name": "dune-build-info", - "version": "3.7.1", - "path": "esy.lock/opam/dune-build-info.3.7.1" + "version": "3.16.0", + "path": "esy.lock/opam/dune-build-info.3.16.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, - "@opam/dune@opam:3.7.1@40db2f22": { - "id": "@opam/dune@opam:3.7.1@40db2f22", + "@opam/dune@opam:3.16.0@33c4c9fe": { + "id": "@opam/dune@opam:3.16.0@33c4c9fe", "name": "@opam/dune", - "version": "opam:3.7.1", + "version": "opam:3.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", - "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "archive:https://opam.ocaml.org/cache/sha256/54/5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6", + "archive:https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" ], "opam": { "name": "dune", - "version": "3.7.1", - "path": "esy.lock/opam/dune.3.7.1" + "version": "3.16.0", + "path": "esy.lock/opam/dune.3.16.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", + "ocaml@4.14.1000@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", + "ocaml@4.14.1000@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", "@opam/base-threads@opam:base@36803084" ] }, - "@opam/csexp@opam:1.5.1@8a8fb3a7": { - "id": "@opam/csexp@opam:1.5.1@8a8fb3a7", + "@opam/csexp@opam:1.5.2@46614bf4": { + "id": "@opam/csexp@opam:1.5.2@46614bf4", "name": "@opam/csexp", - "version": "opam:1.5.1", + "version": "opam:1.5.2", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/d6/d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02#sha256:d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02", - "archive:https://github.com/ocaml-dune/csexp/releases/download/1.5.1/csexp-1.5.1.tbz#sha256:d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02" + "archive:https://opam.ocaml.org/cache/sha256/1a/1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff#sha256:1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff", + "archive:https://github.com/ocaml-dune/csexp/releases/download/1.5.2/csexp-1.5.2.tbz#sha256:1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff" ], "opam": { "name": "csexp", - "version": "1.5.1", - "path": "esy.lock/opam/csexp.1.5.1" + "version": "1.5.2", + "path": "esy.lock/opam/csexp.1.5.2" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" + ] + }, + "@opam/crunch@opam:3.3.1@e6228a2b": { + "id": "@opam/crunch@opam:3.3.1@e6228a2b", + "name": "@opam/crunch", + "version": "opam:3.3.1", + "source": { + "type": "install", + "source": [ + "archive:https://opam.ocaml.org/cache/sha256/2c/2c5ba0d4110bcbb7731cba4eafb6c44a7487c3f88c1ad47401271b69ffa8ed6a#sha256:2c5ba0d4110bcbb7731cba4eafb6c44a7487c3f88c1ad47401271b69ffa8ed6a", + "archive:https://github.com/mirage/ocaml-crunch/releases/download/v3.3.1/crunch-3.3.1.tbz#sha256:2c5ba0d4110bcbb7731cba4eafb6c44a7487c3f88c1ad47401271b69ffa8ed6a" + ], + "opam": { + "name": "crunch", + "version": "3.3.1", + "path": "esy.lock/opam/crunch.3.3.1" + } + }, + "overrides": [], + "dependencies": [ + "ocaml@4.14.1000@d41d8cd9", "@opam/ptime@opam:1.1.0@d6f12219", + "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3", + "@esy-ocaml/substs@0.0.1@d41d8cd9" + ], + "devDependencies": [ + "ocaml@4.14.1000@d41d8cd9", "@opam/ptime@opam:1.1.0@d6f12219", + "@opam/dune@opam:3.16.0@33c4c9fe", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3" ] }, "@opam/cppo@opam:1.6.9@db929a12": { @@ -1588,60 +1702,60 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/base-unix@opam:base@87d0b2eb", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@opam/base-unix@opam:base@87d0b2eb" ] }, - "@opam/cmdliner@opam:1.2.0@b0c6143c": { - "id": "@opam/cmdliner@opam:1.2.0@b0c6143c", + "@opam/cmdliner@opam:1.3.0@f8c5e0f3": { + "id": "@opam/cmdliner@opam:1.3.0@f8c5e0f3", "name": "@opam/cmdliner", - "version": "opam:1.2.0", + "version": "opam:1.3.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha512/6f/6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b#sha512:6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b", - "archive:https://erratique.ch/software/cmdliner/releases/cmdliner-1.2.0.tbz#sha512:6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b" + "archive:https://opam.ocaml.org/cache/sha512/4c/4c46bc334444ff772637deae2f5ba03645d7a1b7db523470a1246acfce79b971c764d964cbb02388639b3161b279700d9ade95da550446fb32aa4849c8a8f283#sha512:4c46bc334444ff772637deae2f5ba03645d7a1b7db523470a1246acfce79b971c764d964cbb02388639b3161b279700d9ade95da550446fb32aa4849c8a8f283", + "archive:https://erratique.ch/software/cmdliner/releases/cmdliner-1.3.0.tbz#sha512:4c46bc334444ff772637deae2f5ba03645d7a1b7db523470a1246acfce79b971c764d964cbb02388639b3161b279700d9ade95da550446fb32aa4849c8a8f283" ], "opam": { "name": "cmdliner", - "version": "1.2.0", - "path": "esy.lock/opam/cmdliner.1.2.0" + "version": "1.3.0", + "path": "esy.lock/opam/cmdliner.1.3.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" + "ocaml@4.14.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, - "@opam/chrome-trace@opam:3.7.1@92d3c503": { - "id": "@opam/chrome-trace@opam:3.7.1@92d3c503", + "@opam/chrome-trace@opam:3.16.0@968aeb8c": { + "id": "@opam/chrome-trace@opam:3.16.0@968aeb8c", "name": "@opam/chrome-trace", - "version": "opam:3.7.1", + "version": "opam:3.16.0", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/sha256/ad/adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3", - "archive:https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz#sha256:adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" + "archive:https://opam.ocaml.org/cache/sha256/54/5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6", + "archive:https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz#sha256:5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" ], "opam": { "name": "chrome-trace", - "version": "3.7.1", - "path": "esy.lock/opam/chrome-trace.3.7.1" + "version": "3.16.0", + "path": "esy.lock/opam/chrome-trace.3.16.0" } }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/camlp-streams@opam:5.0.1@daaa0f94": { @@ -1662,11 +1776,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22", + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/dune@opam:3.7.1@40db2f22" + "ocaml@4.14.1000@d41d8cd9", "@opam/dune@opam:3.16.0@33c4c9fe" ] }, "@opam/base-unix@opam:base@87d0b2eb": { @@ -1718,11 +1832,11 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocamlfind@opam:1.9.5@e83abf74", + "ocaml@4.14.1000@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@923e2274", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/ocamlfind@opam:1.9.5@e83abf74" + "ocaml@4.14.1000@d41d8cd9", "@opam/ocamlfind@opam:1.9.6@923e2274" ] }, "@opam/base-bigarray@opam:base@b03491b0": { @@ -1742,15 +1856,15 @@ "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], "devDependencies": [] }, - "@opam/astring@opam:0.8.5@1300cee8": { - "id": "@opam/astring@opam:0.8.5@1300cee8", + "@opam/astring@opam:0.8.5@6db2b8c5": { + "id": "@opam/astring@opam:0.8.5@6db2b8c5", "name": "@opam/astring", "version": "opam:0.8.5", "source": { "type": "install", "source": [ - "archive:https://opam.ocaml.org/cache/md5/e1/e148907c24157d1df43bec89b58b3ec8#md5:e148907c24157d1df43bec89b58b3ec8", - "archive:https://erratique.ch/software/astring/releases/astring-0.8.5.tbz#md5:e148907c24157d1df43bec89b58b3ec8" + "archive:https://opam.ocaml.org/cache/sha256/86/865692630c07c3ab87c66cdfc2734c0fdfc9c34a57f8e89ffec7c7d15e7a70fa#sha256:865692630c07c3ab87c66cdfc2734c0fdfc9c34a57f8e89ffec7c7d15e7a70fa", + "archive:https://erratique.ch/software/astring/releases/astring-0.8.5.tbz#sha256:865692630c07c3ab87c66cdfc2734c0fdfc9c34a57f8e89ffec7c7d15e7a70fa" ], "opam": { "name": "astring", @@ -1760,12 +1874,12 @@ }, "overrides": [], "dependencies": [ - "ocaml@4.14.0@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", - "@opam/ocamlfind@opam:1.9.5@e83abf74", - "@opam/ocamlbuild@opam:0.14.2@c6163b28", + "ocaml@4.14.1000@d41d8cd9", "@opam/topkg@opam:1.0.7@7ee47d76", + "@opam/ocamlfind@opam:1.9.6@923e2274", + "@opam/ocamlbuild@opam:0.14.3+win@17a8bb46", "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [ "ocaml@4.14.0@d41d8cd9" ] + "devDependencies": [ "ocaml@4.14.1000@d41d8cd9" ] }, "@esy-ocaml/substs@0.0.1@d41d8cd9": { "id": "@esy-ocaml/substs@0.0.1@d41d8cd9", diff --git a/esy.lock/opam/astring.0.8.5/opam b/esy.lock/opam/astring.0.8.5/opam index 338a06a3e..ae270e014 100644 --- a/esy.lock/opam/astring.0.8.5/opam +++ b/esy.lock/opam/astring.0.8.5/opam @@ -32,6 +32,9 @@ Astring depends only on the OCaml standard library. It is distributed under the ISC license. """ url { -archive: "https://erratique.ch/software/astring/releases/astring-0.8.5.tbz" -checksum: "e148907c24157d1df43bec89b58b3ec8" + src: "https://erratique.ch/software/astring/releases/astring-0.8.5.tbz" + checksum: [ + "sha256=865692630c07c3ab87c66cdfc2734c0fdfc9c34a57f8e89ffec7c7d15e7a70fa" + "md5=e148907c24157d1df43bec89b58b3ec8" + ] } diff --git a/esy.lock/opam/chrome-trace.3.7.1/opam b/esy.lock/opam/chrome-trace.3.16.0/opam similarity index 66% rename from esy.lock/opam/chrome-trace.3.7.1/opam rename to esy.lock/opam/chrome-trace.3.16.0/opam index 74649f970..37deaac1c 100644 --- a/esy.lock/opam/chrome-trace.3.7.1/opam +++ b/esy.lock/opam/chrome-trace.3.16.0/opam @@ -9,7 +9,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.5"} + "dune" {>= "3.12"} "ocaml" {>= "4.08.0"} "odoc" {with-doc} ] @@ -30,10 +30,11 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" + src: + "https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz" checksum: [ - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" + "sha256=5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" + "sha512=529f937c61bc9ea7b135c2425f2d730478b48e6ab6b6455c354138d27b76bd43afce40d4784a6f183d6308d3cf0f5d5cea5bea070f83442949762ed818fb44bc" ] } -x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" +x-commit-hash: "e4380ffddbdf924b3ec4c56048cd8331e1bf39ed" diff --git a/esy.lock/opam/cmdliner.1.2.0/opam b/esy.lock/opam/cmdliner.1.3.0/opam similarity index 90% rename from esy.lock/opam/cmdliner.1.2.0/opam rename to esy.lock/opam/cmdliner.1.3.0/opam index b29bd296e..fa9ba3bc5 100644 --- a/esy.lock/opam/cmdliner.1.2.0/opam +++ b/esy.lock/opam/cmdliner.1.3.0/opam @@ -33,7 +33,7 @@ install: [ ] dev-repo: "git+https://erratique.ch/repos/cmdliner.git" url { - src: "https://erratique.ch/software/cmdliner/releases/cmdliner-1.2.0.tbz" + src: "https://erratique.ch/software/cmdliner/releases/cmdliner-1.3.0.tbz" checksum: - "sha512=6fcd6a59a6fbc6986b1aecdc3e4ce7a0dc43c65a16b427d6caa5504b10b51384f6b0bc703af646b09f5f1caeb6827b37d4480ce350ca8006204c850785f2810b" + "sha512=4c46bc334444ff772637deae2f5ba03645d7a1b7db523470a1246acfce79b971c764d964cbb02388639b3161b279700d9ade95da550446fb32aa4849c8a8f283" } \ No newline at end of file diff --git a/esy.lock/opam/crunch.3.3.1/opam b/esy.lock/opam/crunch.3.3.1/opam new file mode 100644 index 000000000..8905e6436 --- /dev/null +++ b/esy.lock/opam/crunch.3.3.1/opam @@ -0,0 +1,53 @@ +opam-version: "2.0" +maintainer: "MirageOS team" +authors: ["Anil Madhavapeddy" "Thomas Gazagnaire" "Stefanie Schirmer" "Hannes Mehnert"] +homepage: "https://github.com/mirage/ocaml-crunch" +bug-reports: "https://github.com/mirage/ocaml-crunch/issues" +doc: "https://mirage.github.io/ocaml-crunch/" +license: "ISC" +dev-repo: "git+https://github.com/mirage/ocaml-crunch.git" +tags: ["org:mirage" "org:xapi-project"] + +depends: [ + "ocaml" {>= "4.08.0"} + "cmdliner" {>= "1.1"} + "ptime" + "dune" {>= "2.5"} + "lwt" {with-test} + "mirage-kv" {with-test & >= "3.0.0"} + "mirage-kv-mem" {with-test & >= "3.0.0"} + "fmt" {with-test} +] +conflicts: [ + "mirage-kv" {< "3.0.0"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +synopsis: "Convert a filesystem into a static OCaml module" +description: """ +`ocaml-crunch` takes a directory of files and compiles them into a standalone +OCaml module which serves the contents directly from memory. This can be +convenient for libraries that need a few embedded files (such as a web server) +and do not want to deal with all the trouble of file configuration. +""" +url { + src: + "https://github.com/mirage/ocaml-crunch/releases/download/v3.3.1/crunch-3.3.1.tbz" + checksum: [ + "sha256=2c5ba0d4110bcbb7731cba4eafb6c44a7487c3f88c1ad47401271b69ffa8ed6a" + "sha512=5aaa1b67456dd2f5e3ab450ea547e62fba2b0341a49f3b24669162dce91b6ea1158c1594d60c6df3e416e719484411c50ae61017c40b2f75ee90401aa543bd08" + ] +} +x-commit-hash: "bd4f0195b35c602b8b83886bc8731e649b1e3f9c" diff --git a/esy.lock/opam/csexp.1.5.1/opam b/esy.lock/opam/csexp.1.5.2/opam similarity index 70% rename from esy.lock/opam/csexp.1.5.1/opam rename to esy.lock/opam/csexp.1.5.2/opam index 59324f9e2..7d511ab80 100644 --- a/esy.lock/opam/csexp.1.5.1/opam +++ b/esy.lock/opam/csexp.1.5.2/opam @@ -20,7 +20,7 @@ module of this library is parameterised by the type of S-expressions. maintainer: ["Jeremie Dimino "] authors: [ "Quentin Hocquet " - "Jane Street Group, LLC" + "Jane Street Group, LLC " "Jeremie Dimino " ] license: "MIT" @@ -28,9 +28,8 @@ homepage: "https://github.com/ocaml-dune/csexp" doc: "https://ocaml-dune.github.io/csexp/" bug-reports: "https://github.com/ocaml-dune/csexp/issues" depends: [ - "dune" {>= "1.11"} + "dune" {>= "3.4"} "ocaml" {>= "4.03.0"} -# "ppx_expect" {with-test & >= "v0.14"} "odoc" {with-doc} ] dev-repo: "git+https://github.com/ocaml-dune/csexp.git" @@ -44,17 +43,16 @@ build: [ "-j" jobs "@install" -# Tests disabled because of a cyclic dependency with csexp, dune-configurator and ppx_expect -# "@runtest" {with-test} +# "@runtest" {with-test & ocaml:version >= "4.04"} "@doc" {with-doc} ] ] -x-commit-hash: "7eeb86206819d2b1782d6cde1be9d6cf8b5fc851" url { src: - "https://github.com/ocaml-dune/csexp/releases/download/1.5.1/csexp-1.5.1.tbz" + "https://github.com/ocaml-dune/csexp/releases/download/1.5.2/csexp-1.5.2.tbz" checksum: [ - "sha256=d605e4065fa90a58800440ef2f33a2d931398bf2c22061a8acb7df845c0aac02" - "sha512=d785bbabaff9f6bf601399149ef0a42e5e99647b54e27f97ef1625907793dda22a45bf83e0e8a1eba2c63634c5484b54739ff0904ef556f5fc592efa38af7505" + "sha256=1a14dd04bb4379a41990248550628c77913a9c07f3c35c1370b6960e697787ff" + "sha512=be281018bcfc20d4db14894ef51c4b836d6338d2fdfe22e63d46f405f8dea7349e16f1c0ecd65f73d4c85a2a80e618cdbb8c9dafcbb9f229f04f1adca5b1973c" ] } +x-commit-hash: "e6c4768e10c61bcb04d09748744dad55602149c6" diff --git a/esy.lock/opam/dune-build-info.3.7.1/opam b/esy.lock/opam/dune-build-info.3.16.0/opam similarity index 73% rename from esy.lock/opam/dune-build-info.3.7.1/opam rename to esy.lock/opam/dune-build-info.3.16.0/opam index 45de3528d..8e285d797 100644 --- a/esy.lock/opam/dune-build-info.3.7.1/opam +++ b/esy.lock/opam/dune-build-info.3.16.0/opam @@ -15,7 +15,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.5"} + "dune" {>= "3.12"} "ocaml" {>= "4.08"} "odoc" {with-doc} ] @@ -36,10 +36,11 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" + src: + "https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz" checksum: [ - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" + "sha256=5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" + "sha512=529f937c61bc9ea7b135c2425f2d730478b48e6ab6b6455c354138d27b76bd43afce40d4784a6f183d6308d3cf0f5d5cea5bea070f83442949762ed818fb44bc" ] } -x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" +x-commit-hash: "e4380ffddbdf924b3ec4c56048cd8331e1bf39ed" diff --git a/esy.lock/opam/dune-configurator.3.7.1/opam b/esy.lock/opam/dune-configurator.3.16.0/opam similarity index 73% rename from esy.lock/opam/dune-configurator.3.7.1/opam rename to esy.lock/opam/dune-configurator.3.16.0/opam index be511dfee..27c7d7e56 100644 --- a/esy.lock/opam/dune-configurator.3.7.1/opam +++ b/esy.lock/opam/dune-configurator.3.16.0/opam @@ -17,7 +17,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.5"} + "dune" {>= "3.12"} "ocaml" {>= "4.04.0"} "base-unix" "csexp" {>= "1.5.0"} @@ -40,10 +40,11 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" + src: + "https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz" checksum: [ - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" + "sha256=5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" + "sha512=529f937c61bc9ea7b135c2425f2d730478b48e6ab6b6455c354138d27b76bd43afce40d4784a6f183d6308d3cf0f5d5cea5bea070f83442949762ed818fb44bc" ] } -x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" +x-commit-hash: "e4380ffddbdf924b3ec4c56048cd8331e1bf39ed" diff --git a/esy.lock/opam/dune.3.7.1/opam b/esy.lock/opam/dune.3.16.0/opam similarity index 69% rename from esy.lock/opam/dune.3.7.1/opam rename to esy.lock/opam/dune.3.16.0/opam index 4a739625d..638f8d9cb 100644 --- a/esy.lock/opam/dune.3.7.1/opam +++ b/esy.lock/opam/dune.3.16.0/opam @@ -2,19 +2,19 @@ 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 +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 +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. +Dune is composable; supporting multi-package development by simply +dropping multiple repositories into the same directory. -It also supports multi-context builds, such as building against +Dune 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. @@ -47,10 +47,11 @@ depends: [ "base-threads" ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" + src: + "https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz" checksum: [ - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" + "sha256=5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" + "sha512=529f937c61bc9ea7b135c2425f2d730478b48e6ab6b6455c354138d27b76bd43afce40d4784a6f183d6308d3cf0f5d5cea5bea070f83442949762ed818fb44bc" ] } -x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" +x-commit-hash: "e4380ffddbdf924b3ec4c56048cd8331e1bf39ed" diff --git a/esy.lock/opam/fiber.3.6.2/opam b/esy.lock/opam/fiber.3.6.2/opam deleted file mode 100644 index 304d921b8..000000000 --- a/esy.lock/opam/fiber.3.6.2/opam +++ /dev/null @@ -1,41 +0,0 @@ -opam-version: "2.0" -synopsis: "Structured concurrency library" -description: - "This library offers no backwards compatibility guarantees. Use at your own risk." -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" -depends: [ - "dune" {>= "3.5"} - "ocaml" {>= "4.08.0"} - "stdune" {= version} - "dyn" {= version} - "odoc" {with-doc} -] -dev-repo: "git+https://github.com/ocaml/dune.git" -build: [ - ["dune" "subst"] {dev} - ["rm" "-rf" "vendor/csexp"] - ["rm" "-rf" "vendor/pp"] - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@doc" {with-doc} - ] -] -url { - src: "https://github.com/ocaml/dune/releases/download/3.6.2/dune-3.6.2.tbz" - checksum: [ - "sha256=b6d4ab848efb04aa2a325d0015d32ed4414ed7130ec7aa12f98158eff445cf3c" - "sha512=d0dd69ada2f1583319a2d6f679b8d49998059117c3258805ee69ae3e71d47bfab7a9c646f19b5fc43a6ccdef934eb87de5bb81205fcd60968bed8bf1790cf0a3" - ] -} -x-commit-hash: "c939c2b0f7a470cedd189988c61cd307a3cedace" diff --git a/esy.lock/opam/fiber.3.7.0/opam b/esy.lock/opam/fiber.3.7.0/opam new file mode 100644 index 000000000..fbf728c37 --- /dev/null +++ b/esy.lock/opam/fiber.3.7.0/opam @@ -0,0 +1,39 @@ +opam-version: "2.0" +synopsis: "Dune's monadic structured concurrency library" +maintainer: ["Jane Street Group, LLC "] +authors: ["Jane Street Group, LLC "] +license: "MIT" +homepage: "https://github.com/ocaml-dune/fiber" +bug-reports: "https://github.com/ocaml-dune/fiber/issues" +depends: [ + "dune" {>= "3.6"} + "ocaml" {>= "4.08"} + "ppx_expect" {with-test & < "v0.17"} + "dyn" + "stdune" + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test & ocaml:version >= "4.13"} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-dune/fiber.git" +url { + src: + "https://github.com/ocaml-dune/fiber/releases/download/3.7.0/fiber-lwt-3.7.0.tbz" + checksum: [ + "sha256=8648a15ae93fe6942999ce36887429a3913b62829c4714e520cc0e7a1c3b9682" + "sha512=348b28b28ffd87de035e90753f677658e8ad58421caf3ac086e4c0bbab8508fa5fe2f55d137c425afaf790ebcf45291e16d70eac5cb766b6d9786f042b58b19b" + ] +} +x-commit-hash: "dd66893a530759da26b66bd1c8939fd77f369afb" diff --git a/esy.lock/opam/fix.20220121/opam b/esy.lock/opam/fix.20230505/opam similarity index 67% rename from esy.lock/opam/fix.20220121/opam rename to esy.lock/opam/fix.20230505/opam index 877b44e66..6278f49e6 100644 --- a/esy.lock/opam/fix.20220121/opam +++ b/esy.lock/opam/fix.20230505/opam @@ -18,9 +18,9 @@ depends: [ synopsis: "Algorithmic building blocks for memoization, recursion, and more" url { src: - "https://gitlab.inria.fr/fpottier/fix/-/archive/20220121/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/fix/-/archive/20230505/archive.tar.gz" checksum: [ - "md5=48d8a5bdff23cf7fbf9288877df2b6aa" - "sha512=a851d8783c0c519c6e55359a5c471af433058872409c29a1a7bdfd0076813341ad2c0ebd1ce9e28bff4d4c729dfbc808c41c084fe12a42b45a2b5e391e77ccd2" + "md5=2a4afa633128c5010677222f7b3c9451" + "sha512=30d446ba6c19aef78b52d9831eb26f8f6ac10e88bd1eff36d16fbbfb32278b2637e31e63a160aec4abbbfdb1e7612ed25d68c936f4cbf2073e51d713ff3a8adf" ] } diff --git a/esy.lock/opam/fpath.0.7.3/opam b/esy.lock/opam/fpath.0.7.3/opam index ae3336e42..84350ace0 100644 --- a/esy.lock/opam/fpath.0.7.3/opam +++ b/esy.lock/opam/fpath.0.7.3/opam @@ -31,6 +31,9 @@ license. [astring]: http://erratique.ch/software/astring """ url { -archive: "https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz" -checksum: "0740b530e8fed5b0adc5eee8463cfc2f" + src: "https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz" + checksum: [ + "sha256=12b08ff192d037d9b6d69e9ca19d1d385184f20b3237c27231e437ac81ace70f" + "md5=0740b530e8fed5b0adc5eee8463cfc2f" + ] } diff --git a/esy.lock/opam/lambda-term.3.3.1/opam b/esy.lock/opam/lambda-term.3.3.2/opam similarity index 74% rename from esy.lock/opam/lambda-term.3.3.1/opam rename to esy.lock/opam/lambda-term.3.3.2/opam index 3a814ebae..66fc69572 100644 --- a/esy.lock/opam/lambda-term.3.3.1/opam +++ b/esy.lock/opam/lambda-term.3.3.2/opam @@ -8,7 +8,7 @@ to provide a higher level functional interface to terminal manipulation than, for example, ncurses, by providing a native OCaml interface instead of bindings to a C library. Lambda-term integrates with zed to provide text edition facilities in console applications.""" -maintainer: ["opam-devel@lists.ocaml.org"] +maintainer: ["ZAN DoYe "] authors: ["Jérémie Dimino"] license: "BSD-3-Clause" homepage: "https://github.com/ocaml-community/lambda-term" @@ -41,10 +41,9 @@ build: [ dev-repo: "git+https://github.com/ocaml-community/lambda-term.git" url { src: - "https://github.com/ocaml-community/lambda-term/releases/download/3.3.1/lambda-term-3.3.1.tbz" + "https://github.com/ocaml-community/lambda-term/archive/refs/tags/3.3.2.tar.gz" checksum: [ - "sha256=5b77cbe096d56ae9157cb1fb55fb4e9028c89e841b1d2bfad4f13d8a1395db3c" - "sha512=d7968ad000c9c7e899ffb7fdd0016009f41c71d9fad4897decbe66ea24140ab1ee8428fd550c7b8016e7f6343f41e7abd53b52b5f2bf6bb85b4de64f12ac9161" + "sha512=78648768644058337e22c79cf1fbb1a36472b24f11b1dc0461fc38419be6ec01b02d8d0ac45fed0bc99f91ba4c0f19d3bda113e834e064bee973b734527b9766" ] } -x-commit-hash: "f6b1940863e94d437a0578e19076a342bc9b5a70" +x-commit-hash: "cade31f3c56f1e52fa6d297ddb78f37d09062761" diff --git a/esy.lock/opam/logs.0.7.0/opam b/esy.lock/opam/logs.0.7.0/opam index c803bafdb..4dc59954a 100644 --- a/esy.lock/opam/logs.0.7.0/opam +++ b/esy.lock/opam/logs.0.7.0/opam @@ -61,6 +61,9 @@ Logs and its reporters are distributed under the ISC license. [lwt]: http://ocsigen.org/lwt/ """ url { -archive: "https://erratique.ch/software/logs/releases/logs-0.7.0.tbz" -checksum: "2bf021ca13331775e33cf34ab60246f7" + src: "https://erratique.ch/software/logs/releases/logs-0.7.0.tbz" + checksum: [ + "sha256=86f4a02807eb1a297aae44977d9f61e419c31458a5d7b23c6f55575e8e69d5ca" + "md5=2bf021ca13331775e33cf34ab60246f7" + ] } diff --git a/esy.lock/opam/lwt.5.6.1/opam b/esy.lock/opam/lwt.5.7.0/opam similarity index 83% rename from esy.lock/opam/lwt.5.6.1/opam rename to esy.lock/opam/lwt.5.7.0/opam index fa437b76b..8366437df 100644 --- a/esy.lock/opam/lwt.5.6.1/opam +++ b/esy.lock/opam/lwt.5.7.0/opam @@ -49,9 +49,9 @@ Meanwhile, OCaml code, including code creating and waiting on promises, runs in a single thread by default. This reduces the need for locks or other synchronization primitives. Code can be run in parallel on an opt-in basis." url { - src: "https://github.com/ocsigen/lwt/archive/5.6.1.tar.gz" + src: "https://github.com/ocsigen/lwt/archive/refs/tags/5.7.0.tar.gz" checksum: [ - "md5=279024789a0ec84a9d97d98bad847f97" - "sha512=698875bd3bfcd5baa47eb48e412f442d289f9972421321541860ebe110b9af1949c3fbc253768495726ec547fe4ba25483cd97ff39bc668496fba95b2ed9edd8" + "md5=737039d29d45b2d2b35db6931c8d75c6" + "sha512=42e629920783428673b99c9d7a639237c9e6b35079b5d907bc67e7ea506acf9edadc48cec580bdcfd2410ed9412bf5e6bcc8b09de2fa7d35ce1490973d05ddd1" ] } diff --git a/esy.lock/opam/menhir.20230415/opam b/esy.lock/opam/menhir.20231231/opam similarity index 69% rename from esy.lock/opam/menhir.20230415/opam rename to esy.lock/opam/menhir.20231231/opam index d61711fc0..adf52bf18 100644 --- a/esy.lock/opam/menhir.20230415/opam +++ b/esy.lock/opam/menhir.20231231/opam @@ -17,13 +17,14 @@ depends: [ "dune" {>= "2.8.0"} "menhirLib" {= version} "menhirSdk" {= version} + "menhirCST" {= version} ] synopsis: "An LR(1) parser generator" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz" checksum: [ - "md5=7c4b51e1b666711af04f7832ebc90618" - "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" + "md5=799748bc3b7a542798a85956c7863865" + "sha512=620ff3443143535e03ac98c5e8ee2ddf9ba48f8cfe441302118def1da3e03ffac7f48d4d4cb129766b625ecad0fb341da1baa0169dee8b6d07a5b0bbb735cf2f" ] } diff --git a/esy.lock/opam/menhirCST.20231231/opam b/esy.lock/opam/menhirCST.20231231/opam new file mode 100644 index 000000000..9a49a8590 --- /dev/null +++ b/esy.lock/opam/menhirCST.20231231/opam @@ -0,0 +1,29 @@ + +opam-version: "2.0" +maintainer: "francois.pottier@inria.fr" +authors: [ + "François Pottier " +] +homepage: "http://gitlab.inria.fr/fpottier/menhir" +dev-repo: "git+https://gitlab.inria.fr/fpottier/menhir.git" +bug-reports: "https://gitlab.inria.fr/fpottier/menhir/-/issues" +license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" +build: [ + ["dune" "build" "-p" name "-j" jobs] +] +depends: [ + "ocaml" { >= "4.08" } + "dune" { >= "2.8.0" } +] +conflicts: [ + "menhir" { != version } +] +synopsis: "Runtime support library for parsers generated by Menhir" +url { + src: + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz" + checksum: [ + "md5=799748bc3b7a542798a85956c7863865" + "sha512=620ff3443143535e03ac98c5e8ee2ddf9ba48f8cfe441302118def1da3e03ffac7f48d4d4cb129766b625ecad0fb341da1baa0169dee8b6d07a5b0bbb735cf2f" + ] +} diff --git a/esy.lock/opam/menhirLib.20230415/opam b/esy.lock/opam/menhirLib.20231231/opam similarity index 73% rename from esy.lock/opam/menhirLib.20230415/opam rename to esy.lock/opam/menhirLib.20231231/opam index 6673506d3..1f321b184 100644 --- a/esy.lock/opam/menhirLib.20230415/opam +++ b/esy.lock/opam/menhirLib.20231231/opam @@ -22,9 +22,9 @@ conflicts: [ synopsis: "Runtime support library for parsers generated by Menhir" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz" checksum: [ - "md5=7c4b51e1b666711af04f7832ebc90618" - "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" + "md5=799748bc3b7a542798a85956c7863865" + "sha512=620ff3443143535e03ac98c5e8ee2ddf9ba48f8cfe441302118def1da3e03ffac7f48d4d4cb129766b625ecad0fb341da1baa0169dee8b6d07a5b0bbb735cf2f" ] } diff --git a/esy.lock/opam/menhirSdk.20230415/opam b/esy.lock/opam/menhirSdk.20231231/opam similarity index 73% rename from esy.lock/opam/menhirSdk.20230415/opam rename to esy.lock/opam/menhirSdk.20231231/opam index 57f8ea866..0e2649fcc 100644 --- a/esy.lock/opam/menhirSdk.20230415/opam +++ b/esy.lock/opam/menhirSdk.20231231/opam @@ -22,9 +22,9 @@ conflicts: [ synopsis: "Compile-time library for auxiliary tools related to Menhir" url { src: - "https://gitlab.inria.fr/fpottier/menhir/-/archive/20230415/archive.tar.gz" + "https://gitlab.inria.fr/fpottier/menhir/-/archive/20231231/archive.tar.gz" checksum: [ - "md5=7c4b51e1b666711af04f7832ebc90618" - "sha512=aa8a34c173d9a82d3503919de8377f1b8c9ff721882486f0b5ae2bdb9b22ee7f5ba8f6ef25e00fbb35704fac9fc3bda71908512ed4cbd345d9dc29d6ede149b2" + "md5=799748bc3b7a542798a85956c7863865" + "sha512=620ff3443143535e03ac98c5e8ee2ddf9ba48f8cfe441302118def1da3e03ffac7f48d4d4cb129766b625ecad0fb341da1baa0169dee8b6d07a5b0bbb735cf2f" ] } diff --git a/esy.lock/opam/mew.0.1.0/opam b/esy.lock/opam/mew.0.1.0/opam index 20aee1ea9..2b94ac6fc 100644 --- a/esy.lock/opam/mew.0.1.0/opam +++ b/esy.lock/opam/mew.0.1.0/opam @@ -21,5 +21,8 @@ This is the core module of mew, a general modal editing engine generator.""" url { src: "https://github.com/kandu/mew/archive/0.1.0.tar.gz" - checksum: "md5=2298149d1415cd804ab4e01f01ea10a0" + checksum: [ + "sha256=64d38ceb52ef574cb314bdd693f7e4a9c9e483e80a58595db22f2df76a8a59e6" + "md5=2298149d1415cd804ab4e01f01ea10a0" + ] } diff --git a/esy.lock/opam/mew_vi.0.5.0/opam b/esy.lock/opam/mew_vi.0.5.0/opam index 033b9fd71..a73b37aff 100644 --- a/esy.lock/opam/mew_vi.0.5.0/opam +++ b/esy.lock/opam/mew_vi.0.5.0/opam @@ -21,5 +21,8 @@ A vi-like modal editing engine generator.""" url { src: "https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz" - checksum: "md5=341e9a9a20383641015bf503952906bc" + checksum: [ + "sha256=a692fa7cdcc9e80fd9387c4f61677776b9fc15f9f7175b4220fcd1a73d1bafda" + "md5=341e9a9a20383641015bf503952906bc" + ] } diff --git a/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam b/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam index 14c9f7537..a2df8c615 100644 --- a/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam +++ b/esy.lock/opam/ocaml-compiler-libs.v0.12.4/opam @@ -10,7 +10,7 @@ homepage: "https://github.com/janestreet/ocaml-compiler-libs" bug-reports: "https://github.com/janestreet/ocaml-compiler-libs/issues" depends: [ "dune" {>= "2.8"} - "ocaml" {>= "4.04.1"} + "ocaml" {>= "4.04.1" & < "5.2.0"} "odoc" {with-doc} ] build: [ diff --git a/esy.lock/opam/ocamlbuild.0.14.2/opam b/esy.lock/opam/ocamlbuild.0.14.3+win/opam similarity index 50% rename from esy.lock/opam/ocamlbuild.0.14.2/opam rename to esy.lock/opam/ocamlbuild.0.14.3+win/opam index 74bfbb272..7c19352f5 100644 --- a/esy.lock/opam/ocamlbuild.0.14.2/opam +++ b/esy.lock/opam/ocamlbuild.0.14.3+win/opam @@ -15,25 +15,24 @@ conflicts: [ "ocamlfind" {< "1.6.2"} ] build: [ - [ - make - "-f" - "configure.make" - "all" - "OCAMLBUILD_PREFIX=%{prefix}%" - "OCAMLBUILD_BINDIR=%{bin}%" - "OCAMLBUILD_LIBDIR=%{lib}%" - "OCAMLBUILD_MANDIR=%{man}%" - "OCAML_NATIVE=%{ocaml:native}%" - "OCAML_NATIVE_TOOLS=%{ocaml:native}%" - ] - [make "check-if-preinstalled" "all" "opam-install"] + [make "all"] +] +install: [ + [make "install"] + ["mkdir" "-p" "%{lib}%/ocamlbuild"] + ["install" "-m" "0644" "META" "%{lib}%/ocamlbuild"] ] dev-repo: "git+https://github.com/ocaml/ocamlbuild.git" url { - src: "https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.2.tar.gz" + src: "https://github.com/ocaml/ocamlbuild/archive/refs/tags/0.14.3.tar.gz" checksum: [ - "md5=2f407fadd57b073155a6aead887d9676" - "sha512=f568bf10431a1f701e8bd7554dc662400a0d978411038bbad93d44dceab02874490a8a5886a9b44e017347e7949997f13f5c3752f74e1eb5e273d2beb19a75fd" + "md5=220df59060c916e8aac2eb471c870485" + "sha512=def8fa1d5488905fda31f72b7f6f0ebdccefa55a8e984a6ea4a7c1e0856e8ea1f7814410202e0f7f7d5e72aca7e8ae0d6623f7f2bade78b0dd82155de76ec4e5" ] -} \ No newline at end of file +} +extra-source "ocamlbuild-0.14.2.patch" { + src: "https://raw.githubusercontent.com/ocaml-opam/opam-repository-mingw/354a87b397856f2a70024c5c83fc5001074935b6/packages/ocamlbuild/ocamlbuild.0.14.2/files/ocamlbuild-0.14.2.patch" + checksum: "sha256=a9b7e1829a3304e5a073d8ddea29d3d8272698e93b7e1ee659ae5e31e5cfb6b9" +} +patches: "ocamlbuild-0.14.2.patch" +available: os = "win32" diff --git a/esy.lock/opam/ocamlfind.1.9.5/files/0001-Fix-bug-when-installing-with-a-system-compiler.patch b/esy.lock/opam/ocamlfind.1.9.5/files/0001-Fix-bug-when-installing-with-a-system-compiler.patch deleted file mode 100644 index c05089900..000000000 --- a/esy.lock/opam/ocamlfind.1.9.5/files/0001-Fix-bug-when-installing-with-a-system-compiler.patch +++ /dev/null @@ -1,26 +0,0 @@ -From f53247f546375972789b96c3f612cd7f524bf2aa Mon Sep 17 00:00:00 2001 -From: Louis Gesbert -Date: Mon, 11 Jul 2022 18:12:18 +0200 -Subject: [PATCH] Fix bug when installing with a system compiler - -See https://discuss.ocaml.org/t/problem-installing-ocamlfind-on-latest-ocamlpro-alpine-docker-image/10147 ---- - src/findlib/Makefile | 2 +- - 1 file changed, 1 insertion(+), 1 deletion(-) - -diff --git a/src/findlib/Makefile b/src/findlib/Makefile -index 84514b6f22..ea23f4a10c 100644 ---- a/src/findlib/Makefile -+++ b/src/findlib/Makefile -@@ -123,7 +123,7 @@ clean: - install: all - $(INSTALLDIR) "$(DESTDIR)$(prefix)$(OCAML_SITELIB)/$(NAME)" - $(INSTALLDIR) "$(DESTDIR)$(prefix)$(OCAMLFIND_BIN)" -- $(INSTALLDIR) "$(DESTDIR)$(prefix)$(OCAML_CORE_STDLIB)" -+ test $(INSTALL_TOPFIND) -eq 0 || $(INSTALLDIR) "$(DESTDIR)$(prefix)$(OCAML_CORE_STDLIB)" - test $(INSTALL_TOPFIND) -eq 0 || $(INSTALLFILE) topfind "$(DESTDIR)$(prefix)$(OCAML_CORE_STDLIB)/" - files=`$(SH) $(TOP)/tools/collect_files $(TOP)/Makefile.config \ - findlib.cmi findlib.mli findlib.cma findlib.cmxa findlib$(LIB_SUFFIX) findlib.cmxs \ --- -2.35.1 - diff --git a/esy.lock/opam/ocamlfind.1.9.5/opam b/esy.lock/opam/ocamlfind.1.9.6/opam similarity index 61% rename from esy.lock/opam/ocamlfind.1.9.5/opam rename to esy.lock/opam/ocamlfind.1.9.6/opam index 2c4f8fc4a..a05fa28c9 100644 --- a/esy.lock/opam/ocamlfind.1.9.5/opam +++ b/esy.lock/opam/ocamlfind.1.9.6/opam @@ -13,7 +13,7 @@ authors: "Gerd Stolpmann " homepage: "http://projects.camlcity.org/projects/findlib.html" bug-reports: "https://github.com/ocaml/ocamlfind/issues" depends: [ - "ocaml" {>= "4.02.0"} + "ocaml" {>= "3.08.0"} ] depopts: ["graphics"] build: [ @@ -34,14 +34,22 @@ install: [ [make "install"] ["install" "-m" "0755" "ocaml-stub" "%{bin}%/ocaml"] {ocaml:preinstalled} ] -extra-files: ["0001-Fix-bug-when-installing-with-a-system-compiler.patch" "md5=130d3d6fe399948ed7991b7756f50dc3"] -patches: ["0001-Fix-bug-when-installing-with-a-system-compiler.patch"] +# See https://github.com/ocaml/ocamlfind/pull/61 +patches: ["0001-Harden-test-for-OCaml-5.patch"] dev-repo: "git+https://github.com/ocaml/ocamlfind.git" url { - src: "http://download.camlcity.org/download/findlib-1.9.5.tar.gz" + src: "http://download.camlcity.org/download/findlib-1.9.6.tar.gz" checksum: [ - "md5=8b893525ce36cb3d4d4952483bcc7cf4" - "sha512=03514c618a16b02889db997c6c4789b3436b3ad7d974348d2c6dea53eb78898ab285ce5f10297c074bab4fd2c82931a8b7c5c113b994447a44abb30fca74c715" + "md5=96c6ee50a32cca9ca277321262dbec57" + "sha512=cfaf1872d6ccda548f07d32cc6b90c3aafe136d2aa6539e03143702171ee0199add55269bba894c77115535dc46a5835901a5d7c75768999e72db503bfd83027" + ] +} +available: os != "win32" +extra-source "0001-Harden-test-for-OCaml-5.patch" { + src: + "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/ocamlfind/0001-Harden-test-for-OCaml-5.patch" + checksum: [ + "sha256=6fcca5f2f7abf8d6304da6c385348584013ffb8602722a87fb0bacbab5867fe8" + "md5=3cddbf72164c29d4e50e077a92a37c6c" ] } - diff --git a/esy.lock/opam/ocamlformat-rpc-lib.0.25.1/opam b/esy.lock/opam/ocamlformat-rpc-lib.0.26.2/opam similarity index 54% rename from esy.lock/opam/ocamlformat-rpc-lib.0.25.1/opam rename to esy.lock/opam/ocamlformat-rpc-lib.0.26.2/opam index e6e4ec197..df66873a6 100644 --- a/esy.lock/opam/ocamlformat-rpc-lib.0.25.1/opam +++ b/esy.lock/opam/ocamlformat-rpc-lib.0.26.2/opam @@ -2,8 +2,18 @@ opam-version: "2.0" synopsis: "Auto-formatter for OCaml code (RPC mode)" description: "OCamlFormat is a tool to automatically format OCaml code in a uniform style. This package defines a RPC interface to OCamlFormat" -maintainer: ["OCamlFormat Team "] -authors: ["Josh Berdine "] +maintainer: [ + "Guillaume Petiot " + "Jules Aguillon " + "Emile Trotignon " +] +authors: [ + "Josh Berdine " + "Hugo Heuzard " + "Etienne Millon " + "Guillaume Petiot " + "Jules Aguillon " +] license: "MIT" homepage: "https://github.com/ocaml-ppx/ocamlformat" bug-reports: "https://github.com/ocaml-ppx/ocamlformat/issues" @@ -30,10 +40,10 @@ build: [ dev-repo: "git+https://github.com/ocaml-ppx/ocamlformat.git" url { src: - "https://github.com/ocaml-ppx/ocamlformat/releases/download/0.25.1/ocamlformat-0.25.1.tbz" + "https://github.com/ocaml-ppx/ocamlformat/releases/download/0.26.2/ocamlformat-0.26.2.tbz" checksum: [ - "sha256=dc8f2a330ca3930b36cacb2623bb360ed8bdf6e4a8acd293dbd9e2241a6fd33d" - "sha512=b28f545425fb5375447c90022d065dc7fd51ed2f66d8c1f65a71a6ad2465d039a8686e8f18249e5ad3a2362fee6149c855ef30eb45fb9d06d743a53d26b3e26f" + "sha256=2e4f596bf7aa367a844fe83ba0f6b0bf14b2a65179ddc082363fe9793d0375c5" + "sha512=b03d57462e65b11aa9f78dd5c4548251e8d1c5a1c9662f7502bdb10472aeb9df33c1d407350767a5223fbff9c01d53de85bafacd0274b49abc4b43701b159bee" ] } -x-commit-hash: "651f767b48e14ba6b24db9421306942d9e51adcc" +x-commit-hash: "f5727b32127730a2722f86c7119eb6d8f884e26d" diff --git a/esy.lock/opam/octavius.1.2.2/opam b/esy.lock/opam/octavius.1.2.2/opam index 0539c097d..e67874dc2 100644 --- a/esy.lock/opam/octavius.1.2.2/opam +++ b/esy.lock/opam/octavius.1.2.2/opam @@ -29,5 +29,8 @@ synopsis: "Ocamldoc comment syntax parser" description: "Octavius is a library to parse the `ocamldoc` comment syntax." url { src: "https://github.com/ocaml-doc/octavius/archive/v1.2.2.tar.gz" - checksum: "md5=72f9e1d996e6c5089fc513cc9218607b" + checksum: [ + "sha256=eac9104ce0316b69da9c44b9c477700fe0b52a888c89ce4bdf1d2b782a73e0ad" + "md5=72f9e1d996e6c5089fc513cc9218607b" + ] } diff --git a/esy.lock/opam/odoc-parser.2.0.0/opam b/esy.lock/opam/odoc-parser.2.0.0/opam deleted file mode 100644 index 602b2bdfb..000000000 --- a/esy.lock/opam/odoc-parser.2.0.0/opam +++ /dev/null @@ -1,47 +0,0 @@ -opam-version: "2.0" -synopsis: "Parser for ocaml documentation comments" -description: """ -Odoc_parser is a library for parsing the contents of OCaml documentation -comments, formatted using 'odoc' syntax, an extension of the language -understood by ocamldoc.""" -maintainer: ["Jon Ludlam "] -authors: ["Anton Bachin "] -license: "ISC" -homepage: "https://github.com/ocaml-doc/odoc-parser" -bug-reports: "https://github.com/ocaml-doc/odoc-parser/issues" -dev-repo: "git+https://github.com/ocaml-doc/odoc-parser.git" -# This template exists because without it dune pop is dependencies and build rules -# involving odoc. Since odoc depends on this package, this doesn't work. -doc: "https://ocaml-doc.github.io/odoc-parser/" -depends: [ - "dune" {>= "2.8"} - "ocaml" {>= "4.02.0"} - "astring" - "result" - "camlp-streams" - "ppx_expect" {with-test} - ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - ] -] -url { - src: - "https://github.com/ocaml-doc/odoc-parser/releases/download/2.0.0/odoc-parser-2.0.0.tbz" - checksum: [ - "sha256=407919fbb0eb95761d6fc6ec6777628d94aa1907343bdca678b1880bafb33922" - "sha512=d2bffa3e9f30471045682e390dcee7a2c1caf3831bca4bd57c16939e782c2e23434e6f1c9887580a1804800b3629ef4c4311a9d418fca5a939f324650d54006e" - ] -} -x-commit-hash: "ebfd3b9489e44187da2c67d79a32b6fc1e92bda4" - diff --git a/esy.lock/opam/odoc-parser.2.4.2/opam b/esy.lock/opam/odoc-parser.2.4.2/opam new file mode 100644 index 000000000..2d4aa7b93 --- /dev/null +++ b/esy.lock/opam/odoc-parser.2.4.2/opam @@ -0,0 +1,45 @@ +opam-version: "2.0" +synopsis: "Parser for ocaml documentation comments" +description: """ +Odoc_parser is a library for parsing the contents of OCaml documentation +comments, formatted using 'odoc' syntax, an extension of the language +understood by ocamldoc.""" +maintainer: ["Jon Ludlam "] +authors: ["Anton Bachin "] +license: "ISC" +homepage: "https://github.com/ocaml/odoc" +bug-reports: "https://github.com/ocaml/odoc/issues" +dev-repo: "git+https://github.com/ocaml/odoc.git" +doc: "https://ocaml.github.io/odoc/odoc_parser" +depends: [ + "dune" {>= "3.7"} + "ocaml" {>= "4.02.0"} + "astring" + "result" + "camlp-streams" + "ppx_expect" {with-test} + ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + # Tests are not all associated with a package and would be run if using the + # default '@runtest'. + "@src/parser/runtest" {with-test} + ] +] +url { + src: "https://github.com/ocaml/odoc/releases/download/2.4.2/odoc-2.4.2.tbz" + checksum: [ + "sha256=563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b" + "sha512=8d48c99e0c253791177dd65287ce5cee47e7c6805e33f3ae0cf6c8e7d349128f26eebbe36459c31429c11519ad5979dbe36fbcb9403a5fde199a69976a3fb3a6" + ] +} +x-commit-hash: "85644b01ca86d1061766908bba3653ced2c15ce4" diff --git a/esy.lock/opam/odoc.2.2.0/opam b/esy.lock/opam/odoc.2.2.0/opam deleted file mode 100644 index c284fc6d5..000000000 --- a/esy.lock/opam/odoc.2.2.0/opam +++ /dev/null @@ -1,61 +0,0 @@ -opam-version: "2.0" -homepage: "http://github.com/ocaml/odoc" -doc: "https://ocaml.github.io/odoc/" -bug-reports: "https://github.com/ocaml/odoc/issues" -license: "ISC" - -authors: [ - "Thomas Refis " - "David Sheets " - "Leo White " - "Anton Bachin " - "Jon Ludlam " - "Jules Aguillon " - "Lubega Simon " -] -maintainer: "Jon Ludlam " -dev-repo: "git+https://github.com/ocaml/odoc.git" - -synopsis: "OCaml documentation generator" -description: """ -Odoc is a documentation generator for OCaml. It reads doc comments, -delimited with `(** ... *)`, and outputs HTML. -""" - -depends: [ - "odoc-parser" {>= "2.0.0"} - "astring" - "cmdliner" {>= "1.0.0"} - "cppo" {build & >= "1.1.0"} - "dune" {>= "3.0.2"} - "fpath" - "ocaml" {>= "4.02.0"} - "result" - "tyxml" {>= "4.3.0"} - "fmt" - - "ocamlfind" {with-test} - "yojson" {< "2.0.0" & with-test} - ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) - "conf-jq" {with-test} - - "ppx_expect" {with-test} - "bos" {with-test} - "crunch" {with-test} - - ("ocaml" {< "4.07.0" & with-test} | "bisect_ppx" {with-test & > "2.5.0"}) - ("ocaml" {< "4.03.0" & with-test} | "mdx" {with-test}) -] - -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] -] -url { - src: "https://github.com/ocaml/odoc/releases/download/2.2.0/odoc-2.2.0.tbz" - checksum: [ - "sha256=6818c971fc0c3eed9d3d143389f80739b1618af70b9fdb443b35bd7f0121740c" - "sha512=9f8fc2ee6b25629474e8aa69dd460becab9277261578af0f7b97f7f779cc5f1056d1b5f14ab583b9b94ea097e5df2d6e35040f2a4887021209705486f9d44a22" - ] -} -x-commit-hash: "103dac4c370aa2ad5aca7ba54f02f8e06adb941b" diff --git a/esy.lock/opam/odoc.2.4.2/opam b/esy.lock/opam/odoc.2.4.2/opam new file mode 100644 index 000000000..0998056cd --- /dev/null +++ b/esy.lock/opam/odoc.2.4.2/opam @@ -0,0 +1,84 @@ +opam-version: "2.0" +homepage: "https://github.com/ocaml/odoc" +doc: "https://ocaml.github.io/odoc/" +bug-reports: "https://github.com/ocaml/odoc/issues" +license: "ISC" + +maintainer: [ + "Daniel Bünzli " + "Jon Ludlam " + "Jules Aguillon " + "Paul-Elliot Anglès d'Auriac " +] +authors: [ + "Anton Bachin " + "Daniel Bünzli " + "David Sheets " + "Jon Ludlam " + "Jules Aguillon " + "Leo White " + "Lubega Simon " + "Paul-Elliot Anglès d'Auriac " + "Thomas Refis " +] +dev-repo: "git+https://github.com/ocaml/odoc.git" + +synopsis: "OCaml Documentation Generator" +description: """ +**odoc** is a powerful and flexible documentation generator for OCaml. It reads *doc comments*, demarcated by `(** ... *)`, and transforms them into a variety of output formats, including HTML, LaTeX, and man pages. + +- **Output Formats:** Odoc generates HTML for web browsing, LaTeX for PDF generation, and man pages for use on Unix-like systems. +- **Cross-References:** odoc uses the `ocamldoc` markup, which allows to create links for functions, types, modules, and documentation pages. +- **Link to Source Code:** Documentation generated includes links to the source code of functions, providing an easy way to navigate from the docs to the actual implementation. +- **Code Highlighting:** odoc automatically highlights syntax in code snippets for different languages. + +odoc is part of the [OCaml Platform](https://ocaml.org/docs/platform), the recommended set of tools for OCaml. +""" + + +depends: [ + "odoc-parser" {= version} + "astring" + "cmdliner" {>= "1.0.0"} + "cppo" {build & >= "1.1.0"} + "dune" {>= "3.7.0"} + "fpath" + "ocaml" {>= "4.02.0"} + "result" + "tyxml" {>= "4.4.0"} + "fmt" + + "ocamlfind" {with-test} + "yojson" {>= "1.6.0" & with-test} + ("ocaml" {< "4.04.1" & with-test} | "sexplib0" {with-test}) + "conf-jq" {with-test} + + "ppx_expect" {with-test} + "bos" {with-test} + "crunch" {> "2.0.0"} + + ("ocaml" {< "4.07.0" & with-test} | "bisect_ppx" {with-test & > "2.5.0"}) +] + +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +url { + src: "https://github.com/ocaml/odoc/releases/download/2.4.2/odoc-2.4.2.tbz" + checksum: [ + "sha256=563cfdbb26ec8a30e737a9cf285a06e0bbae953f48e25bbb0f69f7a99c2ba40b" + "sha512=8d48c99e0c253791177dd65287ce5cee47e7c6805e33f3ae0cf6c8e7d349128f26eebbe36459c31429c11519ad5979dbe36fbcb9403a5fde199a69976a3fb3a6" + ] +} +x-commit-hash: "85644b01ca86d1061766908bba3653ced2c15ce4" diff --git a/esy.lock/opam/omd.1.3.2/opam b/esy.lock/opam/omd.1.3.2/opam index ad2e5014d..3a805c065 100644 --- a/esy.lock/opam/omd.1.3.2/opam +++ b/esy.lock/opam/omd.1.3.2/opam @@ -41,7 +41,7 @@ build: [ ] dev-repo: "git+https://github.com/ocaml/omd.git" url { - src: "https://github.com/ocaml/omd/releases/download/1.3.2/omd-1.3.2.tbz" + src: "https://github.com/ocaml/opam-source-archives/raw/main/omd-1.3.2.tbz" checksum: [ "sha256=6023e1642631f08f678eb5725820879ed7bb5a3ffee777cdedebc28c1f85fadb" "sha512=fa2070a5f5d30b2cc422937ac4158bb087134a69d47fa15df403afb1c0c60a73dd436c949faa8d44e0b65bdee039779d86191b55085b717253f91ef20a69ef98" diff --git a/esy.lock/opam/pp.1.1.2/opam b/esy.lock/opam/pp.1.2.0/opam similarity index 76% rename from esy.lock/opam/pp.1.1.2/opam rename to esy.lock/opam/pp.1.2.0/opam index e09edbfd5..9f4fad20d 100644 --- a/esy.lock/opam/pp.1.1.2/opam +++ b/esy.lock/opam/pp.1.2.0/opam @@ -20,7 +20,7 @@ one [2] should be applicable to Pp as well. """ maintainer: ["Jeremie Dimino "] authors: [ - "Jane Street Group, LLC" + "Jane Street Group, LLC " "Jeremie Dimino " ] license: "MIT" @@ -28,9 +28,10 @@ homepage: "https://github.com/ocaml-dune/pp" doc: "https://ocaml-dune.github.io/pp/" bug-reports: "https://github.com/ocaml-dune/pp/issues" depends: [ - "dune" {>= "2.0"} + "dune" {>= "2.8"} "ocaml" {>= "4.08.0"} "ppx_expect" {with-test} + "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} @@ -47,12 +48,12 @@ build: [ ] ] dev-repo: "git+https://github.com/ocaml-dune/pp.git" -x-commit-hash: "395b95c89cfe2c6d538dad9d56721b6a7278d46c" url { src: - "https://github.com/ocaml-dune/pp/releases/download/1.1.2/pp-1.1.2.tbz" + "https://github.com/ocaml-dune/pp/releases/download/1.2.0/pp-1.2.0.tbz" checksum: [ - "sha256=e4a4e98d96b1bb76950fcd6da4e938c86d989df4d7e48f02f7a44595f5af1d56" - "sha512=58f78b083483006b40814be9aac33c895349eb1c6427d2762b4d760192613401262478bd5deff909763517560b06af7bf013c6a6f87d549aafa77b26345303f2" + "sha256=a5e822573c55afb42db29ec56eacd1f2acd8f65cf2df2878e291de374ce6909c" + "sha512=912164c2aa7241d73f735dadfbefe8ed0138d241579d2e885440e068fac78eb9f0b3d782c2420e757e313168c1725daff6ab91800dd315b1e05288456998b40a" ] } +x-commit-hash: "83b68c740f21acdcfe54436355ab328372871357" diff --git a/esy.lock/opam/ppx_derivers.1.2.1/opam b/esy.lock/opam/ppx_derivers.1.2.1/opam index 484b2654f..d06e23b21 100644 --- a/esy.lock/opam/ppx_derivers.1.2.1/opam +++ b/esy.lock/opam/ppx_derivers.1.2.1/opam @@ -19,5 +19,8 @@ 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" + checksum: [ + "sha256=b6595ee187dea792b31fc54a0e1524ab1e48bc6068d3066c45215a138cc73b95" + "md5=5dc2bf130c1db3c731fe0fffc5648b41" + ] } diff --git a/esy.lock/opam/ppx_yojson_conv_lib.v0.15.0/opam b/esy.lock/opam/ppx_yojson_conv_lib.v0.16.0/opam similarity index 75% rename from esy.lock/opam/ppx_yojson_conv_lib.v0.15.0/opam rename to esy.lock/opam/ppx_yojson_conv_lib.v0.16.0/opam index 1b0664b2a..c3e72b433 100644 --- a/esy.lock/opam/ppx_yojson_conv_lib.v0.15.0/opam +++ b/esy.lock/opam/ppx_yojson_conv_lib.v0.16.0/opam @@ -10,7 +10,7 @@ build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ - "ocaml" {>= "4.02.3"} + "ocaml" {>= "4.14.0"} "dune" {>= "2.0.0"} "yojson" {>= "1.7.0"} ] @@ -19,6 +19,6 @@ description: " Part of the Jane Street's PPX rewriters collection. " url { -src: "https://ocaml.janestreet.com/ocaml-core/v0.15/files/ppx_yojson_conv_lib-v0.15.0.tar.gz" -checksum: "sha256=f9d2c5eff4566ec1f1f379b186ed22c8ddd6be0909a160bc5a9ac7abc6a6b684" +src: "https://ocaml.janestreet.com/ocaml-core/v0.16/files/ppx_yojson_conv_lib-v0.16.0.tar.gz" +checksum: "sha256=557c43c88d365b4cbb514d809f1eecc54d7b9976b0669bc55b02169e6c86ec7d" } diff --git a/esy.lock/opam/ppxlib.0.29.1/opam b/esy.lock/opam/ppxlib.0.32.1/opam similarity index 65% rename from esy.lock/opam/ppxlib.0.29.1/opam rename to esy.lock/opam/ppxlib.0.32.1/opam index 4170d25c1..0db44e20b 100644 --- a/esy.lock/opam/ppxlib.0.29.1/opam +++ b/esy.lock/opam/ppxlib.0.32.1/opam @@ -1,9 +1,9 @@ opam-version: "2.0" -synopsis: "Standard library for ppx rewriters" +synopsis: "Standard infrastructure for ppx rewriters" description: """ -Ppxlib is the standard library for ppx rewriters and other programs -that manipulate the in-memory representation of OCaml programs, a.k.a -the "Parsetree". +Ppxlib is the standard infrastructure for ppx rewriters +and other programs that manipulate the in-memory representation of +OCaml programs, a.k.a the "Parsetree". It also comes bundled with two ppx rewriters that are commonly used to write tools that manipulate and/or generate Parsetree values; @@ -20,7 +20,7 @@ doc: "https://ocaml-ppx.github.io/ppxlib/" bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" depends: [ "dune" {>= "2.7"} - "ocaml" {>= "4.04.1" & < "5.1.0"} + "ocaml" {>= "4.04.1" & < "5.3.0"} "ocaml-compiler-libs" {>= "v0.11.0"} "ppx_derivers" {>= "1.0"} "sexplib0" {>= "v0.12"} @@ -29,12 +29,12 @@ depends: [ "ocamlfind" {with-test} "re" {with-test & >= "1.9.0"} "cinaps" {with-test & >= "v0.12.1"} - "base" {with-test} - "stdio" {with-test} "odoc" {with-doc} ] conflicts: [ "ocaml-migrate-parsetree" {< "2.0.0"} + "ocaml-base-compiler" {= "5.1.0~alpha1"} + "ocaml-variants" {= "5.1.0~alpha1+options"} "base-effects" ] build: [ @@ -54,10 +54,10 @@ build: [ dev-repo: "git+https://github.com/ocaml-ppx/ppxlib.git" url { src: - "https://github.com/ocaml-ppx/ppxlib/releases/download/0.29.1/ppxlib-0.29.1.tbz" + "https://github.com/ocaml-ppx/ppxlib/releases/download/0.32.1/ppxlib-0.32.1.tbz" checksum: [ - "sha256=c8ea8c8770414fdba6612e7f2d814b21a493daa974ea862a90c8e6c766e5dd79" - "sha512=edc468e9111cc26e31825e475fd72f55123a22fe86548e07e7d111796fecb8d60359b1b53c7eac383e5e2114cbae74dfd9c166f330e84cbeab4ddfd5797e322f" + "sha256=9dbad8bcb1c8b4f3df3f58bca60a5ed23d86531f0da34b4196c86bd585c09d7f" + "sha512=7b93b622b119478dde03adcf4993e73ea937c91c280e453ccee631c682d8589ecb31841f11d6a14966239954e22e000da8afbe25a0f089532c7210b698c52553" ] } -x-commit-hash: "36fcba0408b78963a730e0be92abdbab00b0ea26" +x-commit-hash: "cd138a752ae6f21ad649c531b3b2276f332b3bb0" diff --git a/esy.lock/opam/ptime.1.1.0/opam b/esy.lock/opam/ptime.1.1.0/opam new file mode 100644 index 000000000..39796c2a2 --- /dev/null +++ b/esy.lock/opam/ptime.1.1.0/opam @@ -0,0 +1,41 @@ +opam-version: "2.0" +synopsis: "POSIX time for OCaml" +description: """\ +Ptime has platform independent POSIX time support in pure OCaml. It +provides a type to represent a well-defined range of POSIX timestamps +with picosecond precision, conversion with date-time values, +conversion with [RFC 3339 timestamps][rfc3339] and pretty printing to +a human-readable, locale-independent representation. + +The additional Ptime_clock library provides access to a system POSIX +clock and to the system's current time zone offset. + +Ptime is not a calendar library. + +Ptime has no dependency. Ptime_clock depends on your system library or +JavaScript runtime system. Ptime and its libraries are distributed +under the ISC license. + +[rfc3339]: http://tools.ietf.org/html/rfc3339 + +Home page: """ +maintainer: "Daniel Bünzli " +authors: "The ptime programmers" +license: "ISC" +tags: ["time" "posix" "system" "org:erratique"] +homepage: "https://erratique.ch/software/ptime" +doc: "https://erratique.ch/software/ptime/doc/" +bug-reports: "https://github.com/dbuenzli/ptime/issues" +depends: [ + "ocaml" {>= "4.08.0"} + "ocamlfind" {build} + "ocamlbuild" {build & != "0.9.0"} + "topkg" {build & >= "1.0.3"} +] +build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"] +dev-repo: "git+https://erratique.ch/repos/ptime.git" +url { + src: "https://erratique.ch/software/ptime/releases/ptime-1.1.0.tbz" + checksum: + "sha512=309b8383f61b58840e58a82802ec8fbc61b7cc95a4590d38ad427e484cbaaf66f03fa8e6484b5b6855468a87e745aed103bf6f1041ec05062230a9fa5fb86cc6" +} \ No newline at end of file diff --git a/esy.lock/opam/re.1.10.4/opam b/esy.lock/opam/re.1.11.0/opam similarity index 69% rename from esy.lock/opam/re.1.10.4/opam rename to esy.lock/opam/re.1.11.0/opam index 9dad66137..303af008c 100644 --- a/esy.lock/opam/re.1.10.4/opam +++ b/esy.lock/opam/re.1.11.0/opam @@ -8,7 +8,7 @@ authors: [ "Rudi Grinberg" "Gabriel Radanne" ] -license: "LGPL-2.0-or-later WITH OCaml-LGPL-linking-exception" +license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" homepage: "https://github.com/ocaml/ocaml-re" bug-reports: "https://github.com/ocaml/ocaml-re/issues" dev-repo: "git+https://github.com/ocaml/ocaml-re.git" @@ -37,10 +37,10 @@ Pure OCaml regular expressions with: """ url { src: - "https://github.com/ocaml/ocaml-re/releases/download/1.10.4/re-1.10.4.tbz" + "https://github.com/ocaml/ocaml-re/releases/download/1.11.0/re-1.11.0.tbz" checksum: [ - "sha256=83eb3e4300aa9b1dc7820749010f4362ea83524742130524d78c20ce99ca747c" - "sha512=92b05cf92c389fa8c753f2acca837b15dd05a4a2e8e2bec7a269d2e14c35b1a786d394258376648f80b4b99250ba1900cfe68230b8385aeac153149d9ce56099" + "sha256=01fc244780c0f6be72ae796b1fb750f367de18624fd75d07ee79782ed6df8d4f" + "sha512=3e3712cc1266ec1f27620f3508ea2ebba338f4083b07d8a69dccee1facfdc1971a6c39f9deea664d2a62fd7f2cfd2eae816ca4c274acfadaee992a3befc4b757" ] } -x-commit-hash: "e9a4cecb8294c1839db18b1d0c30e755ec85ed5e" +x-commit-hash: "2dd38515c76c40299596d39f18d9b9a20f00d788" diff --git a/esy.lock/opam/result.1.5/opam b/esy.lock/opam/result.1.5/opam index 6b7b68d72..da55ed463 100644 --- a/esy.lock/opam/result.1.5/opam +++ b/esy.lock/opam/result.1.5/opam @@ -18,5 +18,8 @@ Result module defined in this library.""" url { src: "https://github.com/janestreet/result/releases/download/1.5/result-1.5.tbz" - checksum: "md5=1b82dec78849680b49ae9a8a365b831b" + checksum: [ + "sha256=7c3a5e238558f4c1a4f5acca816bc705a0e12f68dc0005c61ddbf2e6cab8ee32" + "md5=1b82dec78849680b49ae9a8a365b831b" + ] } diff --git a/esy.lock/opam/seq.base/files/META.seq b/esy.lock/opam/seq.base/files/META.seq deleted file mode 100644 index 06b95eff3..000000000 --- a/esy.lock/opam/seq.base/files/META.seq +++ /dev/null @@ -1,4 +0,0 @@ -name="seq" -version="[distributed with OCaml 4.07 or above]" -description="dummy backward-compatibility package for iterators" -requires="" diff --git a/esy.lock/opam/seq.base/files/seq.install b/esy.lock/opam/seq.base/files/seq.install deleted file mode 100644 index c4d70206e..000000000 --- a/esy.lock/opam/seq.base/files/seq.install +++ /dev/null @@ -1,3 +0,0 @@ -lib:[ - "META.seq" {"META"} -] diff --git a/esy.lock/opam/seq.base/opam b/esy.lock/opam/seq.base/opam index b33d8c7da..c732d3ebe 100644 --- a/esy.lock/opam/seq.base/opam +++ b/esy.lock/opam/seq.base/opam @@ -9,7 +9,19 @@ dev-repo: "git+https://github.com/ocaml/ocaml.git" bug-reports: "https://caml.inria.fr/mantis/main_page.php" synopsis: "Compatibility package for OCaml's standard iterator type starting from 4.07." -extra-files: [ - ["seq.install" "md5=026b31e1df290373198373d5aaa26e42"] - ["META.seq" "md5=b33c8a1a6c7ed797816ce27df4855107"] -] +extra-source "seq.install" { + src: + "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/seq/seq.install" + checksum: [ + "sha256=fff926c2c4d5a82b6c94c60c4c35eb06e3d39975893ebe6b1f0e6557cbe34904" + "md5=026b31e1df290373198373d5aaa26e42" + ] +} +extra-source "META.seq" { + src: + "https://raw.githubusercontent.com/ocaml/opam-source-archives/main/patches/seq/META.seq" + checksum: [ + "sha256=e95062b4d0519ef8335c02f7d0f1952d11b814c7ab7e6d566a206116162fa2be" + "md5=b33c8a1a6c7ed797816ce27df4855107" + ] +} diff --git a/esy.lock/opam/sexplib0.v0.15.1/opam b/esy.lock/opam/sexplib0.v0.17.0/opam similarity index 65% rename from esy.lock/opam/sexplib0.v0.15.1/opam rename to esy.lock/opam/sexplib0.v0.17.0/opam index 123ccd03c..4a8cdc5de 100644 --- a/esy.lock/opam/sexplib0.v0.15.1/opam +++ b/esy.lock/opam/sexplib0.v0.17.0/opam @@ -10,9 +10,10 @@ build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ - "ocaml" {>= "4.08"} - "dune" {>= "2.0.0"} + "ocaml" {>= "4.14.0"} + "dune" {>= "3.11.0"} ] +available: arch != "arm32" & arch != "x86_32" synopsis: "Library containing the definition of S-expressions and some base converters" description: " Part of Jane Street's Core library @@ -21,6 +22,10 @@ OCaml's standard library that was developed by Jane Street, the largest industrial user of OCaml. " url { -src: "https://github.com/janestreet/sexplib0/archive/refs/tags/v0.15.1.tar.gz" -checksum: "md5=ab8fd6273f35a792cad48cbb3024a7f9" + src: + "https://github.com/janestreet/sexplib0/archive/refs/tags/v0.17.0.tar.gz" + checksum: [ + "md5=abafe8fd1d6302e55a315f4d78960d2a" + "sha512=ad387e40789fe70a11473db7e85fe017b801592624414e9030730b2e92ea08f98095fb6e9236430f33c801605ebee0a2a6284e0f618a26a7da4599d4fd9d395d" + ] } diff --git a/esy.lock/opam/trie.1.0.0/opam b/esy.lock/opam/trie.1.0.0/opam index 29442d7dd..4c023b7c0 100644 --- a/esy.lock/opam/trie.1.0.0/opam +++ b/esy.lock/opam/trie.1.0.0/opam @@ -15,5 +15,8 @@ depends: [ synopsis: "Strict impure trie tree" url { src: "https://github.com/kandu/trie/archive/1.0.0.tar.gz" - checksum: "md5=84519b5f8bd92490bfc68a52f706ba14" + checksum: [ + "sha256=c2f8054ea44216e6a3a961b28f7630e0e3dbfbd1b504ae741be230cbe32498ea" + "md5=84519b5f8bd92490bfc68a52f706ba14" + ] } diff --git a/esy.lock/opam/tyxml.4.5.0/opam b/esy.lock/opam/tyxml.4.6.0/opam similarity index 72% rename from esy.lock/opam/tyxml.4.5.0/opam rename to esy.lock/opam/tyxml.4.6.0/opam index 22c776071..a0e62e118 100644 --- a/esy.lock/opam/tyxml.4.5.0/opam +++ b/esy.lock/opam/tyxml.4.6.0/opam @@ -9,12 +9,13 @@ homepage: "https://github.com/ocsigen/tyxml" doc: "https://ocsigen.org/tyxml/latest/manual/intro" bug-reports: "https://github.com/ocsigen/tyxml/issues" depends: [ - "dune" {>= "2.0"} - "ocaml" {>= "4.02"} + "dune" {>= "2.7"} + "ocaml" {>= "4.04"} "alcotest" {with-test} - "re" {>= "1.5.0"} + "re" {>= "1.7.2"} "seq" "uutf" {>= "1.0.0"} + "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} @@ -31,12 +32,12 @@ build: [ ] ] dev-repo: "git+https://github.com/ocsigen/tyxml.git" -x-commit-hash: "ef431a4bceaefb2d9248e79092e6c1a1a9420095" url { src: - "https://github.com/ocsigen/tyxml/releases/download/4.5.0/tyxml-4.5.0.tbz" + "https://github.com/ocsigen/tyxml/releases/download/4.6.0/tyxml-4.6.0.tbz" checksum: [ - "sha256=c69accef5df4dd89d38f6aa0baad01e8fda4e9e98bb7dad61bec1452c5716068" - "sha512=772535441b09c393d53c27152e65f404a0a541aa0cea1bda899a8d751ab64d1729237e583618c3ff33d75e3865d53503d1ea413c6bbc8c68c413347efd1709b3" + "sha256=bfeb673c6b4e120a4eca4c48448add47dc3f8d02c2b40f63ffdccc4e91c902dd" + "sha512=69750eeaf467014282087bf9628f3278f3e5f00f4c7400358750d208664cfc3f79a5cba16767d2935e53477d1a6862fe08c5b801b69052ec12e09d1a93a5e9b4" ] } +x-commit-hash: "d2916535536f2134bad7793a598ba5b7327cae41" diff --git a/esy.lock/opam/uchar.0.0.2/opam b/esy.lock/opam/uchar.0.0.2/opam index 4310af436..5f7f6161f 100644 --- a/esy.lock/opam/uchar.0.0.2/opam +++ b/esy.lock/opam/uchar.0.0.2/opam @@ -32,5 +32,8 @@ compiler. See [LICENSE](LICENSE) for details. url { src: "https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz" - checksum: "md5=c9ba2c738d264c420c642f7bb1cf4a36" + checksum: [ + "sha256=47397f316cbe76234af53c74a1f9452154ba3bdb54fced5caac959f50f575af0" + "md5=c9ba2c738d264c420c642f7bb1cf4a36" + ] } diff --git a/esy.lock/opam/utop.2.12.0/opam b/esy.lock/opam/utop.2.12.0/opam deleted file mode 100644 index fde17cc37..000000000 --- a/esy.lock/opam/utop.2.12.0/opam +++ /dev/null @@ -1,43 +0,0 @@ -opam-version: "2.0" -maintainer: "jeremie@dimino.org" -authors: "Jérémie Dimino" -license: "BSD-3-Clause" -homepage: "https://github.com/ocaml-community/utop" -bug-reports: "https://github.com/ocaml-community/utop/issues" -doc: "https://ocaml-community.github.io/utop/" -depends: [ - "ocaml" {>= "4.08.0"} - "base-unix" - "base-threads" - "ocamlfind" {>= "1.7.2"} - "lambda-term" {>= "3.1.0" & < "4.0"} - "logs" - "lwt" - "lwt_react" - "zed" { >= "3.2.0" } - "react" {>= "1.0.0"} - "cppo" {build & >= "1.1.2"} - "dune" {>= "1.0"} -] -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -dev-repo: "git+https://github.com/ocaml-community/utop.git" -synopsis: "Universal toplevel for OCaml" -description: """ -utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for -OCaml. It can run in a terminal or in Emacs. It supports line -edition, history, real-time and context sensitive completion, colors, -and more. It integrates with the Tuareg mode in Emacs. -""" -url { - src: - "https://github.com/ocaml-community/utop/releases/download/2.12.0/utop-2.12.0.tbz" - checksum: [ - "sha256=ad19c859a783bec573cd91e810c54d0e6b70f339d0a4fed55ec672ae408aa1ea" - "sha512=cd55cfb49178bec60b39df5b15df9090d9a316b81ddd5e564daaaa04c3c896c2e1ccf24a15ebce5b41ad3e22db56cfc95cc3f1a6808ee8e09f1c685284cdfb71" - ] -} -x-commit-hash: "c50173caf9b147eae637cb44e302e2077778afb4" diff --git a/esy.lock/opam/utop.2.14.0/opam b/esy.lock/opam/utop.2.14.0/opam new file mode 100644 index 000000000..a75ae7af5 --- /dev/null +++ b/esy.lock/opam/utop.2.14.0/opam @@ -0,0 +1,50 @@ +opam-version: "2.0" +synopsis: "Universal toplevel for OCaml" +description: + "utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for OCaml. It can run in a terminal or in Emacs. It supports line edition, history, real-time and context sensitive completion, colors, and more. It integrates with the Tuareg mode in Emacs." +maintainer: ["jeremie@dimino.org"] +authors: ["Jérémie Dimino"] +license: "BSD-3-Clause" +homepage: "https://github.com/ocaml-community/utop" +doc: "https://ocaml-community.github.io/utop/" +bug-reports: "https://github.com/ocaml-community/utop/issues" +depends: [ + "dune" {>= "2.0"} + "ocaml" {>= "4.11.0"} + "base-unix" + "base-threads" + "ocamlfind" {>= "1.7.2"} + "lambda-term" {>= "3.1.0" & < "4.0"} + "logs" + "lwt" + "lwt_react" + "zed" {>= "3.2.0"} + "react" {>= "1.0.0"} + "cppo" {>= "1.1.2"} + "alcotest" {with-test} + "xdg" {>= "3.9.0"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/utop.git" +url { + src: + "https://github.com/ocaml-community/utop/releases/download/2.14.0/utop-2.14.0.tbz" + checksum: [ + "sha256=0fd5a9bc5b458524a71463a1fe0cd16f9b7be13673ae303118b7216e0d273ba9" + "sha512=d64a5ab671424279be13ebd080deac7ee46e2c9bc3abcfc37a6dff164124cc3abc52801527c35d9160ec868f9b8f334880026aaeaad02e507112fd8392094845" + ] +} +x-commit-hash: "d4f6f5f7337eeeac9507801c8f147fff518f9d69" diff --git a/esy.lock/opam/uucp.15.0.0/opam b/esy.lock/opam/uucp.15.1.0/opam similarity index 61% rename from esy.lock/opam/uucp.15.0.0/opam rename to esy.lock/opam/uucp.15.1.0/opam index dccf7c220..f3abfcad2 100644 --- a/esy.lock/opam/uucp.15.0.0/opam +++ b/esy.lock/opam/uucp.15.1.0/opam @@ -2,14 +2,13 @@ opam-version: "2.0" synopsis: "Unicode character properties for OCaml" description: """\ Uucp is an OCaml library providing efficient access to a selection of -character properties of the [Unicode character database][1]. +character properties of the [Unicode character database]. -Uucp is independent from any Unicode text data structure and has no -dependencies. It is distributed under the ISC license. +Uucp is distributed under the ISC license. It has no dependency. -[1]: http://www.unicode.org/reports/tr44/ +Home page: -Home page: http://erratique.ch/software/uucp""" +[Unicode character database]: http://www.unicode.org/reports/tr44/""" maintainer: "Daniel Bünzli " authors: "The uucp programmers" license: "ISC" @@ -18,17 +17,16 @@ homepage: "https://erratique.ch/software/uucp" doc: "https://erratique.ch/software/uucp/doc/" bug-reports: "https://github.com/dbuenzli/uucp/issues" depends: [ - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.14.0"} "ocamlfind" {build} "ocamlbuild" {build} "topkg" {build & >= "1.0.3"} - "uucd" {with-test} + "uucd" {with-test & dev & >= "15.1.0" & < "16.0.0"} "uunf" {with-test} - "uutf" {with-test} ] -depopts: ["uutf" "uunf" "cmdliner"] +depopts: ["uunf" "cmdliner"] conflicts: [ - "uutf" {< "1.0.1"} + "uunf" {< "15.1.0" | >= "16.0.0"} "cmdliner" {< "1.1.0"} ] build: [ @@ -37,8 +35,6 @@ build: [ "build" "--dev-pkg" "%{dev}%" - "--with-uutf" - "%{uutf:installed}%" "--with-uunf" "%{uunf:installed}%" "--with-cmdliner" @@ -49,7 +45,7 @@ post-messages: {failure & (arch = "ppc64" | arch = "arm64")} dev-repo: "git+https://erratique.ch/repos/uucp.git" url { - src: "https://erratique.ch/software/uucp/releases/uucp-15.0.0.tbz" + src: "https://erratique.ch/software/uucp/releases/uucp-15.1.0.tbz" checksum: - "sha512=ee4acff5666961766321e85e287fb9d5b8d50533319f22bf6f4eceb943242df2d0e0f4e775c4a140f68ca142837938eaa5926e22362215a3365ffe7f8768923b" + "sha512=998f94fadb72357b15a3042a3d11c31b3e16f281822673f2defdd515cd1394d55de1817628be8bd5c030175f9e62c53630d4139a1c0253800f9fb898b0f11364" } \ No newline at end of file diff --git a/esy.lock/opam/uuseg.15.0.0/opam b/esy.lock/opam/uuseg.15.1.0/opam similarity index 64% rename from esy.lock/opam/uuseg.15.0.0/opam rename to esy.lock/opam/uuseg.15.1.0/opam index 2178c0440..c1a872035 100644 --- a/esy.lock/opam/uuseg.15.0.0/opam +++ b/esy.lock/opam/uuseg.15.1.0/opam @@ -3,22 +3,20 @@ synopsis: "Unicode text segmentation for OCaml" description: """\ Uuseg is an OCaml library for segmenting Unicode text. It implements the locale independent [Unicode text segmentation algorithms][1] to -detect grapheme cluster, word and sentence boundaries and the -[Unicode line breaking algorithm][2] to detect line break -opportunities. +detect grapheme cluster, word and sentence boundaries and the [Unicode +line breaking algorithm][2] to detect line break opportunities. The library is independent from any IO mechanism or Unicode text data structure and it can process text without a complete in-memory representation. -Uuseg depends on [Uucp](http://erratique.ch/software/uucp) and -optionally on [Uutf](http://erratique.ch/software/uutf) for support on -OCaml UTF-X encoded strings. It is distributed under the ISC license. +Uuseg is distributed under the ISC license. It depends on [Uucp]. [1]: http://www.unicode.org/reports/tr29/ [2]: http://www.unicode.org/reports/tr14/ +[Uucp]: http://erratique.ch/software/uucp -Homepage: http://erratique.ch/software/uuseg""" +Homepage: """ maintainer: "Daniel Bünzli " authors: "The uuseg programmers" license: "ISC" @@ -27,11 +25,11 @@ homepage: "https://erratique.ch/software/uuseg" doc: "https://erratique.ch/software/uuseg/doc/" bug-reports: "https://github.com/dbuenzli/uuseg/issues" depends: [ - "ocaml" {>= "4.03.0"} + "ocaml" {>= "4.14.0"} "ocamlfind" {build} "ocamlbuild" {build} "topkg" {build & >= "1.0.3"} - "uucp" {>= "15.0.0" & < "16.0.0"} + "uucp" {>= "15.1.0" & < "16.0.0"} ] depopts: ["uutf" "cmdliner"] conflicts: [ @@ -51,7 +49,7 @@ build: [ ] dev-repo: "git+https://erratique.ch/repos/uuseg.git" url { - src: "https://erratique.ch/software/uuseg/releases/uuseg-15.0.0.tbz" + src: "https://erratique.ch/software/uuseg/releases/uuseg-15.1.0.tbz" checksum: - "sha512=37ea83b582dd779a026cfae11f08f5d67ef79fce65a2cf03f2a9aabc7eb5de60c8e812524fa7531e4ff6e22a3b18228e3438a0143ce43be95f23237cc283576f" + "sha512=1e9460dc5a856c985d40c61fd1560bdfdb8bbaf8d7430405814589b47d4a7f7869658d1e3198c7a9132412e9b4b85402ceb4bda5040da426b69e9aef4222a23a" } \ No newline at end of file diff --git a/esy.lock/opam/xdg.3.7.1/opam b/esy.lock/opam/xdg.3.16.0/opam similarity index 66% rename from esy.lock/opam/xdg.3.7.1/opam rename to esy.lock/opam/xdg.3.16.0/opam index 18778392f..b6b6823d3 100644 --- a/esy.lock/opam/xdg.3.7.1/opam +++ b/esy.lock/opam/xdg.3.16.0/opam @@ -9,7 +9,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" depends: [ - "dune" {>= "3.5"} + "dune" {>= "3.12"} "ocaml" {>= "4.08"} "odoc" {with-doc} ] @@ -30,10 +30,11 @@ build: [ ] ] url { - src: "https://github.com/ocaml/dune/releases/download/3.7.1/dune-3.7.1.tbz" + src: + "https://github.com/ocaml/dune/releases/download/3.16.0/dune-3.16.0.tbz" checksum: [ - "sha256=adfc38f14c0188a2ad80d61451d011d27ab8839b717492d7ad42f7cb911c54c3" - "sha512=a74cd77ac7714f9434b5991c6dc02c6e6a2f46071d993a8985a9c9f0105182bb9e310ae2bcf7cf1d411c848d1a665e0fc0111b3597e5b1c6b634c1d398bea432" + "sha256=5481dde7918ca3121e02c34d74339f734b32d5883efb8c1b8056471e74f9bda6" + "sha512=529f937c61bc9ea7b135c2425f2d730478b48e6ab6b6455c354138d27b76bd43afce40d4784a6f183d6308d3cf0f5d5cea5bea070f83442949762ed818fb44bc" ] } -x-commit-hash: "e2b2d6aa984e3a5ddffa5ea00dd4f042dbf529a1" +x-commit-hash: "e4380ffddbdf924b3ec4c56048cd8331e1bf39ed" diff --git a/esy.lock/opam/yojson.2.0.2/opam b/esy.lock/opam/yojson.2.2.1/opam similarity index 55% rename from esy.lock/opam/yojson.2.0.2/opam rename to esy.lock/opam/yojson.2.2.1/opam index 3b22e3899..baee26257 100644 --- a/esy.lock/opam/yojson.2.0.2/opam +++ b/esy.lock/opam/yojson.2.2.1/opam @@ -1,38 +1,47 @@ opam-version: "2.0" -maintainer: ["nathan@cryptosense.com" "marek@xivilization.net"] +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. + +ydump is a pretty-printing command-line program provided with the +yojson package.""" +maintainer: [ + "paul-elliot@tarides.com" "nathan@tarides.com" "marek@tarides.com" +] authors: ["Martin Jambon"] +license: "BSD-3-Clause" homepage: "https://github.com/ocaml-community/yojson" +doc: "https://ocaml-community.github.io/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/" -license: "BSD-3-Clause" -build: [ - ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} - ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} -] depends: [ + "dune" {>= "2.7"} "ocaml" {>= "4.02.3"} - "dune" {>= "2.0"} - "cppo" {build} "alcotest" {with-test & >= "0.8.5"} - "odoc" {with-doc} "seq" {>= "0.2.2"} + "odoc" {with-doc} ] -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. - -ydump is a pretty-printing command-line program provided with the -yojson package.""" +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-community/yojson.git" url { src: - "https://github.com/ocaml-community/yojson/releases/download/2.0.2/yojson-2.0.2.tbz" + "https://github.com/ocaml-community/yojson/releases/download/2.2.1/yojson-2.2.1.tbz" checksum: [ - "sha256=876bb6f38af73a84a29438a3da35e4857c60a14556a606525b148c6fdbe5461b" - "sha512=9e150689a814a64e53e361e336fe826df5a3e3851d1367fda4a001392175c29348de55db0b7d7ba18539dec2cf78198efcb7f41b77a9861763f5aa97c05509ad" + "sha256=cd3c1d94f695899a026dff72696989bdb10dc1632934bb9cbe6f4598d4afa6d4" + "sha512=d9ba97feca5fef67325ada009760784be9c7bea70469540df7adf3f7e65c1de6cbda2fe12410c4a315716a4f0b533d21fbe9092bfc922bfaf2ff646931f7f5fc" ] } -x-commit-hash: "17ca03c5877a4346f0691443f35ed9678f99962f" +x-commit-hash: "a9c234f0a0fa143ec35917e814ad20040f8610e1" diff --git a/esy.lock/opam/zed.3.2.1/opam b/esy.lock/opam/zed.3.2.3/opam similarity index 73% rename from esy.lock/opam/zed.3.2.1/opam rename to esy.lock/opam/zed.3.2.3/opam index c4043db88..bc1a7e370 100644 --- a/esy.lock/opam/zed.3.2.1/opam +++ b/esy.lock/opam/zed.3.2.3/opam @@ -8,7 +8,7 @@ validation, and a rope datastructure to achieve efficient operations on large Unicode buffers. Zed also features a regular expression search on ropes. To support efficient text edition capabilities, Zed provides macro recording and cursor management facilities.""" -maintainer: ["opam-devel@lists.ocaml.org"] +maintainer: ["ZAN DoYe "] authors: ["Jérémie Dimino"] license: "BSD-3-Clause" homepage: "https://github.com/ocaml-community/zed" @@ -22,6 +22,7 @@ depends: [ "uutf" "uucp" {>= "2.0.0"} "uuseg" + "alcotest" {with-test} "odoc" {with-doc} ] build: [ @@ -40,11 +41,8 @@ build: [ ] dev-repo: "git+https://github.com/ocaml-community/zed.git" url { - src: - "https://github.com/ocaml-community/zed/releases/download/3.2.1/zed-3.2.1.tbz" + src: "https://github.com/ocaml-community/zed/archive/refs/tags/3.2.3.tar.gz" checksum: [ - "sha256=141091d21a03e92eed0efd96ece150c08c619bfbcd1b153a42d8a261b2b57f53" - "sha512=5c4c3bda52d3b8ba8618a91ac7864ebebd6020742e812d46f2a1cc78034acfc53b0a9b697424259b24fa84b367e36f154f35d4ac7ed536329294f000c7f52156" + "sha512=637f75129550f6459417549d44bed16bdc62721d2e9e0c6bb5bfab30c5bc6478de15faece8c091b56f238375cb79a7bc176375400e543120bb31d7ea626b7c5b" ] } -x-commit-hash: "a7f3d7f967ab8cebe99817a0224fc8fbc3c290b5" diff --git a/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/files/darwin.patch b/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/files/darwin.patch new file mode 100644 index 000000000..480861dca --- /dev/null +++ b/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/files/darwin.patch @@ -0,0 +1,26 @@ +--- ./otherlibs/configurator/src/v1.ml ++++ ./otherlibs/configurator/src/v1.ml +@@ -696,13 +696,16 @@ + which c "brew" + >>= fun brew -> + let new_pkg_config_path = +- let prefix = String.trim (Process.run_capture_exn c ~dir brew [ "--prefix" ]) in +- let p = sprintf "%s/opt/%s/lib/pkgconfig" (quote_if_needed prefix) package in +- Option.some_if +- (match Sys.is_directory p with +- | s -> s +- | exception Sys_error _ -> false) +- p ++ try ++ let prefix = String.trim (Process.run_capture_exn c ~dir brew [ "--prefix" ]) in ++ let p = sprintf "%s/opt/%s/lib/pkgconfig" (quote_if_needed prefix) package in ++ Option.some_if ++ (match Sys.is_directory p with ++ | s -> s ++ | exception Sys_error _ -> false) ++ p ++ with ++ | _ -> None + in + new_pkg_config_path + >>| fun new_pkg_config_path -> diff --git a/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/package.json b/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/package.json new file mode 100644 index 000000000..a34fc43ad --- /dev/null +++ b/esy.lock/overrides/opam__s__dune_configurator_opam__c__3.16.0_opam_override/package.json @@ -0,0 +1,27 @@ +{ + "build": [ + [ + "bash", + "-c", + "patch -p1 < darwin.patch" + ], + [ + "rm", + "-rf", + "vendor/csexp" + ], + [ + "rm", + "-rf", + "vendor/pp" + ], + [ + "dune", + "build", + "-p", + "dune-configurator", + "-j", + "4" + ] + ] +} diff --git a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2_opam_override/files/winpatch.patch b/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override/files/winpatch.patch similarity index 100% rename from esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2_opam_override/files/winpatch.patch rename to esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override/files/winpatch.patch diff --git a/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2_opam_override/package.json b/esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override/package.json similarity index 100% rename from esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.2_opam_override/package.json rename to esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.3+win_opam_override/package.json diff --git a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/files/findlib.patch b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/files/findlib.patch deleted file mode 100644 index 3aa5aa696..000000000 --- a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/files/findlib.patch +++ /dev/null @@ -1,485 +0,0 @@ ---- ./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 ---- ./src/findlib/frontend.ml -+++ ./src/findlib/frontend.ml -@@ -281,10 +281,8 @@ - - - let identify_dir d = -- if is_win then -- failwith "identify_dir"; (* not available *) - let s = Unix.stat d in -- (s.Unix.st_dev, s.Unix.st_ino) -+ (s.Unix.st_dev, s.Unix.st_ino) - ;; - - diff --git a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch new file mode 100644 index 000000000..d545632af --- /dev/null +++ b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/files/findlib.patch @@ -0,0 +1,11 @@ +--- ./Makefile ++++ ./Makefile +@@ -55,7 +55,7 @@ + export USE_CYGPATH; \ + cat findlib.conf.in | \ + $(SH) tools/patch '@SITELIB@' '$(OCAML_SITELIB)' | \ +- $(SH) tools/patch '@FINDLIB_PATH@' '$(FINDLIB_PATH)' -p >findlib.conf ++ $(SH) tools/patch '@FINDLIB_PATH@' '$(FINDLIB_PATH)' >findlib.conf + if ./tools/cmd_from_same_dir ocamlc; then \ + echo 'ocamlc="ocamlc.opt"' >>findlib.conf; \ + fi diff --git a/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/package.json b/esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json similarity index 100% rename from esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.5_opam_override/package.json rename to esy.lock/overrides/opam__s__ocamlfind_opam__c__1.9.6_opam_override/package.json diff --git a/esy.lock/overrides/opam__s__ptime_opam__c__1.1.0_opam_override/package.json b/esy.lock/overrides/opam__s__ptime_opam__c__1.1.0_opam_override/package.json new file mode 100644 index 000000000..59515d3d1 --- /dev/null +++ b/esy.lock/overrides/opam__s__ptime_opam__c__1.1.0_opam_override/package.json @@ -0,0 +1,3 @@ +{ + "build": "bash -c 'ocaml pkg/pkg.ml build --dev-pkg false || (./_build/sanitize.sh; ocaml pkg/pkg.ml build --dev-pkg false)'" +} From 008abbabb6f45a1a391175715f341cebf4ae055e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 22 Jun 2024 23:17:43 -0700 Subject: [PATCH 21/64] try to fix esy ci (#2740) * try fixing esy ci by installing nightly * clean up package.json * nightly --- .github/workflows/esy-ci.yml | 2 +- package-lock.json | 34 ---------------------------- package.json | 43 +++++++++++++++++------------------- 3 files changed, 21 insertions(+), 58 deletions(-) delete mode 100644 package-lock.json diff --git a/.github/workflows/esy-ci.yml b/.github/workflows/esy-ci.yml index 03e6eba4a..292d1fbd6 100644 --- a/.github/workflows/esy-ci.yml +++ b/.github/workflows/esy-ci.yml @@ -43,7 +43,7 @@ jobs: node-version: 16 - name: Install esy - run: npm install -g esy@0.6.12 + run: npm install -g @esy-nightly/esy - name: Restore global cache (~/.esy/source) id: global-cache diff --git a/package-lock.json b/package-lock.json deleted file mode 100644 index 3e9015a4a..000000000 --- a/package-lock.json +++ /dev/null @@ -1,34 +0,0 @@ -{ - "name": "reason", - "version": "3.6.2", - "lockfileVersion": 2, - "requires": true, - "packages": { - "": { - "name": "reason", - "version": "3.6.2", - "license": "MIT", - "dependencies": { - "bs-platform": "1.9.3" - } - }, - "node_modules/bs-platform": { - "version": "1.9.3", - "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-1.9.3.tgz", - "integrity": "sha512-Y37L43zKPoAJh8t7fbcxLlMYPvsjGR/CZrOF5Mr9tVBq53OaRmSXF9rDRYHjdMY8Nhpp99f0AD8aKnrr/cH6jg==", - "hasInstallScript": true, - "bin": { - "bsb": "bin/bsb", - "bsc": "bin/bsc", - "bsrefmt": "bin/bsrefmt" - } - } - }, - "dependencies": { - "bs-platform": { - "version": "1.9.3", - "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-1.9.3.tgz", - "integrity": "sha512-Y37L43zKPoAJh8t7fbcxLlMYPvsjGR/CZrOF5Mr9tVBq53OaRmSXF9rDRYHjdMY8Nhpp99f0AD8aKnrr/cH6jg==" - } - } -} diff --git a/package.json b/package.json index 37856b401..eaca98df0 100644 --- a/package.json +++ b/package.json @@ -1,25 +1,22 @@ { - "name": "reason", - "version": "3.6.2", - "description": "Simple, fast & type safe code that leverages the JavaScript & OCaml ecosystems", - "repository": { - "type": "git", - "url": "https://github.com/reasonml/reason.git" - }, - "main": "refmt.js", - "keywords": [ - "reason", - "ocaml", - "react", - "javascript", - "won't you look at all these nice types" - ], - "license": "MIT", - "homepage": "https://github.com/reasonml/reason", - "devDependencies": { - "bs-platform": "1.9.3" - }, - "scripts": { - "prepublishOnly": "cp .dune-for-prepublish dune && esy @jsoo && ./js/closurefy.sh" - } + "name": "reason", + "version": "3.6.2", + "description": "Simple, fast & type safe code that leverages the JavaScript & OCaml ecosystems", + "repository": { + "type": "git", + "url": "https://github.com/reasonml/reason.git" + }, + "main": "refmt.js", + "keywords": [ + "reason", + "ocaml", + "react", + "javascript", + "won't you look at all these nice types" + ], + "license": "MIT", + "homepage": "https://github.com/reasonml/reason", + "scripts": { + "prepublishOnly": "cp .dune-for-prepublish dune && esy @jsoo && ./js/closurefy.sh" + } } From 34eae5cbdb3387d7801f3be9f8c747d82a0bfb32 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Thu, 27 Jun 2024 10:02:10 -0700 Subject: [PATCH 22/64] add `\u{hex}` syntax (#2738) * add `\u{hex}` syntax * allow for error recovery * print source instead * add changelog entry --- CHANGES.md | 5 ++ .../reason_declarative_lexer.mll | 52 +++++++++++++++---- test/uchar-esc.t/input.re | 15 ++++++ test/uchar-esc.t/run.t | 33 ++++++++++++ 4 files changed, 95 insertions(+), 10 deletions(-) create mode 100644 test/uchar-esc.t/input.re create mode 100644 test/uchar-esc.t/run.t diff --git a/CHANGES.md b/CHANGES.md index d66d84a4a..5b061cb0d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +## Unreleased + +- Add `\u{hex-escape}` syntax (@anmonteiro, + [#2738](https://github.com/reasonml/reason/pull/2738)) + ## 3.11.0 - Print structure items extension nodes correctly inside modules (@anmonteiro, diff --git a/src/reason-parser/reason_declarative_lexer.mll b/src/reason-parser/reason_declarative_lexer.mll index 720dacaa1..2969f2cf9 100644 --- a/src/reason-parser/reason_declarative_lexer.mll +++ b/src/reason-parser/reason_declarative_lexer.mll @@ -231,6 +231,21 @@ let lexeme_operator lexbuf = (* To translate escape sequences *) +let hex_digit_value d = (* assert (d in '0'..'9' 'a'..'f' 'A'..'F') *) + let d = Char.code d in + if d >= 97 then d - 87 else + if d >= 65 then d - 55 else + d - 48 + +let hex_num_value lexbuf ~first ~last = + let rec loop acc i = match i > last with + | true -> acc + | false -> + let value = hex_digit_value (Lexing.lexeme_char lexbuf i) in + loop (16 * acc + value) (i + 1) + in + loop 0 first + let char_for_backslash = function | 'n' -> '\010' | 'r' -> '\013' @@ -250,17 +265,24 @@ let char_for_decimal_code lexbuf i = ) else Char.chr c let char_for_hexadecimal_code lexbuf i = - let d1 = Char.code (Lexing.lexeme_char lexbuf i) in - let val1 = if d1 >= 97 then d1 - 87 - else if d1 >= 65 then d1 - 55 - else d1 - 48 - in - let d2 = Char.code (Lexing.lexeme_char lexbuf (i+1)) in - let val2 = if d2 >= 97 then d2 - 87 - else if d2 >= 65 then d2 - 55 - else d2 - 48 + let byte = hex_num_value lexbuf ~first:i ~last:(i+1) in + Char.chr byte + +let uchar_for_uchar_escape lexbuf = + let err e = + raise_error (Location.curr lexbuf) (Illegal_escape (Lexing.lexeme lexbuf ^ e)); + Uchar.of_char 'u' in - Char.chr (val1 * 16 + val2) + let len = Lexing.lexeme_end lexbuf - Lexing.lexeme_start lexbuf in + let first = 3 (* skip opening \u{ *) in + let last = len - 2 (* skip closing } *) in + let digit_count = last - first + 1 in + match digit_count > 6 with + | true -> err ", too many digits, expected 1 to 6 hexadecimal digits" + | false -> + let cp = hex_num_value lexbuf ~first ~last in + if Uchar.is_valid cp then Uchar.unsafe_of_int cp else + err (", " ^ Printf.sprintf "%X" cp ^ " is not a Unicode scalar value") (* To convert integer literals, allowing max_int + 1 (PR#4210) *) @@ -326,6 +348,8 @@ let kwdopchar = ['$' '&' '*' '+' '-' '/' '<' '=' '>' '@' '^' '|' '.' '!'] let decimal_literal = ['0'-'9'] ['0'-'9' '_']* +let hex_digit = + ['0'-'9' 'A'-'F' 'a'-'f'] let hex_literal = '0' ['x' 'X'] ['0'-'9' 'A'-'F' 'a'-'f']['0'-'9' 'A'-'F' 'a'-'f' '_']* let oct_literal = @@ -819,6 +843,14 @@ and string rawbuf txtbuf = parse end; string rawbuf txtbuf lexbuf } + | '\\' 'u' '{' hex_digit+ '}' + { store_lexeme rawbuf lexbuf; + begin match txtbuf with + | None -> () + | Some buf -> Buffer.add_utf_8_uchar buf (uchar_for_uchar_escape lexbuf) + end; + string rawbuf txtbuf lexbuf + } | '\\' 'x' ['0'-'9' 'a'-'f' 'A'-'F'] ['0'-'9' 'a'-'f' 'A'-'F'] { store_lexeme rawbuf lexbuf; begin match txtbuf with diff --git a/test/uchar-esc.t/input.re b/test/uchar-esc.t/input.re new file mode 100644 index 000000000..c5ad17939 --- /dev/null +++ b/test/uchar-esc.t/input.re @@ -0,0 +1,15 @@ + + +let x = "\u{1F42B}"; +let y = "\u{0}"; +let y = "\u{00}"; +let y = "\u{000}"; +let y = "\u{000000}"; +let y = "\u{0000E9}"; +let y = "\u{10FFFF}"; + +let x = "\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}"; +let () = Format.eprintf ("x: %s@.", x); + +// in a comment +/* "\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}" */ diff --git a/test/uchar-esc.t/run.t b/test/uchar-esc.t/run.t new file mode 100644 index 000000000..71716729e --- /dev/null +++ b/test/uchar-esc.t/run.t @@ -0,0 +1,33 @@ +Test uchar escape lexing + + $ refmt ./input.re + let x = "\u{1F42B}"; + let y = "\u{0}"; + let y = "\u{00}"; + let y = "\u{000}"; + let y = "\u{000000}"; + let y = "\u{0000E9}"; + let y = "\u{10FFFF}"; + + let x = "\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}"; + let () = Format.eprintf("x: %s@.", x); + + // in a comment + /* "\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}\u{1F42B}" */ + +check internal translation + + $ ocamlc -dsource -pp 'refmt --print binary' -intf-suffix .rei -impl input.re -o test + let x = "\240\159\144\171" + let y = "\000" + let y = "\000" + let y = "\000" + let y = "\000" + let y = "\195\169" + let y = "\244\143\191\191" + let x = + "\240\159\144\171\240\159\144\171\240\159\144\171\240\159\144\171\240\159\144\171\240\159\144\171" + let () = Format.eprintf "x: %s@." x + + $ ./test + x: 🐫🐫🐫🐫🐫🐫 From 4474ac7d17678ebc20656b268a3c2de447781768 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 15:30:05 -0700 Subject: [PATCH 23/64] add correct upper bounds for ocaml (#2741) --- dune-project | 4 ++-- reason.opam | 2 +- rtop.opam | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/dune-project b/dune-project index a9e1089a0..8e321b74f 100644 --- a/dune-project +++ b/dune-project @@ -34,7 +34,7 @@ (ocaml (and (>= "4.03") - (< "5.2"))) + (< "5.3"))) (ocamlfind :build) (dune-build-info (>= 2.9.3)) @@ -56,7 +56,7 @@ (ocaml (and (>= "4.03") - (< "5.2"))) + (< "5.3"))) (reason (= :version)) (utop diff --git a/reason.opam b/reason.opam index d814410ba..93cb11124 100644 --- a/reason.opam +++ b/reason.opam @@ -16,7 +16,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.2"} + "ocaml" {>= "4.03" & < "5.3"} "ocamlfind" {build} "dune-build-info" {>= "2.9.3"} "menhir" {>= "20180523"} diff --git a/rtop.opam b/rtop.opam index 8998ee2da..decac463f 100644 --- a/rtop.opam +++ b/rtop.opam @@ -14,7 +14,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.2"} + "ocaml" {>= "4.03" & < "5.3"} "reason" {= version} "utop" {>= "2.0"} "odoc" {with-doc} From 9f9bda51fbed672eb4948112b2f3000914a69b58 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 16:00:24 -0700 Subject: [PATCH 24/64] esy: remove jsoo.json (#2742) --- jsoo.esy.lock/.gitattributes | 3 - jsoo.esy.lock/.gitignore | 3 - jsoo.esy.lock/index.json | 1506 ----------------- jsoo.esy.lock/opam/astring.0.8.5/opam | 37 - jsoo.esy.lock/opam/base-bytes.base/opam | 9 - jsoo.esy.lock/opam/base-threads.base/opam | 6 - jsoo.esy.lock/opam/base-unix.base/opam | 6 - jsoo.esy.lock/opam/biniou.1.2.1/opam | 45 - jsoo.esy.lock/opam/camomile.1.0.2/opam | 35 - jsoo.esy.lock/opam/charInfo_width.1.1.0/opam | 27 - jsoo.esy.lock/opam/cmdliner.1.0.4/opam | 36 - jsoo.esy.lock/opam/conf-m4.1/opam | 22 - jsoo.esy.lock/opam/cppo.1.6.6/opam | 37 - jsoo.esy.lock/opam/csexp.1.3.2/opam | 58 - .../opam/dot-merlin-reader.3.4.2/opam | 28 - .../opam/dune-configurator.2.7.1/opam | 47 - jsoo.esy.lock/opam/dune.2.7.1/opam | 56 - jsoo.esy.lock/opam/easy-format.1.3.2/opam | 46 - jsoo.esy.lock/opam/fix.20201120/opam | 24 - jsoo.esy.lock/opam/fpath.0.7.3/opam | 36 - .../opam/js_of_ocaml-compiler.3.8.0/opam | 40 - jsoo.esy.lock/opam/js_of_ocaml.3.8.0/opam | 31 - jsoo.esy.lock/opam/lambda-term.3.1.0/opam | 35 - jsoo.esy.lock/opam/lwt.5.3.0/opam | 63 - jsoo.esy.lock/opam/lwt_log.1.1.1/opam | 30 - jsoo.esy.lock/opam/lwt_react.1.1.3/opam | 33 - jsoo.esy.lock/opam/menhir.20201122/opam | 27 - jsoo.esy.lock/opam/menhirLib.20201122/opam | 28 - jsoo.esy.lock/opam/menhirSdk.20201122/opam | 28 - jsoo.esy.lock/opam/merlin-extend.0.6/opam | 30 - jsoo.esy.lock/opam/merlin.3.4.2/opam | 74 - jsoo.esy.lock/opam/mew.0.1.0/opam | 25 - jsoo.esy.lock/opam/mew_vi.0.5.0/opam | 25 - jsoo.esy.lock/opam/mmap.1.1.0/opam | 24 - .../opam/ocaml-compiler-libs.v0.12.3/opam | 29 - .../opam/ocaml-migrate-parsetree.2.1.0/opam | 36 - jsoo.esy.lock/opam/ocamlbuild.0.14.0/opam | 36 - .../opam/ocamlfind.1.8.1/files/ocaml-stub | 4 - .../ocamlfind.1.8.1/files/ocamlfind.install | 6 - jsoo.esy.lock/opam/ocamlfind.1.8.1/opam | 50 - jsoo.esy.lock/opam/ocplib-endian.1.1/opam | 38 - jsoo.esy.lock/opam/odoc.1.5.2/opam | 53 - jsoo.esy.lock/opam/ppx_derivers.1.2.1/opam | 23 - jsoo.esy.lock/opam/ppxlib.0.20.0/opam | 50 - jsoo.esy.lock/opam/re.1.9.0/opam | 42 - jsoo.esy.lock/opam/react.1.2.1/opam | 33 - jsoo.esy.lock/opam/result.1.5/opam | 22 - jsoo.esy.lock/opam/seq.base/files/META.seq | 4 - jsoo.esy.lock/opam/seq.base/files/seq.install | 3 - jsoo.esy.lock/opam/seq.base/opam | 15 - jsoo.esy.lock/opam/sexplib0.v0.14.0/opam | 26 - jsoo.esy.lock/opam/stdlib-shims.0.1.0/opam | 28 - jsoo.esy.lock/opam/topkg.1.0.3/opam | 48 - jsoo.esy.lock/opam/trie.1.0.0/opam | 19 - jsoo.esy.lock/opam/tyxml.4.4.0/opam | 47 - jsoo.esy.lock/opam/uchar.0.0.2/opam | 36 - jsoo.esy.lock/opam/utop.2.6.0/opam | 41 - jsoo.esy.lock/opam/uutf.1.0.2/opam | 40 - jsoo.esy.lock/opam/yojson.1.7.0/opam | 38 - jsoo.esy.lock/opam/zed.3.1.0/opam | 32 - .../package.json | 6 - .../files/build.sh | 10 - .../package.json | 8 - .../files/ocamlbuild-0.14.0.patch | 463 ----- .../package.json | 27 - .../files/findlib-1.8.1.patch | 471 ------ .../package.json | 61 - jsoo.json | 9 - 68 files changed, 4414 deletions(-) delete mode 100644 jsoo.esy.lock/.gitattributes delete mode 100644 jsoo.esy.lock/.gitignore delete mode 100644 jsoo.esy.lock/index.json delete mode 100644 jsoo.esy.lock/opam/astring.0.8.5/opam delete mode 100644 jsoo.esy.lock/opam/base-bytes.base/opam delete mode 100644 jsoo.esy.lock/opam/base-threads.base/opam delete mode 100644 jsoo.esy.lock/opam/base-unix.base/opam delete mode 100644 jsoo.esy.lock/opam/biniou.1.2.1/opam delete mode 100644 jsoo.esy.lock/opam/camomile.1.0.2/opam delete mode 100644 jsoo.esy.lock/opam/charInfo_width.1.1.0/opam delete mode 100644 jsoo.esy.lock/opam/cmdliner.1.0.4/opam delete mode 100644 jsoo.esy.lock/opam/conf-m4.1/opam delete mode 100644 jsoo.esy.lock/opam/cppo.1.6.6/opam delete mode 100644 jsoo.esy.lock/opam/csexp.1.3.2/opam delete mode 100644 jsoo.esy.lock/opam/dot-merlin-reader.3.4.2/opam delete mode 100644 jsoo.esy.lock/opam/dune-configurator.2.7.1/opam delete mode 100644 jsoo.esy.lock/opam/dune.2.7.1/opam delete mode 100644 jsoo.esy.lock/opam/easy-format.1.3.2/opam delete mode 100644 jsoo.esy.lock/opam/fix.20201120/opam delete mode 100644 jsoo.esy.lock/opam/fpath.0.7.3/opam delete mode 100644 jsoo.esy.lock/opam/js_of_ocaml-compiler.3.8.0/opam delete mode 100644 jsoo.esy.lock/opam/js_of_ocaml.3.8.0/opam delete mode 100644 jsoo.esy.lock/opam/lambda-term.3.1.0/opam delete mode 100644 jsoo.esy.lock/opam/lwt.5.3.0/opam delete mode 100644 jsoo.esy.lock/opam/lwt_log.1.1.1/opam delete mode 100644 jsoo.esy.lock/opam/lwt_react.1.1.3/opam delete mode 100644 jsoo.esy.lock/opam/menhir.20201122/opam delete mode 100644 jsoo.esy.lock/opam/menhirLib.20201122/opam delete mode 100644 jsoo.esy.lock/opam/menhirSdk.20201122/opam delete mode 100644 jsoo.esy.lock/opam/merlin-extend.0.6/opam delete mode 100644 jsoo.esy.lock/opam/merlin.3.4.2/opam delete mode 100644 jsoo.esy.lock/opam/mew.0.1.0/opam delete mode 100644 jsoo.esy.lock/opam/mew_vi.0.5.0/opam delete mode 100644 jsoo.esy.lock/opam/mmap.1.1.0/opam delete mode 100644 jsoo.esy.lock/opam/ocaml-compiler-libs.v0.12.3/opam delete mode 100644 jsoo.esy.lock/opam/ocaml-migrate-parsetree.2.1.0/opam delete mode 100644 jsoo.esy.lock/opam/ocamlbuild.0.14.0/opam delete mode 100644 jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub delete mode 100644 jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install delete mode 100644 jsoo.esy.lock/opam/ocamlfind.1.8.1/opam delete mode 100644 jsoo.esy.lock/opam/ocplib-endian.1.1/opam delete mode 100644 jsoo.esy.lock/opam/odoc.1.5.2/opam delete mode 100644 jsoo.esy.lock/opam/ppx_derivers.1.2.1/opam delete mode 100644 jsoo.esy.lock/opam/ppxlib.0.20.0/opam delete mode 100644 jsoo.esy.lock/opam/re.1.9.0/opam delete mode 100644 jsoo.esy.lock/opam/react.1.2.1/opam delete mode 100644 jsoo.esy.lock/opam/result.1.5/opam delete mode 100644 jsoo.esy.lock/opam/seq.base/files/META.seq delete mode 100644 jsoo.esy.lock/opam/seq.base/files/seq.install delete mode 100644 jsoo.esy.lock/opam/seq.base/opam delete mode 100644 jsoo.esy.lock/opam/sexplib0.v0.14.0/opam delete mode 100644 jsoo.esy.lock/opam/stdlib-shims.0.1.0/opam delete mode 100644 jsoo.esy.lock/opam/topkg.1.0.3/opam delete mode 100644 jsoo.esy.lock/opam/trie.1.0.0/opam delete mode 100644 jsoo.esy.lock/opam/tyxml.4.4.0/opam delete mode 100644 jsoo.esy.lock/opam/uchar.0.0.2/opam delete mode 100644 jsoo.esy.lock/opam/utop.2.6.0/opam delete mode 100644 jsoo.esy.lock/opam/uutf.1.0.2/opam delete mode 100644 jsoo.esy.lock/opam/yojson.1.7.0/opam delete mode 100644 jsoo.esy.lock/opam/zed.3.1.0/opam delete mode 100644 jsoo.esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json delete mode 100644 jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/files/build.sh delete mode 100644 jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/package.json delete mode 100644 jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch delete mode 100644 jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json delete mode 100644 jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch delete mode 100644 jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json delete mode 100644 jsoo.json diff --git a/jsoo.esy.lock/.gitattributes b/jsoo.esy.lock/.gitattributes deleted file mode 100644 index e0b4e26c5..000000000 --- a/jsoo.esy.lock/.gitattributes +++ /dev/null @@ -1,3 +0,0 @@ - -# Set eol to LF so files aren't converted to CRLF-eol on Windows. -* text eol=lf linguist-generated diff --git a/jsoo.esy.lock/.gitignore b/jsoo.esy.lock/.gitignore deleted file mode 100644 index a221be227..000000000 --- a/jsoo.esy.lock/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -# Reset any possible .gitignore, we want all esy.lock to be un-ignored. -!* diff --git a/jsoo.esy.lock/index.json b/jsoo.esy.lock/index.json deleted file mode 100644 index fee5367be..000000000 --- a/jsoo.esy.lock/index.json +++ /dev/null @@ -1,1506 +0,0 @@ -{ - "checksum": "cb78af6c5e0a74a3d9c296bdfd6372b5", - "root": "reason-cli@link-dev:./esy.json", - "node": { - "reason-cli@link-dev:./esy.json": { - "id": "reason-cli@link-dev:./esy.json", - "name": "reason-cli", - "version": "link-dev:./esy.json", - "source": { "type": "link-dev", "path": ".", "manifest": "esy.json" }, - "overrides": [ "jsoo.json" ], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/utop@opam:2.6.0@d5749530", - "@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:20201122@35e9e3ea", - "@opam/fix@opam:20201120@5c318621", "@opam/dune@opam:2.7.1@f5f493bc" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/odoc@opam:1.5.2@236518eb", - "@opam/merlin@opam:3.4.2@9a4d1fd4", - "@opam/js_of_ocaml@opam:3.8.0@c897ffea" - ] - }, - "ocaml@4.8.1000@d41d8cd9": { - "id": "ocaml@4.8.1000@d41d8cd9", - "name": "ocaml", - "version": "4.8.1000", - "source": { - "type": "install", - "source": [ - "archive:https://registry.npmjs.org/ocaml/-/ocaml-4.8.1000.tgz#sha1:abc435b5d4ddea2acba8b2df7efb81e2d1690db1" - ] - }, - "overrides": [], - "dependencies": [], - "devDependencies": [] - }, - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9": { - "id": - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9", - "name": "esy-m4", - "version": - "github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7", - "source": { - "type": "install", - "source": [ - "github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7" - ] - }, - "overrides": [], - "dependencies": [], - "devDependencies": [] - }, - "@opam/zed@opam:3.1.0@86c55416": { - "id": "@opam/zed@opam:3.1.0@86c55416", - "name": "@opam/zed", - "version": "opam:3.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/51/51e8676ba972e5ad727633c161e404b1#md5:51e8676ba972e5ad727633c161e404b1", - "archive:https://github.com/ocaml-community/zed/archive/3.1.0.tar.gz#md5:51e8676ba972e5ad727633c161e404b1" - ], - "opam": { - "name": "zed", - "version": "3.1.0", - "path": "jsoo.esy.lock/opam/zed.3.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/charInfo_width@opam:1.1.0@4296bdfe", - "@opam/camomile@opam:1.0.2@40411a6b", - "@opam/base-bytes@opam:base@19d0c2ff", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/charInfo_width@opam:1.1.0@4296bdfe", - "@opam/camomile@opam:1.0.2@40411a6b", - "@opam/base-bytes@opam:base@19d0c2ff" - ] - }, - "@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": "jsoo.esy.lock/opam/yojson.1.7.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/cppo@opam:1.6.6@f4f83858", - "@opam/biniou@opam:1.2.1@d7570399", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/biniou@opam:1.2.1@d7570399" - ] - }, - "@opam/uutf@opam:1.0.2@4440868f": { - "id": "@opam/uutf@opam:1.0.2@4440868f", - "name": "@opam/uutf", - "version": "opam:1.0.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/a7/a7c542405a39630c689a82bd7ef2292c#md5:a7c542405a39630c689a82bd7ef2292c", - "archive:http://erratique.ch/software/uutf/releases/uutf-1.0.2.tbz#md5:a7c542405a39630c689a82bd7ef2292c" - ], - "opam": { - "name": "uutf", - "version": "1.0.2", - "path": "jsoo.esy.lock/opam/uutf.1.0.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uchar@opam:0.0.2@c8218eea", - "@opam/topkg@opam:1.0.3@e4e10f1c", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@opam/cmdliner@opam:1.0.4@93208aac", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uchar@opam:0.0.2@c8218eea" - ] - }, - "@opam/utop@opam:2.6.0@d5749530": { - "id": "@opam/utop@opam:2.6.0@d5749530", - "name": "@opam/utop", - "version": "opam:2.6.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/4d/4d0a94c0db27e39629729e485a142255b824545b5ec0f62b909b7572e88bc99e#sha256:4d0a94c0db27e39629729e485a142255b824545b5ec0f62b909b7572e88bc99e", - "archive:https://github.com/ocaml-community/utop/releases/download/2.6.0/utop-2.6.0.tbz#sha256:4d0a94c0db27e39629729e485a142255b824545b5ec0f62b909b7572e88bc99e" - ], - "opam": { - "name": "utop", - "version": "2.6.0", - "path": "jsoo.esy.lock/opam/utop.2.6.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/lwt_react@opam:1.1.3@72987fcf", - "@opam/lwt@opam:5.3.0@0c09f517", - "@opam/lambda-term@opam:3.1.0@8adc2660", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/cppo@opam:1.6.6@f4f83858", - "@opam/camomile@opam:1.0.2@40411a6b", - "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/lwt_react@opam:1.1.3@72987fcf", - "@opam/lwt@opam:5.3.0@0c09f517", - "@opam/lambda-term@opam:3.1.0@8adc2660", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/camomile@opam:1.0.2@40411a6b", - "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084" - ] - }, - "@opam/uchar@opam:0.0.2@c8218eea": { - "id": "@opam/uchar@opam:0.0.2@c8218eea", - "name": "@opam/uchar", - "version": "opam:0.0.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/c9/c9ba2c738d264c420c642f7bb1cf4a36#md5:c9ba2c738d264c420c642f7bb1cf4a36", - "archive:https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz#md5:c9ba2c738d264c420c642f7bb1cf4a36" - ], - "opam": { - "name": "uchar", - "version": "0.0.2", - "path": "jsoo.esy.lock/opam/uchar.0.0.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@opam/tyxml@opam:4.4.0@1dca5713": { - "id": "@opam/tyxml@opam:4.4.0@1dca5713", - "name": "@opam/tyxml", - "version": "opam:4.4.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/51/516394dd4a5c31726997c51d66aa31cacb91e3c46d4e16c7699130e204042530#sha256:516394dd4a5c31726997c51d66aa31cacb91e3c46d4e16c7699130e204042530", - "archive:https://github.com/ocsigen/tyxml/releases/download/4.4.0/tyxml-4.4.0.tbz#sha256:516394dd4a5c31726997c51d66aa31cacb91e3c46d4e16c7699130e204042530" - ], - "opam": { - "name": "tyxml", - "version": "4.4.0", - "path": "jsoo.esy.lock/opam/tyxml.4.4.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uutf@opam:1.0.2@4440868f", - "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.9.0@d4d5e13d", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uutf@opam:1.0.2@4440868f", - "@opam/seq@opam:base@d8d7de1d", "@opam/re@opam:1.9.0@d4d5e13d", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/trie@opam:1.0.0@d2efc587": { - "id": "@opam/trie@opam:1.0.0@d2efc587", - "name": "@opam/trie", - "version": "opam:1.0.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/84/84519b5f8bd92490bfc68a52f706ba14#md5:84519b5f8bd92490bfc68a52f706ba14", - "archive:https://github.com/kandu/trie/archive/1.0.0.tar.gz#md5:84519b5f8bd92490bfc68a52f706ba14" - ], - "opam": { - "name": "trie", - "version": "1.0.0", - "path": "jsoo.esy.lock/opam/trie.1.0.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/topkg@opam:1.0.3@e4e10f1c": { - "id": "@opam/topkg@opam:1.0.3@e4e10f1c", - "name": "@opam/topkg", - "version": "opam:1.0.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e2/e285f7a296d77ee7d831ba9a6bfb396f#md5:e285f7a296d77ee7d831ba9a6bfb396f", - "archive:http://erratique.ch/software/topkg/releases/topkg-1.0.3.tbz#md5:e285f7a296d77ee7d831ba9a6bfb396f" - ], - "opam": { - "name": "topkg", - "version": "1.0.3", - "path": "jsoo.esy.lock/opam/topkg.1.0.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/ocamlbuild@opam:0.14.0@6ac75d03" - ] - }, - "@opam/stdlib-shims@opam:0.1.0@148f22ac": { - "id": "@opam/stdlib-shims@opam:0.1.0@148f22ac", - "name": "@opam/stdlib-shims", - "version": "opam:0.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/12/12b5704eed70c6bff5ac39a16db1425d#md5:12b5704eed70c6bff5ac39a16db1425d", - "archive:https://github.com/ocaml/stdlib-shims/releases/download/0.1.0/stdlib-shims-0.1.0.tbz#md5:12b5704eed70c6bff5ac39a16db1425d" - ], - "opam": { - "name": "stdlib-shims", - "version": "0.1.0", - "path": "jsoo.esy.lock/opam/stdlib-shims.0.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/sexplib0@opam:v0.14.0@ddeb6438": { - "id": "@opam/sexplib0@opam:v0.14.0@ddeb6438", - "name": "@opam/sexplib0", - "version": "opam:v0.14.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/37/37aff0af8f8f6f759249475684aebdc4#md5:37aff0af8f8f6f759249475684aebdc4", - "archive:https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib0-v0.14.0.tar.gz#md5:37aff0af8f8f6f759249475684aebdc4" - ], - "opam": { - "name": "sexplib0", - "version": "v0.14.0", - "path": "jsoo.esy.lock/opam/sexplib0.v0.14.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/seq@opam:base@d8d7de1d": { - "id": "@opam/seq@opam:base@d8d7de1d", - "name": "@opam/seq", - "version": "opam:base", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "seq", - "version": "base", - "path": "jsoo.esy.lock/opam/seq.base" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@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": "jsoo.esy.lock/opam/result.1.5" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/react@opam:1.2.1@0e11855f": { - "id": "@opam/react@opam:1.2.1@0e11855f", - "name": "@opam/react", - "version": "opam:1.2.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/ce/ce1454438ce4e9d2931248d3abba1fcc#md5:ce1454438ce4e9d2931248d3abba1fcc", - "archive:http://erratique.ch/software/react/releases/react-1.2.1.tbz#md5:ce1454438ce4e9d2931248d3abba1fcc" - ], - "opam": { - "name": "react", - "version": "1.2.1", - "path": "jsoo.esy.lock/opam/react.1.2.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/topkg@opam:1.0.3@e4e10f1c", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@opam/re@opam:1.9.0@d4d5e13d": { - "id": "@opam/re@opam:1.9.0@d4d5e13d", - "name": "@opam/re", - "version": "opam:1.9.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/bd/bddaed4f386a22cace7850c9c7dac296#md5:bddaed4f386a22cace7850c9c7dac296", - "archive:https://github.com/ocaml/ocaml-re/releases/download/1.9.0/re-1.9.0.tbz#md5:bddaed4f386a22cace7850c9c7dac296" - ], - "opam": { - "name": "re", - "version": "1.9.0", - "path": "jsoo.esy.lock/opam/re.1.9.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/ppxlib@opam:0.20.0@72354e44": { - "id": "@opam/ppxlib@opam:0.20.0@72354e44", - "name": "@opam/ppxlib", - "version": "opam:0.20.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/1c/1cb5903ef257de9c93e154cbb53df5979d4ad0f041d01967ea5984dd6d2cad37#sha256:1cb5903ef257de9c93e154cbb53df5979d4ad0f041d01967ea5984dd6d2cad37", - "archive:https://github.com/ocaml-ppx/ppxlib/releases/download/0.20.0/ppxlib-0.20.0.tbz#sha256:1cb5903ef257de9c93e154cbb53df5979d4ad0f041d01967ea5984dd6d2cad37" - ], - "opam": { - "name": "ppxlib", - "version": "0.20.0", - "path": "jsoo.esy.lock/opam/ppxlib.0.20.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/stdlib-shims@opam:0.1.0@148f22ac", - "@opam/sexplib0@opam:v0.14.0@ddeb6438", - "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/ocaml-migrate-parsetree@opam:2.1.0@a3b6747d", - "@opam/ocaml-compiler-libs@opam:v0.12.3@f0f069bd", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/stdlib-shims@opam:0.1.0@148f22ac", - "@opam/sexplib0@opam:v0.14.0@ddeb6438", - "@opam/ppx_derivers@opam:1.2.1@ecf0aa45", - "@opam/ocaml-migrate-parsetree@opam:2.1.0@a3b6747d", - "@opam/ocaml-compiler-libs@opam:v0.12.3@f0f069bd", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.esy.lock/opam/ppx_derivers.1.2.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/odoc@opam:1.5.2@236518eb": { - "id": "@opam/odoc@opam:1.5.2@236518eb", - "name": "@opam/odoc", - "version": "opam:1.5.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/d2/d24463f2660bc28c72cda001478360158e953721c9e23fb361ec4783113c4871#sha256:d24463f2660bc28c72cda001478360158e953721c9e23fb361ec4783113c4871", - "archive:https://github.com/ocaml/odoc/releases/download/1.5.2/odoc-1.5.2.tbz#sha256:d24463f2660bc28c72cda001478360158e953721c9e23fb361ec4783113c4871" - ], - "opam": { - "name": "odoc", - "version": "1.5.2", - "path": "jsoo.esy.lock/opam/odoc.1.5.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/tyxml@opam:4.4.0@1dca5713", - "@opam/result@opam:1.5@6b753c82", "@opam/fpath@opam:0.7.3@674d8125", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/cppo@opam:1.6.6@f4f83858", - "@opam/cmdliner@opam:1.0.4@93208aac", - "@opam/astring@opam:0.8.5@1300cee8", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/tyxml@opam:4.4.0@1dca5713", - "@opam/result@opam:1.5@6b753c82", "@opam/fpath@opam:0.7.3@674d8125", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/cmdliner@opam:1.0.4@93208aac", - "@opam/astring@opam:0.8.5@1300cee8" - ] - }, - "@opam/ocplib-endian@opam:1.1@84c1ca88": { - "id": "@opam/ocplib-endian@opam:1.1@84c1ca88", - "name": "@opam/ocplib-endian", - "version": "opam:1.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/de/dedf4d69c1b87b3c6c7234f632399285#md5:dedf4d69c1b87b3c6c7234f632399285", - "archive:https://github.com/OCamlPro/ocplib-endian/archive/1.1.tar.gz#md5:dedf4d69c1b87b3c6c7234f632399285" - ], - "opam": { - "name": "ocplib-endian", - "version": "1.1", - "path": "jsoo.esy.lock/opam/ocplib-endian.1.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/cppo@opam:1.6.6@f4f83858", - "@opam/base-bytes@opam:base@19d0c2ff", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/base-bytes@opam:base@19d0c2ff" - ] - }, - "@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": "jsoo.esy.lock/opam/ocamlfind.1.8.1" - } - }, - "overrides": [ - { - "opamoverride": - "jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override" - } - ], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/conf-m4@opam:1@196bf219", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@opam/ocamlbuild@opam:0.14.0@6ac75d03": { - "id": "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "name": "@opam/ocamlbuild", - "version": "opam:0.14.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/87/87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78#sha256:87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78", - "archive:https://github.com/ocaml/ocamlbuild/archive/0.14.0.tar.gz#sha256:87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78" - ], - "opam": { - "name": "ocamlbuild", - "version": "0.14.0", - "path": "jsoo.esy.lock/opam/ocamlbuild.0.14.0" - } - }, - "overrides": [ - { - "opamoverride": - "jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override" - } - ], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@opam/ocaml-migrate-parsetree@opam:2.1.0@a3b6747d": { - "id": "@opam/ocaml-migrate-parsetree@opam:2.1.0@a3b6747d", - "name": "@opam/ocaml-migrate-parsetree", - "version": "opam:2.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/38/387b788ee4c0537f1fe02c25e05f0335af424828fc6fe940acc0db5948a5a71f#sha256:387b788ee4c0537f1fe02c25e05f0335af424828fc6fe940acc0db5948a5a71f", - "archive:https://github.com/ocaml-ppx/ocaml-migrate-parsetree/releases/download/v2.1.0/ocaml-migrate-parsetree-v2.1.0.tbz#sha256:387b788ee4c0537f1fe02c25e05f0335af424828fc6fe940acc0db5948a5a71f" - ], - "opam": { - "name": "ocaml-migrate-parsetree", - "version": "2.1.0", - "path": "jsoo.esy.lock/opam/ocaml-migrate-parsetree.2.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/ocaml-compiler-libs@opam:v0.12.3@f0f069bd": { - "id": "@opam/ocaml-compiler-libs@opam:v0.12.3@f0f069bd", - "name": "@opam/ocaml-compiler-libs", - "version": "opam:v0.12.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/a8/a8403531439c14bbda2d504ef93610fd29a8e9520fc700f21889d893a513e3c9#sha256:a8403531439c14bbda2d504ef93610fd29a8e9520fc700f21889d893a513e3c9", - "archive:https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.3/ocaml-compiler-libs-v0.12.3.tbz#sha256:a8403531439c14bbda2d504ef93610fd29a8e9520fc700f21889d893a513e3c9" - ], - "opam": { - "name": "ocaml-compiler-libs", - "version": "v0.12.3", - "path": "jsoo.esy.lock/opam/ocaml-compiler-libs.v0.12.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/mmap@opam:1.1.0@b85334ff": { - "id": "@opam/mmap@opam:1.1.0@b85334ff", - "name": "@opam/mmap", - "version": "opam:1.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/8c/8c5d5fbc537296dc525867535fb878ba#md5:8c5d5fbc537296dc525867535fb878ba", - "archive:https://github.com/mirage/mmap/releases/download/v1.1.0/mmap-v1.1.0.tbz#md5:8c5d5fbc537296dc525867535fb878ba" - ], - "opam": { - "name": "mmap", - "version": "1.1.0", - "path": "jsoo.esy.lock/opam/mmap.1.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/mew_vi@opam:0.5.0@cf66c299": { - "id": "@opam/mew_vi@opam:0.5.0@cf66c299", - "name": "@opam/mew_vi", - "version": "opam:0.5.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/34/341e9a9a20383641015bf503952906bc#md5:341e9a9a20383641015bf503952906bc", - "archive:https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz#md5:341e9a9a20383641015bf503952906bc" - ], - "opam": { - "name": "mew_vi", - "version": "0.5.0", - "path": "jsoo.esy.lock/opam/mew_vi.0.5.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/mew@opam:0.1.0@a74f69d6", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/mew@opam:0.1.0@a74f69d6", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/mew@opam:0.1.0@a74f69d6": { - "id": "@opam/mew@opam:0.1.0@a74f69d6", - "name": "@opam/mew", - "version": "opam:0.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/22/2298149d1415cd804ab4e01f01ea10a0#md5:2298149d1415cd804ab4e01f01ea10a0", - "archive:https://github.com/kandu/mew/archive/0.1.0.tar.gz#md5:2298149d1415cd804ab4e01f01ea10a0" - ], - "opam": { - "name": "mew", - "version": "0.1.0", - "path": "jsoo.esy.lock/opam/mew.0.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/trie@opam:1.0.0@d2efc587", - "@opam/result@opam:1.5@6b753c82", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/trie@opam:1.0.0@d2efc587", - "@opam/result@opam:1.5@6b753c82", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.esy.lock/opam/merlin-extend.0.6" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/cppo@opam:1.6.6@f4f83858", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/merlin@opam:3.4.2@9a4d1fd4": { - "id": "@opam/merlin@opam:3.4.2@9a4d1fd4", - "name": "@opam/merlin", - "version": "opam:3.4.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e1/e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81#sha256:e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81", - "archive:https://github.com/ocaml/merlin/releases/download/v3.4.2/merlin-v3.4.2.tbz#sha256:e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81" - ], - "opam": { - "name": "merlin", - "version": "3.4.2", - "path": "jsoo.esy.lock/opam/merlin.3.4.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/result@opam:1.5@6b753c82", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/dot-merlin-reader@opam:3.4.2@55baebb0", - "@opam/csexp@opam:1.3.2@5cea14af", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/result@opam:1.5@6b753c82", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/dot-merlin-reader@opam:3.4.2@55baebb0", - "@opam/csexp@opam:1.3.2@5cea14af" - ] - }, - "@opam/menhirSdk@opam:20201122@552e084f": { - "id": "@opam/menhirSdk@opam:20201122@552e084f", - "name": "@opam/menhirSdk", - "version": "opam:20201122", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/9a/9ad6a5f88aab6ec677b970e0d9de1763#md5:9ad6a5f88aab6ec677b970e0d9de1763", - "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20201122/archive.tar.gz#md5:9ad6a5f88aab6ec677b970e0d9de1763" - ], - "opam": { - "name": "menhirSdk", - "version": "20201122", - "path": "jsoo.esy.lock/opam/menhirSdk.20201122" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/menhirLib@opam:20201122@a11a6018": { - "id": "@opam/menhirLib@opam:20201122@a11a6018", - "name": "@opam/menhirLib", - "version": "opam:20201122", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/9a/9ad6a5f88aab6ec677b970e0d9de1763#md5:9ad6a5f88aab6ec677b970e0d9de1763", - "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20201122/archive.tar.gz#md5:9ad6a5f88aab6ec677b970e0d9de1763" - ], - "opam": { - "name": "menhirLib", - "version": "20201122", - "path": "jsoo.esy.lock/opam/menhirLib.20201122" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/menhir@opam:20201122@35e9e3ea": { - "id": "@opam/menhir@opam:20201122@35e9e3ea", - "name": "@opam/menhir", - "version": "opam:20201122", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/9a/9ad6a5f88aab6ec677b970e0d9de1763#md5:9ad6a5f88aab6ec677b970e0d9de1763", - "archive:https://gitlab.inria.fr/fpottier/menhir/repository/20201122/archive.tar.gz#md5:9ad6a5f88aab6ec677b970e0d9de1763" - ], - "opam": { - "name": "menhir", - "version": "20201122", - "path": "jsoo.esy.lock/opam/menhir.20201122" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/menhirSdk@opam:20201122@552e084f", - "@opam/menhirLib@opam:20201122@a11a6018", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/menhirSdk@opam:20201122@552e084f", - "@opam/menhirLib@opam:20201122@a11a6018", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/lwt_react@opam:1.1.3@72987fcf": { - "id": "@opam/lwt_react@opam:1.1.3@72987fcf", - "name": "@opam/lwt_react", - "version": "opam:1.1.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/1a/1a72b5ae4245707c12656632a25fc18c#md5:1a72b5ae4245707c12656632a25fc18c", - "archive:https://github.com/ocsigen/lwt/archive/4.3.0.tar.gz#md5:1a72b5ae4245707c12656632a25fc18c" - ], - "opam": { - "name": "lwt_react", - "version": "1.1.3", - "path": "jsoo.esy.lock/opam/lwt_react.1.1.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/lwt@opam:5.3.0@0c09f517", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/react@opam:1.2.1@0e11855f", - "@opam/lwt@opam:5.3.0@0c09f517", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/lwt_log@opam:1.1.1@2d7a797f": { - "id": "@opam/lwt_log@opam:1.1.1@2d7a797f", - "name": "@opam/lwt_log", - "version": "opam:1.1.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/02/02e93be62288037870ae5b1ce099fe59#md5:02e93be62288037870ae5b1ce099fe59", - "archive:https://github.com/aantron/lwt_log/archive/1.1.1.tar.gz#md5:02e93be62288037870ae5b1ce099fe59" - ], - "opam": { - "name": "lwt_log", - "version": "1.1.1", - "path": "jsoo.esy.lock/opam/lwt_log.1.1.1" - } - }, - "overrides": [], - "dependencies": [ - "@opam/lwt@opam:5.3.0@0c09f517", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "@opam/lwt@opam:5.3.0@0c09f517", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/lwt@opam:5.3.0@0c09f517": { - "id": "@opam/lwt@opam:5.3.0@0c09f517", - "name": "@opam/lwt", - "version": "opam:5.3.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/85/85e9c7e9095b4e14d0698e3ece72f378#md5:85e9c7e9095b4e14d0698e3ece72f378", - "archive:https://github.com/ocsigen/lwt/archive/5.3.0.tar.gz#md5:85e9c7e9095b4e14d0698e3ece72f378" - ], - "opam": { - "name": "lwt", - "version": "5.3.0", - "path": "jsoo.esy.lock/opam/lwt.5.3.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/result@opam:1.5@6b753c82", - "@opam/ocplib-endian@opam:1.1@84c1ca88", - "@opam/mmap@opam:1.1.0@b85334ff", - "@opam/dune-configurator@opam:2.7.1@96307faa", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/cppo@opam:1.6.6@f4f83858", - "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/seq@opam:base@d8d7de1d", - "@opam/result@opam:1.5@6b753c82", - "@opam/ocplib-endian@opam:1.1@84c1ca88", - "@opam/mmap@opam:1.1.0@b85334ff", - "@opam/dune-configurator@opam:2.7.1@96307faa", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/lambda-term@opam:3.1.0@8adc2660": { - "id": "@opam/lambda-term@opam:3.1.0@8adc2660", - "name": "@opam/lambda-term", - "version": "opam:3.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/78/78180c04ecfc8060b23d7d0014f24196#md5:78180c04ecfc8060b23d7d0014f24196", - "archive:https://github.com/ocaml-community/lambda-term/archive/3.1.0.tar.gz#md5:78180c04ecfc8060b23d7d0014f24196" - ], - "opam": { - "name": "lambda-term", - "version": "3.1.0", - "path": "jsoo.esy.lock/opam/lambda-term.3.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/zed@opam:3.1.0@86c55416", - "@opam/react@opam:1.2.1@0e11855f", - "@opam/mew_vi@opam:0.5.0@cf66c299", - "@opam/lwt_react@opam:1.1.3@72987fcf", - "@opam/lwt_log@opam:1.1.1@2d7a797f", "@opam/lwt@opam:5.3.0@0c09f517", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/camomile@opam:1.0.2@40411a6b", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/zed@opam:3.1.0@86c55416", - "@opam/react@opam:1.2.1@0e11855f", - "@opam/mew_vi@opam:0.5.0@cf66c299", - "@opam/lwt_react@opam:1.1.3@72987fcf", - "@opam/lwt_log@opam:1.1.1@2d7a797f", "@opam/lwt@opam:5.3.0@0c09f517", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/camomile@opam:1.0.2@40411a6b" - ] - }, - "@opam/js_of_ocaml-compiler@opam:3.8.0@0b5efb6b": { - "id": "@opam/js_of_ocaml-compiler@opam:3.8.0@0b5efb6b", - "name": "@opam/js_of_ocaml-compiler", - "version": "opam:3.8.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/9e/9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219#sha256:9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219", - "archive:https://github.com/ocsigen/js_of_ocaml/releases/download/3.8.0/js_of_ocaml-3.8.0.tbz#sha256:9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219" - ], - "opam": { - "name": "js_of_ocaml-compiler", - "version": "3.8.0", - "path": "jsoo.esy.lock/opam/js_of_ocaml-compiler.3.8.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/ppxlib@opam:0.20.0@72354e44", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/menhir@opam:20201122@35e9e3ea", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/cmdliner@opam:1.0.4@93208aac", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/ppxlib@opam:0.20.0@72354e44", - "@opam/menhir@opam:20201122@35e9e3ea", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/cmdliner@opam:1.0.4@93208aac" - ] - }, - "@opam/js_of_ocaml@opam:3.8.0@c897ffea": { - "id": "@opam/js_of_ocaml@opam:3.8.0@c897ffea", - "name": "@opam/js_of_ocaml", - "version": "opam:3.8.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/9e/9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219#sha256:9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219", - "archive:https://github.com/ocsigen/js_of_ocaml/releases/download/3.8.0/js_of_ocaml-3.8.0.tbz#sha256:9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219" - ], - "opam": { - "name": "js_of_ocaml", - "version": "3.8.0", - "path": "jsoo.esy.lock/opam/js_of_ocaml.3.8.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uchar@opam:0.0.2@c8218eea", - "@opam/ppxlib@opam:0.20.0@72354e44", - "@opam/js_of_ocaml-compiler@opam:3.8.0@0b5efb6b", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/uchar@opam:0.0.2@c8218eea", - "@opam/ppxlib@opam:0.20.0@72354e44", - "@opam/js_of_ocaml-compiler@opam:3.8.0@0b5efb6b", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/fpath@opam:0.7.3@674d8125": { - "id": "@opam/fpath@opam:0.7.3@674d8125", - "name": "@opam/fpath", - "version": "opam:0.7.3", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/07/0740b530e8fed5b0adc5eee8463cfc2f#md5:0740b530e8fed5b0adc5eee8463cfc2f", - "archive:https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz#md5:0740b530e8fed5b0adc5eee8463cfc2f" - ], - "opam": { - "name": "fpath", - "version": "0.7.3", - "path": "jsoo.esy.lock/opam/fpath.0.7.3" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/topkg@opam:1.0.3@e4e10f1c", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@opam/astring@opam:0.8.5@1300cee8", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/astring@opam:0.8.5@1300cee8" - ] - }, - "@opam/fix@opam:20201120@5c318621": { - "id": "@opam/fix@opam:20201120@5c318621", - "name": "@opam/fix", - "version": "opam:20201120", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/7e/7eb570b759635fe66f3556d2b1cc88e3#md5:7eb570b759635fe66f3556d2b1cc88e3", - "archive:https://gitlab.inria.fr/fpottier/fix/repository/20201120/archive.tar.gz#md5:7eb570b759635fe66f3556d2b1cc88e3" - ], - "opam": { - "name": "fix", - "version": "20201120", - "path": "jsoo.esy.lock/opam/fix.20201120" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.esy.lock/opam/easy-format.1.3.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@opam/dune-configurator@opam:2.7.1@96307faa": { - "id": "@opam/dune-configurator@opam:2.7.1@96307faa", - "name": "@opam/dune-configurator", - "version": "opam:2.7.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/c3/c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d#sha256:c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d", - "archive:https://github.com/ocaml/dune/releases/download/2.7.1/dune-2.7.1.tbz#sha256:c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d" - ], - "opam": { - "name": "dune-configurator", - "version": "2.7.1", - "path": "jsoo.esy.lock/opam/dune-configurator.2.7.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/csexp@opam:1.3.2@5cea14af", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/csexp@opam:1.3.2@5cea14af" - ] - }, - "@opam/dune@opam:2.7.1@f5f493bc": { - "id": "@opam/dune@opam:2.7.1@f5f493bc", - "name": "@opam/dune", - "version": "opam:2.7.1", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/c3/c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d#sha256:c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d", - "archive:https://github.com/ocaml/dune/releases/download/2.7.1/dune-2.7.1.tbz#sha256:c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d" - ], - "opam": { - "name": "dune", - "version": "2.7.1", - "path": "jsoo.esy.lock/opam/dune.2.7.1" - } - }, - "overrides": [ - { - "opamoverride": - "jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override" - } - ], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/base-unix@opam:base@87d0b2eb", - "@opam/base-threads@opam:base@36803084" - ] - }, - "@opam/dot-merlin-reader@opam:3.4.2@55baebb0": { - "id": "@opam/dot-merlin-reader@opam:3.4.2@55baebb0", - "name": "@opam/dot-merlin-reader", - "version": "opam:3.4.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/e1/e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81#sha256:e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81", - "archive:https://github.com/ocaml/merlin/releases/download/v3.4.2/merlin-v3.4.2.tbz#sha256:e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81" - ], - "opam": { - "name": "dot-merlin-reader", - "version": "3.4.2", - "path": "jsoo.esy.lock/opam/dot-merlin-reader.3.4.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/result@opam:1.5@6b753c82", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/csexp@opam:1.3.2@5cea14af", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/yojson@opam:1.7.0@7056d985", - "@opam/result@opam:1.5@6b753c82", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/dune@opam:2.7.1@f5f493bc", "@opam/csexp@opam:1.3.2@5cea14af" - ] - }, - "@opam/csexp@opam:1.3.2@5cea14af": { - "id": "@opam/csexp@opam:1.3.2@5cea14af", - "name": "@opam/csexp", - "version": "opam:1.3.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/f2/f21f427b277f07e8bfd050e00c640a5893c1bf4b689147640fa383255dcf1c4a#sha256:f21f427b277f07e8bfd050e00c640a5893c1bf4b689147640fa383255dcf1c4a", - "archive:https://github.com/ocaml-dune/csexp/releases/download/1.3.2/csexp-1.3.2.tbz#sha256:f21f427b277f07e8bfd050e00c640a5893c1bf4b689147640fa383255dcf1c4a" - ], - "opam": { - "name": "csexp", - "version": "1.3.2", - "path": "jsoo.esy.lock/opam/csexp.1.3.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.esy.lock/opam/cppo.1.6.6" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/base-unix@opam:base@87d0b2eb", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/base-unix@opam:base@87d0b2eb" - ] - }, - "@opam/conf-m4@opam:1@196bf219": { - "id": "@opam/conf-m4@opam:1@196bf219", - "name": "@opam/conf-m4", - "version": "opam:1", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "conf-m4", - "version": "1", - "path": "jsoo.esy.lock/opam/conf-m4.1" - } - }, - "overrides": [ - { - "opamoverride": - "jsoo.esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override" - } - ], - "dependencies": [ - "esy-m4@github:esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7@d41d8cd9", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [] - }, - "@opam/cmdliner@opam:1.0.4@93208aac": { - "id": "@opam/cmdliner@opam:1.0.4@93208aac", - "name": "@opam/cmdliner", - "version": "opam:1.0.4", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/fe/fe2213d0bc63b1e10a2d0aa66d2fc8d9#md5:fe2213d0bc63b1e10a2d0aa66d2fc8d9", - "archive:http://erratique.ch/software/cmdliner/releases/cmdliner-1.0.4.tbz#md5:fe2213d0bc63b1e10a2d0aa66d2fc8d9" - ], - "opam": { - "name": "cmdliner", - "version": "1.0.4", - "path": "jsoo.esy.lock/opam/cmdliner.1.0.4" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@opam/charInfo_width@opam:1.1.0@4296bdfe": { - "id": "@opam/charInfo_width@opam:1.1.0@4296bdfe", - "name": "@opam/charInfo_width", - "version": "opam:1.1.0", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/a5/a539436d1da4aeb93711303f107bec7e#md5:a539436d1da4aeb93711303f107bec7e", - "archive:https://github.com/kandu/charInfo_width/archive/1.1.0.tar.gz#md5:a539436d1da4aeb93711303f107bec7e" - ], - "opam": { - "name": "charInfo_width", - "version": "1.1.0", - "path": "jsoo.esy.lock/opam/charInfo_width.1.1.0" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/camomile@opam:1.0.2@40411a6b", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/result@opam:1.5@6b753c82", - "@opam/dune@opam:2.7.1@f5f493bc", - "@opam/camomile@opam:1.0.2@40411a6b" - ] - }, - "@opam/camomile@opam:1.0.2@40411a6b": { - "id": "@opam/camomile@opam:1.0.2@40411a6b", - "name": "@opam/camomile", - "version": "opam:1.0.2", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/sha256/f0/f0a419b0affc36500f83b086ffaa36c545560cee5d57e84b729e8f851b3d1632#sha256:f0a419b0affc36500f83b086ffaa36c545560cee5d57e84b729e8f851b3d1632", - "archive:https://github.com/yoriyuki/Camomile/releases/download/1.0.2/camomile-1.0.2.tbz#sha256:f0a419b0affc36500f83b086ffaa36c545560cee5d57e84b729e8f851b3d1632" - ], - "opam": { - "name": "camomile", - "version": "1.0.2", - "path": "jsoo.esy.lock/opam/camomile.1.0.2" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.esy.lock/opam/biniou.1.2.1" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:2.7.1@f5f493bc", "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/easy-format@opam:1.3.2@0484b3c4", - "@opam/dune@opam:2.7.1@f5f493bc" - ] - }, - "@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": "jsoo.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": "jsoo.esy.lock/opam/base-threads.base" - } - }, - "overrides": [], - "dependencies": [ "@esy-ocaml/substs@0.0.1@d41d8cd9" ], - "devDependencies": [] - }, - "@opam/base-bytes@opam:base@19d0c2ff": { - "id": "@opam/base-bytes@opam:base@19d0c2ff", - "name": "@opam/base-bytes", - "version": "opam:base", - "source": { - "type": "install", - "source": [ "no-source:" ], - "opam": { - "name": "base-bytes", - "version": "base", - "path": "jsoo.esy.lock/opam/base-bytes.base" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/ocamlfind@opam:1.8.1@ff07b0f9" - ] - }, - "@opam/astring@opam:0.8.5@1300cee8": { - "id": "@opam/astring@opam:0.8.5@1300cee8", - "name": "@opam/astring", - "version": "opam:0.8.5", - "source": { - "type": "install", - "source": [ - "archive:https://opam.ocaml.org/cache/md5/e1/e148907c24157d1df43bec89b58b3ec8#md5:e148907c24157d1df43bec89b58b3ec8", - "archive:https://erratique.ch/software/astring/releases/astring-0.8.5.tbz#md5:e148907c24157d1df43bec89b58b3ec8" - ], - "opam": { - "name": "astring", - "version": "0.8.5", - "path": "jsoo.esy.lock/opam/astring.0.8.5" - } - }, - "overrides": [], - "dependencies": [ - "ocaml@4.8.1000@d41d8cd9", "@opam/topkg@opam:1.0.3@e4e10f1c", - "@opam/ocamlfind@opam:1.8.1@ff07b0f9", - "@opam/ocamlbuild@opam:0.14.0@6ac75d03", - "@esy-ocaml/substs@0.0.1@d41d8cd9" - ], - "devDependencies": [ "ocaml@4.8.1000@d41d8cd9" ] - }, - "@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/jsoo.esy.lock/opam/astring.0.8.5/opam b/jsoo.esy.lock/opam/astring.0.8.5/opam deleted file mode 100644 index 338a06a3e..000000000 --- a/jsoo.esy.lock/opam/astring.0.8.5/opam +++ /dev/null @@ -1,37 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["The astring programmers"] -homepage: "https://erratique.ch/software/astring" -doc: "https://erratique.ch/software/astring/doc" -dev-repo: "git+http://erratique.ch/repos/astring.git" -bug-reports: "https://github.com/dbuenzli/astring/issues" -tags: [ "string" "org:erratique" ] -license: "ISC" -depends: [ - "ocaml" {>= "4.05.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build} ] -build: [[ "ocaml" "pkg/pkg.ml" "build" "--pinned" "%{pinned}%" ]] - -synopsis: """Alternative String module for OCaml""" -description: """\ - -Astring exposes an alternative `String` module for OCaml. This module -tries to balance minimality and expressiveness for basic, index-free, -string processing and provides types and functions for substrings, -string sets and string maps. - -Remaining compatible with the OCaml `String` module is a non-goal. The -`String` module exposed by Astring has exception safe functions, -removes deprecated and rarely used functions, alters some signatures -and names, adds a few missing functions and fully exploits OCaml's -newfound string immutability. - -Astring depends only on the OCaml standard library. It is distributed -under the ISC license. -""" -url { -archive: "https://erratique.ch/software/astring/releases/astring-0.8.5.tbz" -checksum: "e148907c24157d1df43bec89b58b3ec8" -} diff --git a/jsoo.esy.lock/opam/base-bytes.base/opam b/jsoo.esy.lock/opam/base-bytes.base/opam deleted file mode 100644 index f1cae506c..000000000 --- a/jsoo.esy.lock/opam/base-bytes.base/opam +++ /dev/null @@ -1,9 +0,0 @@ -opam-version: "2.0" -maintainer: " " -authors: " " -homepage: " " -depends: [ - "ocaml" {>= "4.02.0"} - "ocamlfind" {>= "1.5.3"} -] -synopsis: "Bytes library distributed with the OCaml compiler" diff --git a/jsoo.esy.lock/opam/base-threads.base/opam b/jsoo.esy.lock/opam/base-threads.base/opam deleted file mode 100644 index 914ff50ce..000000000 --- a/jsoo.esy.lock/opam/base-threads.base/opam +++ /dev/null @@ -1,6 +0,0 @@ -opam-version: "2.0" -maintainer: "https://github.com/ocaml/opam-repository/issues" -description: """ -Threads library distributed with the OCaml compiler -""" - diff --git a/jsoo.esy.lock/opam/base-unix.base/opam b/jsoo.esy.lock/opam/base-unix.base/opam deleted file mode 100644 index b973540bc..000000000 --- a/jsoo.esy.lock/opam/base-unix.base/opam +++ /dev/null @@ -1,6 +0,0 @@ -opam-version: "2.0" -maintainer: "https://github.com/ocaml/opam-repository/issues" -description: """ -Unix library distributed with the OCaml compiler -""" - diff --git a/jsoo.esy.lock/opam/biniou.1.2.1/opam b/jsoo.esy.lock/opam/biniou.1.2.1/opam deleted file mode 100644 index b706b4251..000000000 --- a/jsoo.esy.lock/opam/biniou.1.2.1/opam +++ /dev/null @@ -1,45 +0,0 @@ -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/jsoo.esy.lock/opam/camomile.1.0.2/opam b/jsoo.esy.lock/opam/camomile.1.0.2/opam deleted file mode 100644 index 39e6f80f8..000000000 --- a/jsoo.esy.lock/opam/camomile.1.0.2/opam +++ /dev/null @@ -1,35 +0,0 @@ -opam-version: "2.0" -synopsis: "A Unicode library" -description: """ -Camomile is a Unicode library for OCaml. Camomile provides Unicode character -type, UTF-8, UTF-16, UTF-32 strings, conversion to/from about 200 encodings, -collation and locale-sensitive case mappings, and more. The library is currently -designed for Unicode Standard 3.2.""" -maintainer: ["yoriyuki.y@gmail.com"] -authors: ["Yoriyuki Yamagata"] -license: "LGPL-2.1-or-later with OCaml-LGPL-linking-exception" -homepage: "https://github.com/yoriyuki/Camomile" -doc: "https://yoriyuki.github.io/Camomile/" -bug-reports: "https://github.com/yoriyuki/Camomile/issues" -depends: [ - "dune" {>= "1.11"} - "ocaml" {>= "4.02.3"} -] -dev-repo: "git+https://github.com/yoriyuki/Camomile.git" -build: [ - ["ocaml" "configure.ml" "--share" "%{share}%/camomile"] - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs - "@install" - "@doc" {with-doc} - ] -] -url { - src: - "https://github.com/yoriyuki/Camomile/releases/download/1.0.2/camomile-1.0.2.tbz" - checksum: [ - "sha256=f0a419b0affc36500f83b086ffaa36c545560cee5d57e84b729e8f851b3d1632" - "sha512=7586422e68779476206027c6ebbe19b677fbe459153221f7c952c7fae374c5c8232249cb76fdb1f482069707aa1580be827cd39693906142988268b7f0e7f6d0" - ] -} -available: arch != "ppc64" diff --git a/jsoo.esy.lock/opam/charInfo_width.1.1.0/opam b/jsoo.esy.lock/opam/charInfo_width.1.1.0/opam deleted file mode 100644 index c88c2c9d4..000000000 --- a/jsoo.esy.lock/opam/charInfo_width.1.1.0/opam +++ /dev/null @@ -1,27 +0,0 @@ -opam-version: "2.0" -maintainer: "zandoye@gmail.com" -authors: [ "ZAN DoYe" ] -homepage: "https://github.com/kandu/charinfo_width/" -bug-reports: "https://github.com/kandu/charinfo_width/issues" -license: "MIT" -dev-repo: "git://github.com/kandu/charinfo_width.git" -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test & (ocaml:version >= "4.04.0")} -] -depends: [ - "ocaml" {>= "4.02.3"} - "result" - "camomile" {>= "1.0.0" & < "2.0~"} - "dune" - "ppx_expect" {with-test & < "v0.15"} -] - -synopsis: "Determine column width for a character" -description: """ -This module is implemented purely in OCaml and the width function follows the prototype of POSIX's wcwidth.""" - -url { - src:"https://github.com/kandu/charInfo_width/archive/1.1.0.tar.gz" - checksum: "md5=a539436d1da4aeb93711303f107bec7e" -} diff --git a/jsoo.esy.lock/opam/cmdliner.1.0.4/opam b/jsoo.esy.lock/opam/cmdliner.1.0.4/opam deleted file mode 100644 index b2187dc5b..000000000 --- a/jsoo.esy.lock/opam/cmdliner.1.0.4/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["Daniel Bünzli "] -homepage: "http://erratique.ch/software/cmdliner" -doc: "http://erratique.ch/software/cmdliner/doc/Cmdliner" -dev-repo: "git+http://erratique.ch/repos/cmdliner.git" -bug-reports: "https://github.com/dbuenzli/cmdliner/issues" -tags: [ "cli" "system" "declarative" "org:erratique" ] -license: "ISC" -depends:[ "ocaml" {>= "4.03.0"} ] -build: [[ make "all" "PREFIX=%{prefix}%" ]] -install: -[[make "install" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%" ] - [make "install-doc" "LIBDIR=%{_:lib}%" "DOCDIR=%{_:doc}%" ]] - -synopsis: """Declarative definition of command line interfaces for OCaml""" -description: """\ - -Cmdliner allows the declarative definition of command line interfaces -for OCaml. - -It provides a simple and compositional mechanism to convert command -line arguments to OCaml values and pass them to your functions. The -module automatically handles syntax errors, help messages and UNIX man -page generation. It supports programs with single or multiple commands -and respects most of the [POSIX][1] and [GNU][2] conventions. - -Cmdliner has no dependencies and is distributed under the ISC license. - -[1]: http://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html -[2]: http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html -""" -url { -archive: "http://erratique.ch/software/cmdliner/releases/cmdliner-1.0.4.tbz" -checksum: "fe2213d0bc63b1e10a2d0aa66d2fc8d9" -} diff --git a/jsoo.esy.lock/opam/conf-m4.1/opam b/jsoo.esy.lock/opam/conf-m4.1/opam deleted file mode 100644 index c6feb2a74..000000000 --- a/jsoo.esy.lock/opam/conf-m4.1/opam +++ /dev/null @@ -1,22 +0,0 @@ -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/jsoo.esy.lock/opam/cppo.1.6.6/opam b/jsoo.esy.lock/opam/cppo.1.6.6/opam deleted file mode 100644 index f683f8b41..000000000 --- a/jsoo.esy.lock/opam/cppo.1.6.6/opam +++ /dev/null @@ -1,37 +0,0 @@ -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/jsoo.esy.lock/opam/csexp.1.3.2/opam b/jsoo.esy.lock/opam/csexp.1.3.2/opam deleted file mode 100644 index 1508d17af..000000000 --- a/jsoo.esy.lock/opam/csexp.1.3.2/opam +++ /dev/null @@ -1,58 +0,0 @@ -opam-version: "2.0" -synopsis: "Parsing and printing of S-expressions in Canonical form" -description: """ - -This library provides minimal support for Canonical S-expressions -[1]. Canonical S-expressions are a binary encoding of S-expressions -that is super simple and well suited for communication between -programs. - -This library only provides a few helpers for simple applications. If -you need more advanced support, such as parsing from more fancy input -sources, you should consider copying the code of this library given -how simple parsing S-expressions in canonical form is. - -To avoid a dependency on a particular S-expression library, the only -module of this library is parameterised by the type of S-expressions. - -[1] https://en.wikipedia.org/wiki/Canonical_S-expressions -""" -maintainer: ["Jeremie Dimino "] -authors: [ - "Quentin Hocquet " - "Jane Street Group, LLC " - "Jeremie Dimino " -] -license: "MIT" -homepage: "https://github.com/ocaml-dune/csexp" -doc: "https://ocaml-dune.github.io/csexp/" -bug-reports: "https://github.com/ocaml-dune/csexp/issues" -depends: [ - "dune" {>= "1.11"} - "ocaml" {>= "4.02.3"} - "result" {>= "1.5"} -] -dev-repo: "git+https://github.com/ocaml-dune/csexp.git" -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" -# "@runtest" {with-test & ocaml:version >= "4.04"} - "@doc" {with-doc} - ] -] -x-commit-hash: "19a2e7bc171a707059c73d78dd18e4e3ff03ac9b" -url { - src: - "https://github.com/ocaml-dune/csexp/releases/download/1.3.2/csexp-1.3.2.tbz" - checksum: [ - "sha256=f21f427b277f07e8bfd050e00c640a5893c1bf4b689147640fa383255dcf1c4a" - "sha512=ff1bd6a7c6bb3a73ca9ab0506c9ec1f357657deaa9ecc7eb32955817d9b0f266d976af3e2b8fc34c621cb0caf1fde55f9a609dd184e2054f500bf09afeb83026" - ] -} diff --git a/jsoo.esy.lock/opam/dot-merlin-reader.3.4.2/opam b/jsoo.esy.lock/opam/dot-merlin-reader.3.4.2/opam deleted file mode 100644 index e740ed7da..000000000 --- a/jsoo.esy.lock/opam/dot-merlin-reader.3.4.2/opam +++ /dev/null @@ -1,28 +0,0 @@ -opam-version: "2.0" -maintainer: "defree@gmail.com" -authors: "The Merlin team" -synopsis: "Reads config files for merlin" -homepage: "https://github.com/ocaml/merlin" -bug-reports: "https://github.com/ocaml/merlin/issues" -dev-repo: "git+https://github.com/ocaml/merlin.git" -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.02.1" & < "4.12"} - "dune" {>= "1.8.0"} - "yojson" {>= "1.6.0"} - "ocamlfind" {>= "1.6.0"} - "csexp" {>= "1.2.3"} - "result" {>= "1.5"} -] -x-commit-hash: "c9761a552380838e9f530b5c47c0ea3c47c33565" -url { - src: - "https://github.com/ocaml/merlin/releases/download/v3.4.2/merlin-v3.4.2.tbz" - checksum: [ - "sha256=e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81" - "sha512=7c39c70fc923971c4eca9432061077941498574c0b804efc20af244c1c9ab34c9178d7eb50ab750feaac30696e7ff911a0ccd5fb86341b68485bedae472aa15f" - ] -} diff --git a/jsoo.esy.lock/opam/dune-configurator.2.7.1/opam b/jsoo.esy.lock/opam/dune-configurator.2.7.1/opam deleted file mode 100644 index 3a02b1af2..000000000 --- a/jsoo.esy.lock/opam/dune-configurator.2.7.1/opam +++ /dev/null @@ -1,47 +0,0 @@ -opam-version: "2.0" -synopsis: "Helper library for gathering system configuration" -description: """ -dune-configurator is a small library that helps writing OCaml scripts that -test features available on the system, in order to generate config.h -files for instance. -Among other things, dune-configurator allows one to: -- test if a C program compiles -- query pkg-config -- import #define from OCaml header files -- generate config.h file -""" -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" -depends: [ - "dune" {>= "2.7"} - "ocaml" {>= "4.03.0"} - "result" - "csexp" {>= "1.3.0"} - "odoc" {with-doc} -] -dev-repo: "git+https://github.com/ocaml/dune.git" -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@doc" {with-doc} - ] -] -x-commit-hash: "5472766b2448308a7160dfd0fca1ec711e124a5c" -url { - src: "https://github.com/ocaml/dune/releases/download/2.7.1/dune-2.7.1.tbz" - checksum: [ - "sha256=c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d" - "sha512=2b4b311824471dac8196181d7c7267f96b1b73f35341b72019f169cf6d42a19254e90bdfba2d3ecb138ad318e2e2431dd0ec6c38d9efe1da382ec95f5d9e959b" - ] -} diff --git a/jsoo.esy.lock/opam/dune.2.7.1/opam b/jsoo.esy.lock/opam/dune.2.7.1/opam deleted file mode 100644 index aaa13e677..000000000 --- a/jsoo.esy.lock/opam/dune.2.7.1/opam +++ /dev/null @@ -1,56 +0,0 @@ -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 .github/workflows/workflow.yml, - # dune-project and min_ocaml_version in bootstrap.ml - ("ocaml" {>= "4.08"} | ("ocaml" {< "4.08~~"} & "ocamlfind-secondary")) - "base-unix" - "base-threads" -] -x-commit-hash: "5472766b2448308a7160dfd0fca1ec711e124a5c" -url { - src: "https://github.com/ocaml/dune/releases/download/2.7.1/dune-2.7.1.tbz" - checksum: [ - "sha256=c3528f2f8b3a2e3fe18e166fc823e6caeee8b7c78ade6b6fe4d2fa978070925d" - "sha512=2b4b311824471dac8196181d7c7267f96b1b73f35341b72019f169cf6d42a19254e90bdfba2d3ecb138ad318e2e2431dd0ec6c38d9efe1da382ec95f5d9e959b" - ] -} diff --git a/jsoo.esy.lock/opam/easy-format.1.3.2/opam b/jsoo.esy.lock/opam/easy-format.1.3.2/opam deleted file mode 100644 index 138d0fb23..000000000 --- a/jsoo.esy.lock/opam/easy-format.1.3.2/opam +++ /dev/null @@ -1,46 +0,0 @@ -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/jsoo.esy.lock/opam/fix.20201120/opam b/jsoo.esy.lock/opam/fix.20201120/opam deleted file mode 100644 index 31c8a641a..000000000 --- a/jsoo.esy.lock/opam/fix.20201120/opam +++ /dev/null @@ -1,24 +0,0 @@ -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/20201120/archive.tar.gz" - checksum: [ - "md5=7eb570b759635fe66f3556d2b1cc88e3" - "sha512=344dcc619f9e8b8a6c998775b6d2dab2ea5253e6a67abe4797f76dc5dd30bc776568abce1e90477422e9db447821579889737e3531c42139708f813e983ea5d4" - ] -} diff --git a/jsoo.esy.lock/opam/fpath.0.7.3/opam b/jsoo.esy.lock/opam/fpath.0.7.3/opam deleted file mode 100644 index ae3336e42..000000000 --- a/jsoo.esy.lock/opam/fpath.0.7.3/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["The fpath programmers"] -homepage: "https://erratique.ch/software/fpath" -doc: "https://erratique.ch/software/fpath/doc" -dev-repo: "git+https://erratique.ch/repos/fpath.git" -bug-reports: "https://github.com/dbuenzli/fpath/issues" -tags: [ "file" "system" "path" "org:erratique" ] -license: "ISC" -depends: [ - "ocaml" {>= "4.03.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build & >= "0.9.0"} - "astring" -] -build: [[ - "ocaml" "pkg/pkg.ml" "build" - "--dev-pkg=true" {dev} ]] - -synopsis: """File system paths for OCaml""" -description: """\ - -Fpath is an OCaml module for handling file system paths with POSIX or -Windows conventions. Fpath processes paths without accessing the file -system and is independent from any system library. - -Fpath depends on [Astring][astring] and is distributed under the ISC -license. - -[astring]: http://erratique.ch/software/astring -""" -url { -archive: "https://erratique.ch/software/fpath/releases/fpath-0.7.3.tbz" -checksum: "0740b530e8fed5b0adc5eee8463cfc2f" -} diff --git a/jsoo.esy.lock/opam/js_of_ocaml-compiler.3.8.0/opam b/jsoo.esy.lock/opam/js_of_ocaml-compiler.3.8.0/opam deleted file mode 100644 index bf6fb8b28..000000000 --- a/jsoo.esy.lock/opam/js_of_ocaml-compiler.3.8.0/opam +++ /dev/null @@ -1,40 +0,0 @@ -opam-version: "2.0" -maintainer: "dev@ocsigen.org" -authors: "Ocsigen team" -bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" -homepage: "http://ocsigen.github.io/js_of_ocaml" -dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -synopsis: "Compiler from OCaml bytecode to Javascript" -description: """ -Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. -It makes it possible to run pure OCaml programs in JavaScript -environment like browsers and Node.js -""" - -build: [["dune" "build" "-p" name "-j" jobs]] - -depends: [ - "ocaml" {>= "4.02.0" & < "4.12.0"} - "dune" {>= "2.5"} - "ppx_expect" {with-test & >= "v0.12.0"} - "cmdliner" - "menhir" - "ppxlib" {>= "0.15.0"} - "yojson" # It's optional, but we want users to be able to use source-map without pain. -] - -depopts: [ "ocamlfind" ] - -conflicts: [ - "ocamlfind" {< "1.5.1"} - "js_of_ocaml" {< "3.0"} -] -x-commit-hash: "09d5731241917577e9c16b6a0063c23baae00df8" -url { - src: - "https://github.com/ocsigen/js_of_ocaml/releases/download/3.8.0/js_of_ocaml-3.8.0.tbz" - checksum: [ - "sha256=9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219" - "sha512=e4855e242e4b0c6b396154e3d093fb5de28e4073efb1df00ee91ad52fad8530425498f4ff46631f128a9c792225f53c2046eeaea81517281cee1e3442a347578" - ] -} diff --git a/jsoo.esy.lock/opam/js_of_ocaml.3.8.0/opam b/jsoo.esy.lock/opam/js_of_ocaml.3.8.0/opam deleted file mode 100644 index e11ebd030..000000000 --- a/jsoo.esy.lock/opam/js_of_ocaml.3.8.0/opam +++ /dev/null @@ -1,31 +0,0 @@ -opam-version: "2.0" -maintainer: "dev@ocsigen.org" -authors: "Ocsigen team" -bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" -homepage: "http://ocsigen.github.io/js_of_ocaml" -dev-repo: "git+https://github.com/ocsigen/js_of_ocaml.git" -synopsis: "Compiler from OCaml bytecode to Javascript" -description: """ -Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. -It makes it possible to run pure OCaml programs in JavaScript -environment like browsers and Node.js -""" - -build: [["dune" "build" "-p" name "-j" jobs]] - -depends: [ - "ocaml" {>= "4.02.0"} - "dune" {>= "2.5"} - "ppxlib" {>= "0.15.0" } - "uchar" - "js_of_ocaml-compiler" {= version} -] -x-commit-hash: "09d5731241917577e9c16b6a0063c23baae00df8" -url { - src: - "https://github.com/ocsigen/js_of_ocaml/releases/download/3.8.0/js_of_ocaml-3.8.0.tbz" - checksum: [ - "sha256=9ed1424afd3eeafa5c5a031d817326edd751da58bda9a16fb4fcb1ee55f43219" - "sha512=e4855e242e4b0c6b396154e3d093fb5de28e4073efb1df00ee91ad52fad8530425498f4ff46631f128a9c792225f53c2046eeaea81517281cee1e3442a347578" - ] -} diff --git a/jsoo.esy.lock/opam/lambda-term.3.1.0/opam b/jsoo.esy.lock/opam/lambda-term.3.1.0/opam deleted file mode 100644 index 6a491eb77..000000000 --- a/jsoo.esy.lock/opam/lambda-term.3.1.0/opam +++ /dev/null @@ -1,35 +0,0 @@ -opam-version: "2.0" -maintainer: "jeremie@dimino.org" -authors: ["Jérémie Dimino"] -homepage: "https://github.com/ocaml-community/lambda-term" -bug-reports: "https://github.com/ocaml-community/lambda-term/issues" -dev-repo: "git://github.com/ocaml-community/lambda-term.git" -license: "BSD-3-Clause" -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -depends: [ - "ocaml" {>= "4.02.3"} - "lwt" {>= "4.0.0"} - "lwt_log" - "react" - "zed" {>= "3.1.0" & < "4.0"} - "camomile" {>= "1.0.1"} - "lwt_react" - "mew_vi" {>= "0.5.0" & < "0.6.0"} - "dune" {>= "1.1.0"} -] -synopsis: "Terminal manipulation library for OCaml" -description: """ -Lambda-term is a cross-platform library for manipulating the terminal. It -provides an abstraction for keys, mouse events, colors, as well as a set of -widgets to write curses-like applications. The main objective of lambda-term is -to provide a higher level functional interface to terminal manipulation than, -for example, ncurses, by providing a native OCaml interface instead of bindings -to a C library. Lambda-term integrates with zed to provide text edition -facilities in console applications.""" -url { - src: "https://github.com/ocaml-community/lambda-term/archive/3.1.0.tar.gz" - checksum: "md5=78180c04ecfc8060b23d7d0014f24196" -} diff --git a/jsoo.esy.lock/opam/lwt.5.3.0/opam b/jsoo.esy.lock/opam/lwt.5.3.0/opam deleted file mode 100644 index 7cc4dc92c..000000000 --- a/jsoo.esy.lock/opam/lwt.5.3.0/opam +++ /dev/null @@ -1,63 +0,0 @@ -opam-version: "2.0" - -synopsis: "Promises and event-driven I/O" - -version: "5.3.0" -license: "MIT" -homepage: "https://github.com/ocsigen/lwt" -doc: "https://ocsigen.org/lwt" -bug-reports: "https://github.com/ocsigen/lwt/issues" - -authors: [ - "Jérôme Vouillon" - "Jérémie Dimino" -] -maintainer: [ - "Anton Bachin " -] -dev-repo: "git+https://github.com/ocsigen/lwt.git" - -depends: [ - "cppo" {build & >= "1.1.0"} - "dune" {>= "1.8.0"} - "dune-configurator" - "mmap" {>= "1.1.0"} # mmap is needed as long as Lwt supports OCaml < 4.06.0. - "ocaml" {>= "4.02.0" & < "4.12"} - ("ocaml" {>= "4.08.0"} | "ocaml-syntax-shims") - "ocplib-endian" - "result" # result is needed as long as Lwt supports OCaml 4.02. - "seq" # seq is needed as long as Lwt supports OCaml < 4.07.0. - - "bisect_ppx" {dev & >= "2.0.0"} - "ocamlfind" {dev & >= "1.7.3-1"} -] - -depopts: [ - "base-threads" - "base-unix" - "conf-libev" -] - -conflicts: [ - "ocaml-variants" {= "4.02.1+BER"} -] - -build: [ - ["dune" "exec" "-p" name "src/unix/config/discover.exe" "--" "--save" - "--use-libev" "%{conf-libev:installed}%"] - ["dune" "build" "-p" name "-j" jobs] -] - -description: "A promise is a value that may become determined in the future. - -Lwt provides typed, composable promises. Promises that are resolved by I/O are -resolved by Lwt in parallel. - -Meanwhile, OCaml code, including code creating and waiting on promises, runs in -a single thread by default. This reduces the need for locks or other -synchronization primitives. Code can be run in parallel on an opt-in basis." - -url { - src: "https://github.com/ocsigen/lwt/archive/5.3.0.tar.gz" - checksum: "md5=85e9c7e9095b4e14d0698e3ece72f378" -} diff --git a/jsoo.esy.lock/opam/lwt_log.1.1.1/opam b/jsoo.esy.lock/opam/lwt_log.1.1.1/opam deleted file mode 100644 index 56cdfd7b0..000000000 --- a/jsoo.esy.lock/opam/lwt_log.1.1.1/opam +++ /dev/null @@ -1,30 +0,0 @@ -opam-version: "2.0" - -synopsis: "Lwt logging library (deprecated)" - -version: "1.1.1" -license: "LGPL-2.0-or-later" -homepage: "https://github.com/ocsigen/lwt_log" -doc: "https://github.com/ocsigen/lwt_log/blob/master/src/core/lwt_log_core.mli" -bug-reports: "https://github.com/ocsigen/lwt_log/issues" - -authors: [ - "Shawn Wagner" - "Jérémie Dimino" -] -maintainer: "Anton Bachin " -dev-repo: "git+https://github.com/ocsigen/lwt_log.git" - -depends: [ - "dune" {>= "1.0"} - "lwt" {>= "4.0.0"} -] - -build: [ - ["dune" "build" "-p" name "-j" jobs] -] - -url { - src: "https://github.com/aantron/lwt_log/archive/1.1.1.tar.gz" - checksum: "md5=02e93be62288037870ae5b1ce099fe59" -} diff --git a/jsoo.esy.lock/opam/lwt_react.1.1.3/opam b/jsoo.esy.lock/opam/lwt_react.1.1.3/opam deleted file mode 100644 index a2636879e..000000000 --- a/jsoo.esy.lock/opam/lwt_react.1.1.3/opam +++ /dev/null @@ -1,33 +0,0 @@ -opam-version: "2.0" - -synopsis: "Helpers for using React with Lwt" - -version: "1.1.3" -license: "MIT" -homepage: "https://github.com/ocsigen/lwt" -doc: "https://ocsigen.org/lwt/api/Lwt_react" -bug-reports: "https://github.com/ocsigen/lwt/issues" - -authors: [ - "Jérémie Dimino" -] -maintainer: [ - "Anton Bachin " -] -dev-repo: "git+https://github.com/ocsigen/lwt.git" - -depends: [ - "dune" - "lwt" {>= "3.0.0"} - "ocaml" - "react" {>= "1.0.0"} -] - -build: [ - ["dune" "build" "-p" name "-j" jobs] -] - -url { - src: "https://github.com/ocsigen/lwt/archive/4.3.0.tar.gz" - checksum: "md5=1a72b5ae4245707c12656632a25fc18c" -} diff --git a/jsoo.esy.lock/opam/menhir.20201122/opam b/jsoo.esy.lock/opam/menhir.20201122/opam deleted file mode 100644 index 48faa4152..000000000 --- a/jsoo.esy.lock/opam/menhir.20201122/opam +++ /dev/null @@ -1,27 +0,0 @@ -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/20201122/archive.tar.gz" - checksum: [ - "md5=9ad6a5f88aab6ec677b970e0d9de1763" - "sha512=9174e74cfb2336c5008c7461411ba79190e673d310da99117e363f60782bcf9a4bb26a04f6448cf6f3ed7888aa2b5b04d38c32e6d86594accfaadbbb72528068" - ] -} diff --git a/jsoo.esy.lock/opam/menhirLib.20201122/opam b/jsoo.esy.lock/opam/menhirLib.20201122/opam deleted file mode 100644 index e1cb73cc2..000000000 --- a/jsoo.esy.lock/opam/menhirLib.20201122/opam +++ /dev/null @@ -1,28 +0,0 @@ -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/20201122/archive.tar.gz" - checksum: [ - "md5=9ad6a5f88aab6ec677b970e0d9de1763" - "sha512=9174e74cfb2336c5008c7461411ba79190e673d310da99117e363f60782bcf9a4bb26a04f6448cf6f3ed7888aa2b5b04d38c32e6d86594accfaadbbb72528068" - ] -} diff --git a/jsoo.esy.lock/opam/menhirSdk.20201122/opam b/jsoo.esy.lock/opam/menhirSdk.20201122/opam deleted file mode 100644 index 977c9fbd3..000000000 --- a/jsoo.esy.lock/opam/menhirSdk.20201122/opam +++ /dev/null @@ -1,28 +0,0 @@ -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/20201122/archive.tar.gz" - checksum: [ - "md5=9ad6a5f88aab6ec677b970e0d9de1763" - "sha512=9174e74cfb2336c5008c7461411ba79190e673d310da99117e363f60782bcf9a4bb26a04f6448cf6f3ed7888aa2b5b04d38c32e6d86594accfaadbbb72528068" - ] -} diff --git a/jsoo.esy.lock/opam/merlin-extend.0.6/opam b/jsoo.esy.lock/opam/merlin-extend.0.6/opam deleted file mode 100644 index 39b337577..000000000 --- a/jsoo.esy.lock/opam/merlin-extend.0.6/opam +++ /dev/null @@ -1,30 +0,0 @@ -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/jsoo.esy.lock/opam/merlin.3.4.2/opam b/jsoo.esy.lock/opam/merlin.3.4.2/opam deleted file mode 100644 index 3e2291669..000000000 --- a/jsoo.esy.lock/opam/merlin.3.4.2/opam +++ /dev/null @@ -1,74 +0,0 @@ -opam-version: "2.0" -maintainer: "defree@gmail.com" -authors: "The Merlin team" -homepage: "https://github.com/ocaml/merlin" -bug-reports: "https://github.com/ocaml/merlin/issues" -dev-repo: "git+https://github.com/ocaml/merlin.git" -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" "1"] {with-test & ocaml:version >= "4.03"} -] -depends: [ - "ocaml" {>= "4.02.3" & < "4.12"} - "dune" {>= "1.8.0"} - "dot-merlin-reader" {= version} - "yojson" {>= "1.6.0"} - "mdx" {with-test & >= "1.3.0"} - "conf-jq" {with-test} - "csexp" {>= "1.2.3"} - "result" {>= "1.5"} -] -synopsis: - "Editor helper, provides completion, typing and source browsing in Vim and Emacs" -description: - "Merlin is an assistant for editing OCaml code. It aims to provide the features available in modern IDEs: error reporting, auto completion, source browsing and much more." -post-messages: [ - "merlin installed. - -Quick setup for VIM -------------------- -Append this to your .vimrc to add merlin to vim's runtime-path: - let g:opamshare = substitute(system('opam config var share'),'\\n$','','''') - execute \"set rtp+=\" . g:opamshare . \"/merlin/vim\" - -Also run the following line in vim to index the documentation: - :execute \"helptags \" . g:opamshare . \"/merlin/vim/doc\" - -Quick setup for EMACS -------------------- -Add opam emacs directory to your load-path by appending this to your .emacs: - (let ((opam-share (ignore-errors (car (process-lines \"opam\" \"config\" \"var\" \"share\"))))) - (when (and opam-share (file-directory-p opam-share)) - ;; Register Merlin - (add-to-list 'load-path (expand-file-name \"emacs/site-lisp\" opam-share)) - (autoload 'merlin-mode \"merlin\" nil t nil) - ;; Automatically start it in OCaml buffers - (add-hook 'tuareg-mode-hook 'merlin-mode t) - (add-hook 'caml-mode-hook 'merlin-mode t) - ;; Use opam switch to lookup ocamlmerlin binary - (setq merlin-command 'opam))) - -Take a look at https://github.com/ocaml/merlin for more information - -Quick setup with opam-user-setup --------------------------------- - -Opam-user-setup support Merlin. - - $ opam user-setup install - -should take care of basic setup. -See https://github.com/OCamlPro/opam-user-setup -" - {success & !user-setup:installed} -] -x-commit-hash: "c9761a552380838e9f530b5c47c0ea3c47c33565" -url { - src: - "https://github.com/ocaml/merlin/releases/download/v3.4.2/merlin-v3.4.2.tbz" - checksum: [ - "sha256=e1b7b897b11119d92995c558530149fd07bd67a4aaf140f55f3c4ffb5e882a81" - "sha512=7c39c70fc923971c4eca9432061077941498574c0b804efc20af244c1c9ab34c9178d7eb50ab750feaac30696e7ff911a0ccd5fb86341b68485bedae472aa15f" - ] -} diff --git a/jsoo.esy.lock/opam/mew.0.1.0/opam b/jsoo.esy.lock/opam/mew.0.1.0/opam deleted file mode 100644 index 3563a5e22..000000000 --- a/jsoo.esy.lock/opam/mew.0.1.0/opam +++ /dev/null @@ -1,25 +0,0 @@ -opam-version: "2.0" -maintainer: "zandoye@gmail.com" -authors: [ "ZAN DoYe" ] -homepage: "https://github.com/kandu/mew" -bug-reports: "https://github.com/kandu/mew/issues" -license: "MIT" -dev-repo: "git+https://github.com/kandu/mew.git" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.02.3"} - "result" - "trie" - "dune" {>= "1.1.0"} -] - -synopsis: "Modal editing witch" -description: """ -This is the core module of mew, a general modal editing engine generator.""" - -url { - src: "https://github.com/kandu/mew/archive/0.1.0.tar.gz" - checksum: "md5=2298149d1415cd804ab4e01f01ea10a0" -} diff --git a/jsoo.esy.lock/opam/mew_vi.0.5.0/opam b/jsoo.esy.lock/opam/mew_vi.0.5.0/opam deleted file mode 100644 index 033b9fd71..000000000 --- a/jsoo.esy.lock/opam/mew_vi.0.5.0/opam +++ /dev/null @@ -1,25 +0,0 @@ -opam-version: "2.0" -maintainer: "zandoye@gmail.com" -authors: [ "ZAN DoYe" ] -homepage: "https://github.com/kandu/mew_vi" -bug-reports: "https://github.com/kandu/mew_vi/issues" -license: "MIT" -dev-repo: "git+https://github.com/kandu/mew_vi.git" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.02.3"} - "mew" {>= "0.1.0" & < "0.2"} - "react" - "dune" {>= "1.1.0"} -] - -synopsis: "Modal editing witch, VI interpreter" -description: """ -A vi-like modal editing engine generator.""" - -url { - src: "https://github.com/kandu/mew_vi/archive/0.5.0.tar.gz" - checksum: "md5=341e9a9a20383641015bf503952906bc" -} diff --git a/jsoo.esy.lock/opam/mmap.1.1.0/opam b/jsoo.esy.lock/opam/mmap.1.1.0/opam deleted file mode 100644 index 52d8ff0ca..000000000 --- a/jsoo.esy.lock/opam/mmap.1.1.0/opam +++ /dev/null @@ -1,24 +0,0 @@ -opam-version: "2.0" -maintainer: "jeremie@dimino.org" -authors: ["Jérémie Dimino " "Anton Bachin" ] -homepage: "https://github.com/mirage/mmap" -bug-reports: "https://github.com/mirage/mmap/issues" -doc: "https://mirage.github.io/mmap/" -dev-repo: "git+https://github.com/mirage/mmap.git" -license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" - "dune" {>= "1.6"} -] -synopsis: "File mapping functionality" -description: """ -This project provides a Mmap.map_file functions for mapping files in memory. -""" -url { - src: - "https://github.com/mirage/mmap/releases/download/v1.1.0/mmap-v1.1.0.tbz" - checksum: "md5=8c5d5fbc537296dc525867535fb878ba" -} diff --git a/jsoo.esy.lock/opam/ocaml-compiler-libs.v0.12.3/opam b/jsoo.esy.lock/opam/ocaml-compiler-libs.v0.12.3/opam deleted file mode 100644 index b96702f5d..000000000 --- a/jsoo.esy.lock/opam/ocaml-compiler-libs.v0.12.3/opam +++ /dev/null @@ -1,29 +0,0 @@ -opam-version: "2.0" -maintainer: "opensource@janestreet.com" -authors: ["Jane Street Group, LLC "] -homepage: "https://github.com/janestreet/ocaml-compiler-libs" -bug-reports: "https://github.com/janestreet/ocaml-compiler-libs/issues" -dev-repo: "git+https://github.com/janestreet/ocaml-compiler-libs.git" -license: "MIT" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.04.1"} - "dune" {>= "1.5.1"} -] -synopsis: """OCaml compiler libraries repackaged""" -description: """ - -This packages exposes the OCaml compiler libraries repackages under -the toplevel names Ocaml_common, Ocaml_bytecomp, Ocaml_optcomp, ... -""" -x-commit-hash: "7f5d1d2931b96fb3ee6dd569a469b51f621a6dd4" -url { - src: - "https://github.com/janestreet/ocaml-compiler-libs/releases/download/v0.12.3/ocaml-compiler-libs-v0.12.3.tbz" - checksum: [ - "sha256=a8403531439c14bbda2d504ef93610fd29a8e9520fc700f21889d893a513e3c9" - "sha512=0bb03b38e93bab3274a8ade38d017808110bc02f2181a594d8775c68fdd465733393f0451dbbf8860e6b50b56c45671d2182637c0840d1d6574803ec18673972" - ] -} diff --git a/jsoo.esy.lock/opam/ocaml-migrate-parsetree.2.1.0/opam b/jsoo.esy.lock/opam/ocaml-migrate-parsetree.2.1.0/opam deleted file mode 100644 index 298f17281..000000000 --- a/jsoo.esy.lock/opam/ocaml-migrate-parsetree.2.1.0/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "frederic.bour@lakaban.net" -authors: [ - "Frédéric Bour " - "Jérémie Dimino " -] -license: "LGPL-2.1 with OCaml linking exception" -homepage: "https://github.com/ocaml-ppx/ocaml-migrate-parsetree" -bug-reports: "https://github.com/ocaml-ppx/ocaml-migrate-parsetree/issues" -dev-repo: "git+https://github.com/ocaml-ppx/ocaml-migrate-parsetree.git" -doc: "https://ocaml-ppx.github.io/ocaml-migrate-parsetree/" -tags: [ "syntax" "org:ocamllabs" ] -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "dune" {>= "1.11"} - "ocaml" {>= "4.02.3" & < "4.13"} -] -synopsis: "Convert OCaml parsetrees between different versions" -description: """ -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. -""" -x-commit-hash: "4a05cf7a00d84e5f827cc9ae9c75e5dc85126085" -url { - src: - "https://github.com/ocaml-ppx/ocaml-migrate-parsetree/releases/download/v2.1.0/ocaml-migrate-parsetree-v2.1.0.tbz" - checksum: [ - "sha256=387b788ee4c0537f1fe02c25e05f0335af424828fc6fe940acc0db5948a5a71f" - "sha512=6ac80face6b77531c8d89a77d7a246bd5d43da435c355f62c03c8b8e360e1d7e339c904709fd3dbc9aa340c86ada9a69d5ebcf97cbdb7bd51bec97f831741b99" - ] -} diff --git a/jsoo.esy.lock/opam/ocamlbuild.0.14.0/opam b/jsoo.esy.lock/opam/ocamlbuild.0.14.0/opam deleted file mode 100644 index 8deabeedf..000000000 --- a/jsoo.esy.lock/opam/ocamlbuild.0.14.0/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "Gabriel Scherer " -authors: ["Nicolas Pouillard" "Berke Durak"] -homepage: "https://github.com/ocaml/ocamlbuild/" -bug-reports: "https://github.com/ocaml/ocamlbuild/issues" -license: "LGPL-2.1-only with OCaml-LGPL-linking-exception" -doc: "https://github.com/ocaml/ocamlbuild/blob/master/manual/manual.adoc" -dev-repo: "git+https://github.com/ocaml/ocamlbuild.git" -build: [ - [ - make - "-f" - "configure.make" - "all" - "OCAMLBUILD_PREFIX=%{prefix}%" - "OCAMLBUILD_BINDIR=%{bin}%" - "OCAMLBUILD_LIBDIR=%{lib}%" - "OCAMLBUILD_MANDIR=%{man}%" - "OCAML_NATIVE=%{ocaml:native}%" - "OCAML_NATIVE_TOOLS=%{ocaml:native}%" - ] - [make "check-if-preinstalled" "all" "opam-install"] -] -conflicts: [ - "base-ocamlbuild" - "ocamlfind" {< "1.6.2"} -] -synopsis: - "OCamlbuild is a build system with builtin rules to easily build most OCaml projects." -depends: [ - "ocaml" {>= "4.03"} -] -url { - src: "https://github.com/ocaml/ocamlbuild/archive/0.14.0.tar.gz" - checksum: "sha256=87b29ce96958096c0a1a8eeafeb6268077b2d11e1bf2b3de0f5ebc9cf8d42e78" -} diff --git a/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub b/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub deleted file mode 100644 index e5ad9907e..000000000 --- a/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocaml-stub +++ /dev/null @@ -1,4 +0,0 @@ -#!/bin/sh - -BINDIR=$(dirname "$(command -v ocamlc)") -"$BINDIR/ocaml" -I "$OCAML_TOPLEVEL_PATH" "$@" diff --git a/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install b/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install deleted file mode 100644 index 295c62545..000000000 --- a/jsoo.esy.lock/opam/ocamlfind.1.8.1/files/ocamlfind.install +++ /dev/null @@ -1,6 +0,0 @@ -bin: [ - "src/findlib/ocamlfind" {"ocamlfind"} - "?src/findlib/ocamlfind_opt" {"ocamlfind"} - "?tools/safe_camlp4" -] -toplevel: ["src/findlib/topfind"] diff --git a/jsoo.esy.lock/opam/ocamlfind.1.8.1/opam b/jsoo.esy.lock/opam/ocamlfind.1.8.1/opam deleted file mode 100644 index d757d669c..000000000 --- a/jsoo.esy.lock/opam/ocamlfind.1.8.1/opam +++ /dev/null @@ -1,50 +0,0 @@ -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/jsoo.esy.lock/opam/ocplib-endian.1.1/opam b/jsoo.esy.lock/opam/ocplib-endian.1.1/opam deleted file mode 100644 index c3c2ac6e4..000000000 --- a/jsoo.esy.lock/opam/ocplib-endian.1.1/opam +++ /dev/null @@ -1,38 +0,0 @@ -opam-version: "2.0" -synopsis: - "Optimised functions to read and write int16/32/64 from strings and bigarrays" -description: """ -The library implements three modules: -* [EndianString](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianString.mli) works directly on strings, and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts; -* [EndianBytes](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianBytes.mli) works directly on bytes, and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts; -* [EndianBigstring](https://github.com/OCamlPro/ocplib-endian/blob/master/src/endianBigstring.mli) works on bigstrings (Bigarrays of chars), and provides submodules BigEndian and LittleEndian, with their unsafe counter-parts.""" -maintainer: "pierre.chambart@ocamlpro.com" -authors: "Pierre Chambart" -homepage: "https://github.com/OCamlPro/ocplib-endian" -doc: "https://ocamlpro.github.io/ocplib-endian/ocplib-endian/" -bug-reports: "https://github.com/OCamlPro/ocplib-endian/issues" -depends: [ - "base-bytes" - "ocaml" {>= "4.02.3"} - "cppo" {>= "1.1.0" & build} - "dune" {>= "1.0"} -] -build: [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - "@runtest" {with-test} - "@doc" {with-doc} -] -dev-repo: "git+https://github.com/OCamlPro/ocplib-endian.git" -url { - src: "https://github.com/OCamlPro/ocplib-endian/archive/1.1.tar.gz" - checksum: [ - "md5=dedf4d69c1b87b3c6c7234f632399285" - "sha512=39351c666d1394770696fa89ac62f7c137ad1697d99888bfba2cc8de2c61df05dd8b3aa327c117bf38f3e29e081026d2c575c5ad0022bde92b3d43aba577d3f9" - ] -} \ No newline at end of file diff --git a/jsoo.esy.lock/opam/odoc.1.5.2/opam b/jsoo.esy.lock/opam/odoc.1.5.2/opam deleted file mode 100644 index f59e64077..000000000 --- a/jsoo.esy.lock/opam/odoc.1.5.2/opam +++ /dev/null @@ -1,53 +0,0 @@ -opam-version: "2.0" - -homepage: "http://github.com/ocaml/odoc" -doc: "https://ocaml.github.io/odoc/" -bug-reports: "https://github.com/ocaml/odoc/issues" -license: "ISC" - -authors: [ - "Thomas Refis " - "David Sheets " - "Leo White " - "Anton Bachin " - "Jon Ludlam " -] -maintainer: "Anton Bachin " -dev-repo: "git+https://github.com/ocaml/odoc.git" - -synopsis: "OCaml documentation generator" -description: """ -Odoc is a documentation generator for OCaml. It reads doc comments, -delimited with `(** ... *)`, and outputs HTML. -""" - -depends: [ - "astring" - "cmdliner" - "cppo" {build} - "dune" - "fpath" - "ocaml" {>= "4.02.0"} - "result" - "tyxml" {>= "4.3.0"} - - "alcotest" {dev & >= "0.8.3"} - "markup" {dev & >= "1.0.0"} - "ocamlfind" {dev} - "sexplib" {dev & >= "113.33.00"} - - "bisect_ppx" {with-test & >= "1.3.0"} -] - -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] -] -x-commit-hash: "c0df8ce2171fa9645a41f371429aa3ddc16de5c1" -url { - src: "https://github.com/ocaml/odoc/releases/download/1.5.2/odoc-1.5.2.tbz" - checksum: [ - "sha256=d24463f2660bc28c72cda001478360158e953721c9e23fb361ec4783113c4871" - "sha512=e6c83630325de422f31cda8f88c038d213969f8b98e989593c057658f3956c0855860c9bc38f61b6479929516ca95aee689ddfba3ad8c47d821c4fdf54524cf9" - ] -} diff --git a/jsoo.esy.lock/opam/ppx_derivers.1.2.1/opam b/jsoo.esy.lock/opam/ppx_derivers.1.2.1/opam deleted file mode 100644 index 3d10814e0..000000000 --- a/jsoo.esy.lock/opam/ppx_derivers.1.2.1/opam +++ /dev/null @@ -1,23 +0,0 @@ -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/jsoo.esy.lock/opam/ppxlib.0.20.0/opam b/jsoo.esy.lock/opam/ppxlib.0.20.0/opam deleted file mode 100644 index 7c541f079..000000000 --- a/jsoo.esy.lock/opam/ppxlib.0.20.0/opam +++ /dev/null @@ -1,50 +0,0 @@ -opam-version: "2.0" -maintainer: "opensource@janestreet.com" -authors: ["Jane Street Group, LLC "] -homepage: "https://github.com/ocaml-ppx/ppxlib" -bug-reports: "https://github.com/ocaml-ppx/ppxlib/issues" -dev-repo: "git+https://github.com/ocaml-ppx/ppxlib.git" -doc: "https://ocaml-ppx.github.io/ppxlib/" -license: "MIT" -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] -] -run-test: [ - ["dune" "runtest" "-p" name "-j" jobs] { ocaml:version >= "4.10" } -] -depends: [ - "ocaml" {>= "4.04.1" & < "4.13"} - "dune" {>= "1.11"} - "ocaml-compiler-libs" {>= "v0.11.0"} - "ocaml-migrate-parsetree" {>= "2.1.0"} - "ppx_derivers" {>= "1.0"} - "sexplib0" - "stdlib-shims" - "ocamlfind" {with-test} - "cinaps" {with-test & >= "v0.12.1"} - "base" {with-test} - "stdio" {with-test} -] -synopsis: "Standard library for ppx rewriters" -description: """ -Ppxlib is the standard library for ppx rewriters and other programs -that manipulate the in-memory reprensation of OCaml programs, a.k.a -the "Parsetree". - -It also comes bundled with two ppx rewriters that are commonly used to -write tools that manipulate and/or generate Parsetree values; -`ppxlib.metaquot` which allows to construct Parsetree values using the -OCaml syntax directly and `ppxlib.traverse` which provides various -ways of automatically traversing values of a given type, in particular -allowing to inject a complex structured value into generated code. -""" -x-commit-hash: "51b6f0bd59692712ef2af73a4f378dccc7fabac8" -url { - src: - "https://github.com/ocaml-ppx/ppxlib/releases/download/0.20.0/ppxlib-0.20.0.tbz" - checksum: [ - "sha256=1cb5903ef257de9c93e154cbb53df5979d4ad0f041d01967ea5984dd6d2cad37" - "sha512=fa4179e821a88b70cf874488f2f8fcc7d0d52a2df50069dd8822d57c61a88c92c40e782267dbca0a8efc2f35976eaed73f85fcbec4299585dcf7b748ccd1c19f" - ] -} diff --git a/jsoo.esy.lock/opam/re.1.9.0/opam b/jsoo.esy.lock/opam/re.1.9.0/opam deleted file mode 100644 index f7987544d..000000000 --- a/jsoo.esy.lock/opam/re.1.9.0/opam +++ /dev/null @@ -1,42 +0,0 @@ -opam-version: "2.0" - -maintainer: "rudi.grinberg@gmail.com" -authors: [ - "Jerome Vouillon" - "Thomas Gazagnaire" - "Anil Madhavapeddy" - "Rudi Grinberg" - "Gabriel Radanne" -] -license: "LGPL-2.0-only with OCaml-LGPL-linking-exception" -homepage: "https://github.com/ocaml/ocaml-re" -bug-reports: "https://github.com/ocaml/ocaml-re/issues" -dev-repo: "git+https://github.com/ocaml/ocaml-re.git" - -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] - -depends: [ - "ocaml" {>= "4.02"} - "dune" - "ounit" {with-test} - "seq" -] - -synopsis: "RE is a regular expression library for OCaml" -description: """ -Pure OCaml regular expressions with: -* Perl-style regular expressions (module Re.Perl) -* Posix extended regular expressions (module Re.Posix) -* Emacs-style regular expressions (module Re.Emacs) -* Shell-style file globbing (module Re.Glob) -* Compatibility layer for OCaml's built-in Str module (module Re.Str) -""" -url { - src: - "https://github.com/ocaml/ocaml-re/releases/download/1.9.0/re-1.9.0.tbz" - checksum: "md5=bddaed4f386a22cace7850c9c7dac296" -} diff --git a/jsoo.esy.lock/opam/react.1.2.1/opam b/jsoo.esy.lock/opam/react.1.2.1/opam deleted file mode 100644 index a7cd9dd36..000000000 --- a/jsoo.esy.lock/opam/react.1.2.1/opam +++ /dev/null @@ -1,33 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -homepage: "http://erratique.ch/software/react" -authors: ["Daniel Bünzli "] -doc: "http://erratique.ch/software/react/doc/React" -dev-repo: "git+http://erratique.ch/repos/react.git" -bug-reports: "https://github.com/dbuenzli/react/issues" -tags: [ "reactive" "declarative" "signal" "event" "frp" "org:erratique" ] -license: "ISC" -depends: [ - "ocaml" {>= "4.01.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build & >= "0.9.0"} -] -build: -[[ "ocaml" "pkg/pkg.ml" "build" - "--dev-pkg" "%{pinned}%" ]] -synopsis: "Declarative events and signals for OCaml" -description: """ -Release %%VERSION%% - -React is an OCaml module for functional reactive programming (FRP). It -provides support to program with time varying values : declarative -events and signals. React doesn't define any primitive event or -signal, it lets the client chooses the concrete timeline. - -React is made of a single, independent, module and distributed under -the ISC license.""" -url { - src: "http://erratique.ch/software/react/releases/react-1.2.1.tbz" - checksum: "md5=ce1454438ce4e9d2931248d3abba1fcc" -} diff --git a/jsoo.esy.lock/opam/result.1.5/opam b/jsoo.esy.lock/opam/result.1.5/opam deleted file mode 100644 index 671af042a..000000000 --- a/jsoo.esy.lock/opam/result.1.5/opam +++ /dev/null @@ -1,22 +0,0 @@ -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/jsoo.esy.lock/opam/seq.base/files/META.seq b/jsoo.esy.lock/opam/seq.base/files/META.seq deleted file mode 100644 index 06b95eff3..000000000 --- a/jsoo.esy.lock/opam/seq.base/files/META.seq +++ /dev/null @@ -1,4 +0,0 @@ -name="seq" -version="[distributed with OCaml 4.07 or above]" -description="dummy backward-compatibility package for iterators" -requires="" diff --git a/jsoo.esy.lock/opam/seq.base/files/seq.install b/jsoo.esy.lock/opam/seq.base/files/seq.install deleted file mode 100644 index c4d70206e..000000000 --- a/jsoo.esy.lock/opam/seq.base/files/seq.install +++ /dev/null @@ -1,3 +0,0 @@ -lib:[ - "META.seq" {"META"} -] diff --git a/jsoo.esy.lock/opam/seq.base/opam b/jsoo.esy.lock/opam/seq.base/opam deleted file mode 100644 index b33d8c7da..000000000 --- a/jsoo.esy.lock/opam/seq.base/opam +++ /dev/null @@ -1,15 +0,0 @@ -opam-version: "2.0" -maintainer: " " -authors: " " -homepage: " " -depends: [ - "ocaml" {>= "4.07.0"} -] -dev-repo: "git+https://github.com/ocaml/ocaml.git" -bug-reports: "https://caml.inria.fr/mantis/main_page.php" -synopsis: - "Compatibility package for OCaml's standard iterator type starting from 4.07." -extra-files: [ - ["seq.install" "md5=026b31e1df290373198373d5aaa26e42"] - ["META.seq" "md5=b33c8a1a6c7ed797816ce27df4855107"] -] diff --git a/jsoo.esy.lock/opam/sexplib0.v0.14.0/opam b/jsoo.esy.lock/opam/sexplib0.v0.14.0/opam deleted file mode 100644 index f7afcef36..000000000 --- a/jsoo.esy.lock/opam/sexplib0.v0.14.0/opam +++ /dev/null @@ -1,26 +0,0 @@ -opam-version: "2.0" -maintainer: "opensource@janestreet.com" -authors: ["Jane Street Group, LLC "] -homepage: "https://github.com/janestreet/sexplib0" -bug-reports: "https://github.com/janestreet/sexplib0/issues" -dev-repo: "git+https://github.com/janestreet/sexplib0.git" -doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/sexplib0/index.html" -license: "MIT" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.04.2"} - "dune" {>= "2.0.0"} -] -synopsis: "Library containing the definition of S-expressions and some base converters" -description: " -Part of Jane Street's Core library -The Core suite of libraries is an industrial strength alternative to -OCaml's standard library that was developed by Jane Street, the -largest industrial user of OCaml. -" -url { - src: "https://ocaml.janestreet.com/ocaml-core/v0.14/files/sexplib0-v0.14.0.tar.gz" - checksum: "md5=37aff0af8f8f6f759249475684aebdc4" -} diff --git a/jsoo.esy.lock/opam/stdlib-shims.0.1.0/opam b/jsoo.esy.lock/opam/stdlib-shims.0.1.0/opam deleted file mode 100644 index c6f3529a3..000000000 --- a/jsoo.esy.lock/opam/stdlib-shims.0.1.0/opam +++ /dev/null @@ -1,28 +0,0 @@ -opam-version: "2.0" -maintainer: "The stdlib-shims programmers" -authors: "The stdlib-shims programmers" -homepage: "https://github.com/ocaml/stdlib-shims" -doc: "https://ocaml.github.io/stdlib-shims/" -dev-repo: "git+https://github.com/ocaml/stdlib-shims.git" -bug-reports: "https://github.com/ocaml/stdlib-shims/issues" -tags: ["stdlib" "compatibility" "org:ocaml"] -license: ["typeof OCaml system"] -depends: [ - "ocaml" {>= "4.02.3"} - "dune" - ("dune" {>= "2.8.0"} | "ocaml" {< "4.12.0~~"}) -] -build: [ "dune" "build" "-p" name "-j" jobs ] -synopsis: "Backport some of the new stdlib features to older compiler" -description: """ -Backport some of the new stdlib features to older compiler, -such as the Stdlib module. - -This allows projects that require compatibility with older compiler to -use these new features in their code. -""" -url { - src: - "https://github.com/ocaml/stdlib-shims/releases/download/0.1.0/stdlib-shims-0.1.0.tbz" - checksum: "md5=12b5704eed70c6bff5ac39a16db1425d" -} diff --git a/jsoo.esy.lock/opam/topkg.1.0.3/opam b/jsoo.esy.lock/opam/topkg.1.0.3/opam deleted file mode 100644 index 6e073a114..000000000 --- a/jsoo.esy.lock/opam/topkg.1.0.3/opam +++ /dev/null @@ -1,48 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["Daniel Bünzli "] -homepage: "http://erratique.ch/software/topkg" -doc: "http://erratique.ch/software/topkg/doc" -license: "ISC" -dev-repo: "git+http://erratique.ch/repos/topkg.git" -bug-reports: "https://github.com/dbuenzli/topkg/issues" -tags: ["packaging" "ocamlbuild" "org:erratique"] -depends: [ - "ocaml" {>= "4.03.0"} - "ocamlfind" {build & >= "1.6.1"} - "ocamlbuild" ] -build: [[ - "ocaml" "pkg/pkg.ml" "build" - "--pkg-name" name - "--dev-pkg" "%{pinned}%" ]] -synopsis: """The transitory OCaml software packager""" -description: """\ - -Topkg is a packager for distributing OCaml software. It provides an -API to describe the files a package installs in a given build -configuration and to specify information about the package's -distribution, creation and publication procedures. - -The optional topkg-care package provides the `topkg` command line tool -which helps with various aspects of a package's life cycle: creating -and linting a distribution, releasing it on the WWW, publish its -documentation, add it to the OCaml opam repository, etc. - -Topkg is distributed under the ISC license and has **no** -dependencies. This is what your packages will need as a *build* -dependency. - -Topkg-care is distributed under the ISC license it depends on -[fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], -[webbrowser][webbrowser] and `opam-format`. - -[fmt]: http://erratique.ch/software/fmt -[logs]: http://erratique.ch/software/logs -[bos]: http://erratique.ch/software/bos -[cmdliner]: http://erratique.ch/software/cmdliner -[webbrowser]: http://erratique.ch/software/webbrowser -""" -url { -archive: "http://erratique.ch/software/topkg/releases/topkg-1.0.3.tbz" -checksum: "e285f7a296d77ee7d831ba9a6bfb396f" -} diff --git a/jsoo.esy.lock/opam/trie.1.0.0/opam b/jsoo.esy.lock/opam/trie.1.0.0/opam deleted file mode 100644 index 283fc8fb5..000000000 --- a/jsoo.esy.lock/opam/trie.1.0.0/opam +++ /dev/null @@ -1,19 +0,0 @@ -opam-version: "2.0" -maintainer: "zandoye@gmail.com" -authors: [ "ZAN DoYe" ] -homepage: "https://github.com/kandu/trie/" -bug-reports: "https://github.com/kandu/trie/issues" -license: "MIT" -dev-repo: "git://github.com/kandu/trie.git" -build: [ - ["dune" "build" "-p" name "-j" jobs] -] -depends: [ - "ocaml" {>= "4.02"} - "dune" {>= "1.0"} -] -synopsis: "Strict impure trie tree" -url { - src: "https://github.com/kandu/trie/archive/1.0.0.tar.gz" - checksum: "md5=84519b5f8bd92490bfc68a52f706ba14" -} diff --git a/jsoo.esy.lock/opam/tyxml.4.4.0/opam b/jsoo.esy.lock/opam/tyxml.4.4.0/opam deleted file mode 100644 index 51532b536..000000000 --- a/jsoo.esy.lock/opam/tyxml.4.4.0/opam +++ /dev/null @@ -1,47 +0,0 @@ -opam-version: "2.0" -maintainer: "dev@ocsigen.org" -homepage: "https://github.com/ocsigen/tyxml/" -bug-reports: "https://github.com/ocsigen/tyxml/issues" -doc: "https://ocsigen.org/tyxml/manual/" -dev-repo: "git+https://github.com/ocsigen/tyxml.git" -license: "LGPL-2.1 with OCaml linking exception" - -build: [ - ["dune" "subst"] {pinned} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] - -depends: [ - "ocaml" {>= "4.02"} - "dune" - "alcotest" {with-test} - "seq" - "uutf" {>= "1.0.0"} - "re" {>= "1.5.0"} -] - -synopsis:"TyXML is a library for building correct HTML and SVG documents" -description:""" -TyXML provides a set of convenient combinators that uses the OCaml -type system to ensure the validity of the generated documents. TyXML -can be used with any representation of HTML and SVG: the textual one, -provided directly by this package, or DOM trees (`js_of_ocaml-tyxml`) -virtual DOM (`virtual-dom`) and reactive or replicated trees -(`eliom`). You can also create your own representation and use it to -instantiate a new set of combinators. - -```ocaml -open Tyxml -let to_ocaml = Html.(a ~a:[a_href "ocaml.org"] [txt "OCaml!"]) -``` -""" -authors: "The ocsigen team" -url { - src: - "https://github.com/ocsigen/tyxml/releases/download/4.4.0/tyxml-4.4.0.tbz" - checksum: [ - "sha256=516394dd4a5c31726997c51d66aa31cacb91e3c46d4e16c7699130e204042530" - "sha512=d5f2187f8410524cec7a14b28e8950837070eb0b6571b015dd06076c2841eb7ccaffa86d5d2307eaf1950ee62f9fb926477dac01c870d9c1a2f525853cb44d0c" - ] -} diff --git a/jsoo.esy.lock/opam/uchar.0.0.2/opam b/jsoo.esy.lock/opam/uchar.0.0.2/opam deleted file mode 100644 index 428d7aa6f..000000000 --- a/jsoo.esy.lock/opam/uchar.0.0.2/opam +++ /dev/null @@ -1,36 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["Daniel Bünzli "] -homepage: "http://ocaml.org" -doc: "https://ocaml.github.io/uchar/" -dev-repo: "git+https://github.com/ocaml/uchar.git" -bug-reports: "https://github.com/ocaml/uchar/issues" -tags: [ "text" "character" "unicode" "compatibility" "org:ocaml.org" ] -license: "typeof OCaml system" -depends: [ - "ocaml" {>= "3.12.0"} - "ocamlbuild" {build} -] -build: [ - ["ocaml" "pkg/git.ml"] - [ - "ocaml" - "pkg/build.ml" - "native=%{ocaml:native}%" - "native-dynlink=%{ocaml:native-dynlink}%" - ] -] -synopsis: "Compatibility library for OCaml's Uchar module" -description: """ -The `uchar` package provides a compatibility library for the -[`Uchar`][1] module introduced in OCaml 4.03. - -The `uchar` package is distributed under the license of the OCaml -compiler. See [LICENSE](LICENSE) for details. - -[1]: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Uchar.html""" -url { - src: - "https://github.com/ocaml/uchar/releases/download/v0.0.2/uchar-0.0.2.tbz" - checksum: "md5=c9ba2c738d264c420c642f7bb1cf4a36" -} diff --git a/jsoo.esy.lock/opam/utop.2.6.0/opam b/jsoo.esy.lock/opam/utop.2.6.0/opam deleted file mode 100644 index eaf36e040..000000000 --- a/jsoo.esy.lock/opam/utop.2.6.0/opam +++ /dev/null @@ -1,41 +0,0 @@ -opam-version: "2.0" -maintainer: "jeremie@dimino.org" -authors: "Jérémie Dimino" -license: "BSD3" -homepage: "https://github.com/ocaml-community/utop" -bug-reports: "https://github.com/ocaml-community/utop/issues" -doc: "https://ocaml-community.github.io/utop/" -depends: [ - "ocaml" {>= "4.03.0" & < "4.12"} - "base-unix" - "base-threads" - "ocamlfind" {>= "1.7.2"} - "lambda-term" {>= "3.1.0" & < "4.0"} - "lwt" - "lwt_react" - "camomile" - "react" {>= "1.0.0"} - "cppo" {build & >= "1.1.2"} - "dune" {>= "1.0"} -] -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/utop.git" -synopsis: "Universal toplevel for OCaml" -description: """ -utop is an improved toplevel (i.e., Read-Eval-Print Loop or REPL) for -OCaml. It can run in a terminal or in Emacs. It supports line -edition, history, real-time and context sensitive completion, colors, -and more. It integrates with the Tuareg mode in Emacs. -""" -url { - src: - "https://github.com/ocaml-community/utop/releases/download/2.6.0/utop-2.6.0.tbz" - checksum: [ - "sha256=4d0a94c0db27e39629729e485a142255b824545b5ec0f62b909b7572e88bc99e" - "sha512=767d6d0a98ec5d1e67648f948c9523a79df60c951b16867067a8a377d32261f9b68805ae5c5e3c27d6ce33937d1694bfd15110a23efbc9422399c7ec8b900016" - ] -} diff --git a/jsoo.esy.lock/opam/uutf.1.0.2/opam b/jsoo.esy.lock/opam/uutf.1.0.2/opam deleted file mode 100644 index 3a9f5678d..000000000 --- a/jsoo.esy.lock/opam/uutf.1.0.2/opam +++ /dev/null @@ -1,40 +0,0 @@ -opam-version: "2.0" -maintainer: "Daniel Bünzli " -authors: ["Daniel Bünzli "] -homepage: "http://erratique.ch/software/uutf" -doc: "http://erratique.ch/software/uutf/doc/Uutf" -dev-repo: "git+http://erratique.ch/repos/uutf.git" -bug-reports: "https://github.com/dbuenzli/uutf/issues" -tags: [ "unicode" "text" "utf-8" "utf-16" "codec" "org:erratique" ] -license: "ISC" -depends: [ - "ocaml" {>= "4.01.0"} - "ocamlfind" {build} - "ocamlbuild" {build} - "topkg" {build} - "uchar" -] -depopts: ["cmdliner"] -conflicts: ["cmdliner" { < "0.9.6"} ] -build: [[ - "ocaml" "pkg/pkg.ml" "build" - "--pinned" "%{pinned}%" - "--with-cmdliner" "%{cmdliner:installed}%" ]] -synopsis: """Non-blocking streaming Unicode codec for OCaml""" -description: """\ - -Uutf is a non-blocking streaming codec to decode and encode the UTF-8, -UTF-16, UTF-16LE and UTF-16BE encoding schemes. It can efficiently -work character by character without blocking on IO. Decoders perform -character position tracking and support newline normalization. - -Functions are also provided to fold over the characters of UTF encoded -OCaml string values and to directly encode characters in OCaml -Buffer.t values. - -Uutf has no dependency and is distributed under the ISC license. -""" -url { -archive: "http://erratique.ch/software/uutf/releases/uutf-1.0.2.tbz" -checksum: "a7c542405a39630c689a82bd7ef2292c" -} diff --git a/jsoo.esy.lock/opam/yojson.1.7.0/opam b/jsoo.esy.lock/opam/yojson.1.7.0/opam deleted file mode 100644 index ffef0682a..000000000 --- a/jsoo.esy.lock/opam/yojson.1.7.0/opam +++ /dev/null @@ -1,38 +0,0 @@ -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/jsoo.esy.lock/opam/zed.3.1.0/opam b/jsoo.esy.lock/opam/zed.3.1.0/opam deleted file mode 100644 index a3f195444..000000000 --- a/jsoo.esy.lock/opam/zed.3.1.0/opam +++ /dev/null @@ -1,32 +0,0 @@ -opam-version: "2.0" -maintainer: "opam-devel@lists.ocaml.org" -authors: ["Jérémie Dimino"] -homepage: "https://github.com/ocaml-community/zed" -bug-reports: "https://github.com/ocaml-community/zed/issues" -dev-repo: "git://github.com/ocaml-community/zed.git" -license: "BSD-3-Clause" -depends: [ - "ocaml" {>= "4.02.3"} - "dune" {>= "1.1.0"} - "base-bytes" - "camomile" {>= "1.0.1"} - "react" - "charInfo_width" {>= "1.1.0" & < "2.0~"} -] -build: [ - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} -] -synopsis: "Abstract engine for text edition in OCaml" -description: """ -Zed is an abstract engine for text edition. It can be used to write text -editors, edition widgets, readlines, ... Zed uses Camomile to fully support the -Unicode specification, and implements an UTF-8 encoded string type with -validation, and a rope datastructure to achieve efficient operations on large -Unicode buffers. Zed also features a regular expression search on ropes. To -support efficient text edition capabilities, Zed provides macro recording and -cursor management facilities.""" -url { - src: "https://github.com/ocaml-community/zed/archive/3.1.0.tar.gz" - checksum: "md5=51e8676ba972e5ad727633c161e404b1" -} diff --git a/jsoo.esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json b/jsoo.esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json deleted file mode 100644 index ca6a373d8..000000000 --- a/jsoo.esy.lock/overrides/opam__s__conf_m4_opam__c__1_opam_override/package.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "build": "true", - "dependencies": { - "esy-m4": "esy-packages/esy-m4#c7cf0ac9221be2b1f9d90e83559ca08397a629e7" - } -} diff --git a/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/files/build.sh b/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/files/build.sh deleted file mode 100644 index b2a94f751..000000000 --- a/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/files/build.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/bash - -SECONDARY_CONF="$OCAMLFIND_SECONDARY_PREFIX/lib/findlib.conf.d/ocaml-secondary-compiler.conf" - -if test -f $SECONDARY_CONF; then - export OCAMLFIND_CONF=$SECONDARY_CONF; -fi - -env -u OCAMLLIB ocaml bootstrap.ml -./dune.exe build -p dune --profile dune-bootstrap diff --git a/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/package.json b/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/package.json deleted file mode 100644 index c7d77ab67..000000000 --- a/jsoo.esy.lock/overrides/opam__s__dune_opam__c__2.7.1_opam_override/package.json +++ /dev/null @@ -1,8 +0,0 @@ -{ - "buildsInSource": true, - "build": "bash build.sh", - "install": "esy-installer dune.install", - "buildEnv": { - "OCAMLPATH": "#{ $OCAMLFIND_SECONDARY_PREFIX / 'lib' : ocaml.lib : $OCAML_SECONDARY_COMPILER_PREFIX / 'share' / 'ocaml-secondary-compiler' / 'lib' }" - } -} diff --git a/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch b/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch deleted file mode 100644 index 4d5bea0e0..000000000 --- a/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/files/ocamlbuild-0.14.0.patch +++ /dev/null @@ -1,463 +0,0 @@ ---- ./Makefile -+++ ./Makefile -@@ -213,7 +213,7 @@ - rm -f man/ocamlbuild.1 - - man/options_man.byte: src/ocamlbuild_pack.cmo -- $(OCAMLC) $^ -I src man/options_man.ml -o man/options_man.byte -+ $(OCAMLC) -I +unix unix.cma $^ -I src man/options_man.ml -o man/options_man.byte - - clean:: - rm -f man/options_man.cm* ---- ./src/command.ml -+++ ./src/command.ml -@@ -148,9 +148,10 @@ - let self = string_of_command_spec_with_calls call_with_tags call_with_target resolve_virtuals in - let b = Buffer.create 256 in - (* The best way to prevent bash from switching to its windows-style -- * quote-handling is to prepend an empty string before the command name. *) -+ * quote-handling is to prepend an empty string before the command name. -+ * space seems to work, too - and the ouput is nicer *) - if Sys.os_type = "Win32" then -- Buffer.add_string b "''"; -+ Buffer.add_char b ' '; - let first = ref true in - let put_space () = - if !first then -@@ -260,7 +261,7 @@ - - let execute_many ?(quiet=false) ?(pretend=false) cmds = - add_parallel_stat (List.length cmds); -- let degraded = !*My_unix.is_degraded || Sys.os_type = "Win32" in -+ let degraded = !*My_unix.is_degraded in - let jobs = !jobs in - if jobs < 0 then invalid_arg "jobs < 0"; - let max_jobs = if jobs = 0 then None else Some jobs in ---- ./src/findlib.ml -+++ ./src/findlib.ml -@@ -66,9 +66,6 @@ - (fun command -> lexer & Lexing.from_string & run_and_read command) - command - --let run_and_read command = -- Printf.ksprintf run_and_read command -- - let rec query name = - try - Hashtbl.find packages name -@@ -135,7 +132,8 @@ - with Not_found -> s - - let list () = -- List.map before_space (split_nl & run_and_read "%s list" ocamlfind) -+ let cmd = Shell.quote_filename_if_needed ocamlfind ^ " list" in -+ List.map before_space (split_nl & run_and_read cmd) - - (* The closure algorithm is easy because the dependencies are already closed - and sorted for each package. We only have to make the union. We could also ---- ./src/main.ml -+++ ./src/main.ml -@@ -162,6 +162,9 @@ - Tags.mem "traverse" tags - || List.exists (Pathname.is_prefix path_name) !Options.include_dirs - || List.exists (Pathname.is_prefix path_name) target_dirs) -+ && ((* beware: !Options.build_dir is an absolute directory *) -+ Pathname.normalize !Options.build_dir -+ <> Pathname.normalize (Pathname.pwd/path_name)) - end - end - end ---- ./src/my_std.ml -+++ ./src/my_std.ml -@@ -271,13 +271,107 @@ - try Array.iter (fun x -> if x = basename then raise Exit) a; false - with Exit -> true - -+let command_plain = function -+| [| |] -> 0 -+| margv -> -+ let rec waitpid a b = -+ match Unix.waitpid a b with -+ | exception (Unix.Unix_error(Unix.EINTR,_,_)) -> waitpid a b -+ | x -> x -+ in -+ let pid = Unix.(create_process margv.(0) margv stdin stdout stderr) in -+ let pid', process_status = waitpid [] pid in -+ assert (pid = pid'); -+ match process_status with -+ | Unix.WEXITED n -> n -+ | Unix.WSIGNALED _ -> 2 (* like OCaml's uncaught exceptions *) -+ | Unix.WSTOPPED _ -> 127 -+ -+(* can't use Lexers because of circular dependency *) -+let split_path_win str = -+ let rec aux pos = -+ try -+ let i = String.index_from str pos ';' in -+ let len = i - pos in -+ if len = 0 then -+ aux (succ i) -+ else -+ String.sub str pos (i - pos) :: aux (succ i) -+ with Not_found | Invalid_argument _ -> -+ let len = String.length str - pos in -+ if len = 0 then [] else [String.sub str pos len] -+ in -+ aux 0 -+ -+let windows_shell = lazy begin -+ let rec iter = function -+ | [] -> [| "bash.exe" ; "--norc" ; "--noprofile" |] -+ | hd::tl -> -+ let dash = Filename.concat hd "dash.exe" in -+ if Sys.file_exists dash then [|dash|] else -+ let bash = Filename.concat hd "bash.exe" in -+ if Sys.file_exists bash = false then iter tl else -+ (* if sh.exe and bash.exe exist in the same dir, choose sh.exe *) -+ let sh = Filename.concat hd "sh.exe" in -+ if Sys.file_exists sh then [|sh|] else [|bash ; "--norc" ; "--noprofile"|] -+ in -+ split_path_win (try Sys.getenv "PATH" with Not_found -> "") |> iter -+end -+ -+let prep_windows_cmd cmd = -+ (* workaround known ocaml bug, remove later *) -+ if String.contains cmd '\t' && String.contains cmd ' ' = false then -+ " " ^ cmd -+ else -+ cmd -+ -+let run_with_shell = function -+| "" -> 0 -+| cmd -> -+ let cmd = prep_windows_cmd cmd in -+ let shell = Lazy.force windows_shell in -+ let qlen = Filename.quote cmd |> String.length in -+ (* old versions of dash had problems with bs *) -+ try -+ if qlen < 7_900 then -+ command_plain (Array.append shell [| "-ec" ; cmd |]) -+ else begin -+ (* it can still work, if the called command is a cygwin tool *) -+ let ch_closed = ref false in -+ let file_deleted = ref false in -+ let fln,ch = -+ Filename.open_temp_file -+ ~mode:[Open_binary] -+ "ocamlbuildtmp" -+ ".sh" -+ in -+ try -+ let f_slash = String.map ( fun x -> if x = '\\' then '/' else x ) fln in -+ output_string ch cmd; -+ ch_closed:= true; -+ close_out ch; -+ let ret = command_plain (Array.append shell [| "-e" ; f_slash |]) in -+ file_deleted:= true; -+ Sys.remove fln; -+ ret -+ with -+ | x -> -+ if !ch_closed = false then -+ close_out_noerr ch; -+ if !file_deleted = false then -+ (try Sys.remove fln with _ -> ()); -+ raise x -+ end -+ with -+ | (Unix.Unix_error _) as x -> -+ (* Sys.command doesn't raise an exception, so run_with_shell also won't -+ raise *) -+ Printexc.to_string x ^ ":" ^ cmd |> prerr_endline; -+ 1 -+ - let sys_command = -- match Sys.os_type with -- | "Win32" -> fun cmd -> -- if cmd = "" then 0 else -- let cmd = "bash --norc -c " ^ Filename.quote cmd in -- Sys.command cmd -- | _ -> fun cmd -> if cmd = "" then 0 else Sys.command cmd -+ if Sys.win32 then run_with_shell -+ else fun cmd -> if cmd = "" then 0 else Sys.command cmd - - (* FIXME warning fix and use Filename.concat *) - let filename_concat x y = ---- ./src/my_std.mli -+++ ./src/my_std.mli -@@ -69,3 +69,6 @@ - - val split_ocaml_version : (int * int * int * string) option - (** (major, minor, patchlevel, rest) *) -+ -+val windows_shell : string array Lazy.t -+val prep_windows_cmd : string -> string ---- ./src/ocamlbuild_executor.ml -+++ ./src/ocamlbuild_executor.ml -@@ -34,6 +34,8 @@ - job_stdin : out_channel; - job_stderr : in_channel; - job_buffer : Buffer.t; -+ job_pid : int; -+ job_tmp_file: string option; - mutable job_dying : bool; - };; - -@@ -76,6 +78,61 @@ - in - loop 0 - ;; -+ -+let open_process_full_win cmd env = -+ let (in_read, in_write) = Unix.pipe () in -+ let (out_read, out_write) = Unix.pipe () in -+ let (err_read, err_write) = Unix.pipe () in -+ Unix.set_close_on_exec in_read; -+ Unix.set_close_on_exec out_write; -+ Unix.set_close_on_exec err_read; -+ let inchan = Unix.in_channel_of_descr in_read in -+ let outchan = Unix.out_channel_of_descr out_write in -+ let errchan = Unix.in_channel_of_descr err_read in -+ let shell = Lazy.force Ocamlbuild_pack.My_std.windows_shell in -+ let test_cmd = -+ String.concat " " (List.map Filename.quote (Array.to_list shell)) ^ -+ "-ec " ^ -+ Filename.quote (Ocamlbuild_pack.My_std.prep_windows_cmd cmd) in -+ let argv,tmp_file = -+ if String.length test_cmd < 7_900 then -+ Array.append -+ shell -+ [| "-ec" ; Ocamlbuild_pack.My_std.prep_windows_cmd cmd |],None -+ else -+ let fln,ch = Filename.open_temp_file ~mode:[Open_binary] "ocamlbuild" ".sh" in -+ output_string ch (Ocamlbuild_pack.My_std.prep_windows_cmd cmd); -+ close_out ch; -+ let fln' = String.map (function '\\' -> '/' | c -> c) fln in -+ Array.append -+ shell -+ [| "-c" ; fln' |], Some fln in -+ let pid = -+ Unix.create_process_env argv.(0) argv env out_read in_write err_write in -+ Unix.close out_read; -+ Unix.close in_write; -+ Unix.close err_write; -+ (pid, inchan, outchan, errchan,tmp_file) -+ -+let close_process_full_win (pid,inchan, outchan, errchan, tmp_file) = -+ let delete tmp_file = -+ match tmp_file with -+ | None -> () -+ | Some x -> try Sys.remove x with Sys_error _ -> () in -+ let tmp_file_deleted = ref false in -+ try -+ close_in inchan; -+ close_out outchan; -+ close_in errchan; -+ let res = snd(Unix.waitpid [] pid) in -+ tmp_file_deleted := true; -+ delete tmp_file; -+ res -+ with -+ | x when tmp_file <> None && !tmp_file_deleted = false -> -+ delete tmp_file; -+ raise x -+ - (* ***) - (*** execute *) - (* XXX: Add test for non reentrancy *) -@@ -130,10 +187,16 @@ - (*** add_job *) - let add_job cmd rest result id = - (*display begin fun oc -> fp oc "Job %a is %s\n%!" print_job_id id cmd; end;*) -- let (stdout', stdin', stderr') = open_process_full cmd env in -+ let (pid,stdout', stdin', stderr', tmp_file) = -+ if Sys.win32 then open_process_full_win cmd env else -+ let a,b,c = open_process_full cmd env in -+ -1,a,b,c,None -+ in - incr jobs_active; -- set_nonblock (doi stdout'); -- set_nonblock (doi stderr'); -+ if not Sys.win32 then ( -+ set_nonblock (doi stdout'); -+ set_nonblock (doi stderr'); -+ ); - let job = - { job_id = id; - job_command = cmd; -@@ -143,7 +206,9 @@ - job_stdin = stdin'; - job_stderr = stderr'; - job_buffer = Buffer.create 1024; -- job_dying = false } -+ job_dying = false; -+ job_tmp_file = tmp_file; -+ job_pid = pid } - in - outputs := FDM.add (doi stdout') job (FDM.add (doi stderr') job !outputs); - jobs := JS.add job !jobs; -@@ -199,6 +264,7 @@ - try - read fd u 0 (Bytes.length u) - with -+ | Unix.Unix_error(Unix.EPIPE,_,_) when Sys.win32 -> 0 - | Unix.Unix_error(e,_,_) -> - let msg = error_message e in - display (fun oc -> fp oc -@@ -241,14 +307,19 @@ - decr jobs_active; - - (* PR#5371: we would get EAGAIN below otherwise *) -- clear_nonblock (doi job.job_stdout); -- clear_nonblock (doi job.job_stderr); -- -+ if not Sys.win32 then ( -+ clear_nonblock (doi job.job_stdout); -+ clear_nonblock (doi job.job_stderr); -+ ); - do_read ~loop:true (doi job.job_stdout) job; - do_read ~loop:true (doi job.job_stderr) job; - outputs := FDM.remove (doi job.job_stdout) (FDM.remove (doi job.job_stderr) !outputs); - jobs := JS.remove job !jobs; -- let status = close_process_full (job.job_stdout, job.job_stdin, job.job_stderr) in -+ let status = -+ if Sys.win32 then -+ close_process_full_win (job.job_pid, job.job_stdout, job.job_stdin, job.job_stderr, job.job_tmp_file) -+ else -+ close_process_full (job.job_stdout, job.job_stdin, job.job_stderr) in - - let shown = ref false in - ---- ./src/ocamlbuild_unix_plugin.ml -+++ ./src/ocamlbuild_unix_plugin.ml -@@ -48,12 +48,22 @@ - end - - let run_and_open s kont = -+ let s_orig = s in -+ let s = -+ (* Be consistent! My_unix.run_and_open uses My_std.sys_command and -+ sys_command uses bash. *) -+ if Sys.win32 = false then s else -+ let l = match Lazy.force My_std.windows_shell |> Array.to_list with -+ | hd::tl -> (Filename.quote hd)::tl -+ | _ -> assert false in -+ "\"" ^ (String.concat " " l) ^ " -ec " ^ Filename.quote (" " ^ s) ^ "\"" -+ in - let ic = Unix.open_process_in s in - let close () = - match Unix.close_process_in ic with - | Unix.WEXITED 0 -> () - | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> -- failwith (Printf.sprintf "Error while running: %s" s) in -+ failwith (Printf.sprintf "Error while running: %s" s_orig) in - let res = try - kont ic - with e -> (close (); raise e) ---- ./src/options.ml -+++ ./src/options.ml -@@ -174,11 +174,24 @@ - build_dir := Filename.concat (Sys.getcwd ()) s - else - build_dir := s -+ -+let slashify = -+ if Sys.win32 then fun p -> String.map (function '\\' -> '/' | x -> x) p -+ else fun p ->p -+ -+let sb () = -+ match Sys.os_type with -+ | "Win32" -> -+ (try set_binary_mode_out stdout true with _ -> ()); -+ | _ -> () -+ -+ - let spec = ref ( - let print_version () = -+ sb (); - Printf.printf "ocamlbuild %s\n%!" Ocamlbuild_config.version; raise Exit_OK - in -- let print_vnum () = print_endline Ocamlbuild_config.version; raise Exit_OK in -+ let print_vnum () = sb (); print_endline Ocamlbuild_config.version; raise Exit_OK in - Arg.align - [ - "-version", Unit print_version , " Display the version"; -@@ -257,8 +270,8 @@ - "-build-dir", String set_build_dir, " Set build directory (implies no-links)"; - "-install-lib-dir", Set_string Ocamlbuild_where.libdir, " Set the install library directory"; - "-install-bin-dir", Set_string Ocamlbuild_where.bindir, " Set the install binary directory"; -- "-where", Unit (fun () -> print_endline !Ocamlbuild_where.libdir; raise Exit_OK), " Display the install library directory"; -- "-which", String (fun cmd -> print_endline (find_tool cmd); raise Exit_OK), " Display path to the tool command"; -+ "-where", Unit (fun () -> sb (); print_endline (slashify !Ocamlbuild_where.libdir); raise Exit_OK), " Display the install library directory"; -+ "-which", String (fun cmd -> sb (); print_endline (slashify (find_tool cmd)); raise Exit_OK), " Display path to the tool command"; - "-ocamlc", set_cmd ocamlc, " Set the OCaml bytecode compiler"; - "-plugin-ocamlc", set_cmd plugin_ocamlc, " Set the OCaml bytecode compiler \ - used when building myocamlbuild.ml (only)"; ---- ./src/pathname.ml -+++ ./src/pathname.ml -@@ -84,6 +84,26 @@ - | x :: xs -> x :: normalize_list xs - - let normalize x = -+ let x = -+ if Sys.win32 = false then -+ x -+ else -+ let len = String.length x in -+ let b = Bytes.create len in -+ for i = 0 to pred len do -+ match x.[i] with -+ | '\\' -> Bytes.set b i '/' -+ | c -> Bytes.set b i c -+ done; -+ if len > 1 then ( -+ let c1 = Bytes.get b 0 in -+ let c2 = Bytes.get b 1 in -+ if c2 = ':' && c1 >= 'a' && c1 <= 'z' && -+ ( len = 2 || Bytes.get b 2 = '/') then -+ Bytes.set b 0 (Char.uppercase_ascii c1) -+ ); -+ Bytes.unsafe_to_string b -+ in - if Glob.eval not_normal_form_re x then - let root, paths = split x in - join root (normalize_list paths) ---- ./src/shell.ml -+++ ./src/shell.ml -@@ -24,12 +24,26 @@ - | 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '-' | '/' | '_' | ':' | '@' | '+' | ',' -> loop (pos + 1) - | _ -> false in - loop 0 -+ -+let generic_quote quotequote s = -+ let l = String.length s in -+ let b = Buffer.create (l + 20) in -+ Buffer.add_char b '\''; -+ for i = 0 to l - 1 do -+ if s.[i] = '\'' -+ then Buffer.add_string b quotequote -+ else Buffer.add_char b s.[i] -+ done; -+ Buffer.add_char b '\''; -+ Buffer.contents b -+let unix_quote = generic_quote "'\\''" -+ - let quote_filename_if_needed s = - if is_simple_filename s then s - (* We should probably be using [Filename.unix_quote] except that function - * isn't exported. Users on Windows will have to live with not being able to - * install OCaml into c:\o'caml. Too bad. *) -- else if Sys.os_type = "Win32" then Printf.sprintf "'%s'" s -+ else if Sys.os_type = "Win32" then unix_quote s - else Filename.quote s - let chdir dir = - reset_filesys_cache (); -@@ -37,7 +51,7 @@ - let run args target = - reset_readdir_cache (); - let cmd = String.concat " " (List.map quote_filename_if_needed args) in -- if !*My_unix.is_degraded || Sys.os_type = "Win32" then -+ if !*My_unix.is_degraded then - begin - Log.event cmd target Tags.empty; - let st = sys_command cmd in diff --git a/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json b/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json deleted file mode 100644 index b24be7b5b..000000000 --- a/jsoo.esy.lock/overrides/opam__s__ocamlbuild_opam__c__0.14.0_opam_override/package.json +++ /dev/null @@ -1,27 +0,0 @@ -{ - "build": [ - [ - "bash", - "-c", - "#{os == 'windows' ? 'patch -p1 < ocamlbuild-0.14.0.patch' : 'true'}" - ], - [ - "make", - "-f", - "configure.make", - "all", - "OCAMLBUILD_PREFIX=#{self.install}", - "OCAMLBUILD_BINDIR=#{self.bin}", - "OCAMLBUILD_LIBDIR=#{self.lib}", - "OCAMLBUILD_MANDIR=#{self.man}", - "OCAMLBUILD_NATIVE=true", - "OCAMLBUILD_NATIVE_TOOLS=true" - ], - [ - "make", - "check-if-preinstalled", - "all", - "#{os == 'windows' ? 'install' : 'opam-install'}" - ] - ] -} diff --git a/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch b/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch deleted file mode 100644 index 3e3ee5a24..000000000 --- a/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/files/findlib-1.8.1.patch +++ /dev/null @@ -1,471 +0,0 @@ ---- ./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/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json b/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json deleted file mode 100644 index 9314f8708..000000000 --- a/jsoo.esy.lock/overrides/opam__s__ocamlfind_opam__c__1.8.1_opam_override/package.json +++ /dev/null @@ -1,61 +0,0 @@ -{ - "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/jsoo.json b/jsoo.json deleted file mode 100644 index 1a0e92bfc..000000000 --- a/jsoo.json +++ /dev/null @@ -1,9 +0,0 @@ -{ - "source": "./esy.json", - "override": { - "build": "dune build js/refmt.bc.js", - "devDependencies": { - "@opam/js_of_ocaml": "*" - } - } -} \ No newline at end of file From 89fc815fb4781903ffe1b1cf396c5d555cf1a2b2 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 16:25:49 -0700 Subject: [PATCH 25/64] chore: remove unused files related to JS compilation (#2743) --- js/.gitignore | 1 - js/closurefy.sh | 21 --------------------- package.json | 8 ++------ 3 files changed, 2 insertions(+), 28 deletions(-) delete mode 100644 js/.gitignore delete mode 100755 js/closurefy.sh diff --git a/js/.gitignore b/js/.gitignore deleted file mode 100644 index 1ab59d34a..000000000 --- a/js/.gitignore +++ /dev/null @@ -1 +0,0 @@ -closure-compiler/ \ No newline at end of file diff --git a/js/closurefy.sh b/js/closurefy.sh deleted file mode 100755 index 518ed98b2..000000000 --- a/js/closurefy.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!/bin/bash -set -xeo pipefail - -THIS_SCRIPT_DIR="$(cd "$( dirname "$0" )" && pwd)" - -# download google closure compiler if needed -CLOSURE_COMPILER_DIR="$THIS_SCRIPT_DIR/closure-compiler" -if [ ! -d $CLOSURE_COMPILER_DIR ]; then - mkdir -p $CLOSURE_COMPILER_DIR - pushd $CLOSURE_COMPILER_DIR - curl -O http://dl.google.com/closure-compiler/compiler-20170910.tar.gz - tar -xzf compiler-20170910.tar.gz - popd -fi - -ESY_TARGET_DIR=`esy @jsoo echo '#{self.target_dir}'` -JSOO_FILE="$ESY_TARGET_DIR/default/js/refmt.bc.js" -OUTPUT="$THIS_SCRIPT_DIR/../refmt" - -# # use closure compiler to minify the final file! -java -jar $THIS_SCRIPT_DIR/closure-compiler/closure-compiler-v20170910.jar --create_source_map "$OUTPUT.map" --language_in ECMASCRIPT6 --compilation_level SIMPLE "$JSOO_FILE" > "$OUTPUT.js" diff --git a/package.json b/package.json index eaca98df0..a482cb87c 100644 --- a/package.json +++ b/package.json @@ -11,12 +11,8 @@ "reason", "ocaml", "react", - "javascript", - "won't you look at all these nice types" + "javascript" ], "license": "MIT", - "homepage": "https://github.com/reasonml/reason", - "scripts": { - "prepublishOnly": "cp .dune-for-prepublish dune && esy @jsoo && ./js/closurefy.sh" - } + "homepage": "https://github.com/reasonml/reason" } From 62ebd5c23045a4b46df52e3854eb08a284b7449e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 18:28:52 -0700 Subject: [PATCH 26/64] chore: update esy to released version (#2744) --- .github/workflows/esy-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/esy-ci.yml b/.github/workflows/esy-ci.yml index 292d1fbd6..f2b67b3d8 100644 --- a/.github/workflows/esy-ci.yml +++ b/.github/workflows/esy-ci.yml @@ -43,7 +43,7 @@ jobs: node-version: 16 - name: Install esy - run: npm install -g @esy-nightly/esy + run: npm install -g esy@0.7.3-beta.3 - name: Restore global cache (~/.esy/source) id: global-cache From 4a2bd17705feb471e149432087d75a255a79d5e0 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 19:53:31 -0700 Subject: [PATCH 27/64] refactor: remove compiler-libs.common from some dune files (#2745) * refactor: remove compiler-libs.common from some dune files * wip --- src/reason-merlin/dune | 2 -- src/reason-merlin/ocamlmerlin_reason.cppo.ml | 2 +- src/reason-parser-tests/testOprint.cppo.ml | 7 ++----- src/rtop/dune | 1 - src/vendored-omp/src/dune | 2 +- test/lib/outcometreePrinter.cppo.ml | 7 ++----- 6 files changed, 6 insertions(+), 15 deletions(-) diff --git a/src/reason-merlin/dune b/src/reason-merlin/dune index c64583c31..094d27eeb 100644 --- a/src/reason-merlin/dune +++ b/src/reason-merlin/dune @@ -8,6 +8,4 @@ (name ocamlmerlin_reason) (public_name ocamlmerlin-reason) (package reason) - (flags - (:standard -w -9)) (libraries compiler-libs.common merlin-extend reason)) diff --git a/src/reason-merlin/ocamlmerlin_reason.cppo.ml b/src/reason-merlin/ocamlmerlin_reason.cppo.ml index 352b9b979..30701e23c 100644 --- a/src/reason-merlin/ocamlmerlin_reason.cppo.ml +++ b/src/reason-merlin/ocamlmerlin_reason.cppo.ml @@ -24,7 +24,7 @@ module Reason_reader = struct in Signature (Reason_toolchain.To_current.copy_signature sg) - let parse {text; path} = + let parse {text; path; _} = let l = String.length path in let buf = Lexing.from_string text in Location.init buf (Filename.basename path); diff --git a/src/reason-parser-tests/testOprint.cppo.ml b/src/reason-parser-tests/testOprint.cppo.ml index 4d7c7ed7b..9cebda7b3 100644 --- a/src/reason-parser-tests/testOprint.cppo.ml +++ b/src/reason-parser-tests/testOprint.cppo.ml @@ -19,10 +19,7 @@ * not a super easy path to "test it out", but this setup is hopefully not too complicated. *) -open Reason_omp -module Ast = Ast_414 - -module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) +module ConvertBack = Reason_toolchain.From_current let main () = let filename = "./TestTest.ml" in @@ -55,7 +52,7 @@ let main () = env ast in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in - let phrase = (Ast.Outcometree.Ophr_signature + let phrase = (Reason_omp.Ast_414.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) ) in let fmt = Format.str_formatter in diff --git a/src/rtop/dune b/src/rtop/dune index 30ab73801..94e58d3ca 100644 --- a/src/rtop/dune +++ b/src/rtop/dune @@ -5,7 +5,6 @@ (wrapped false) (modes byte) (libraries - compiler-libs.common menhirLib reason.easy_format reason diff --git a/src/vendored-omp/src/dune b/src/vendored-omp/src/dune index 489d709e8..078482fee 100644 --- a/src/vendored-omp/src/dune +++ b/src/vendored-omp/src/dune @@ -6,7 +6,7 @@ (wrapped true) ; (wrapped ; (transition "Access modules via the Migrate_parsetree toplevel module")) - (libraries compiler-libs.common ppx_derivers) + (libraries ppxlib.astlib ppx_derivers) (modules :standard \ migrate_parsetree_driver_main) (preprocess (action diff --git a/test/lib/outcometreePrinter.cppo.ml b/test/lib/outcometreePrinter.cppo.ml index 4d7c7ed7b..9cebda7b3 100644 --- a/test/lib/outcometreePrinter.cppo.ml +++ b/test/lib/outcometreePrinter.cppo.ml @@ -19,10 +19,7 @@ * not a super easy path to "test it out", but this setup is hopefully not too complicated. *) -open Reason_omp -module Ast = Ast_414 - -module ConvertBack = Reason_omp.Convert (Reason_omp.OCaml_current) (Reason_omp.OCaml_414) +module ConvertBack = Reason_toolchain.From_current let main () = let filename = "./TestTest.ml" in @@ -55,7 +52,7 @@ let main () = env ast in let tree = Printtyp.tree_of_signature typedtree.Typedtree.str_type in - let phrase = (Ast.Outcometree.Ophr_signature + let phrase = (Reason_omp.Ast_414.Outcometree.Ophr_signature (List.map (fun item -> (ConvertBack.copy_out_sig_item item, None)) tree) ) in let fmt = Format.str_formatter in From 73dcfe82039e62f039a4d7d4fbedc57a973cb221 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 29 Jun 2024 19:53:50 -0700 Subject: [PATCH 28/64] fix(ci): pin the correct ocaml version for Esy (#2712) * fix(ci): pin the correct ocaml version for Esy * Update esy-ci.yml * rm ocaml-lsp for <4.14 testing * try i.bak * remove 4.06 from esy CI, it's tested elsewhere * stop building on 4.12 too i guess * lol * guess we're not running esy on more versions --- .github/workflows/esy-ci.yml | 10 +--------- esy.json | 1 - 2 files changed, 1 insertion(+), 10 deletions(-) diff --git a/.github/workflows/esy-ci.yml b/.github/workflows/esy-ci.yml index f2b67b3d8..a7008994a 100644 --- a/.github/workflows/esy-ci.yml +++ b/.github/workflows/esy-ci.yml @@ -26,17 +26,12 @@ jobs: - windows-latest ocaml-compiler: - # Please keep the list in sync with the minimal version of OCaml in - # esy.json, reason.esy/reason.opam and rtop.esy/rtop.opam. - - 4.06.x # We support 4.06 because is the one that is used in BuckleScript / ReScript v9 - - 4.10.x - - 4.12.x - 4.14.x runs-on: ${{ matrix.os }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: actions/setup-node@v3 with: @@ -66,9 +61,6 @@ jobs: key: esy-build-${{ matrix.os }}-${{ matrix.ocaml-compiler }}-${{ hashFiles('esy.lock.json') }} restore-keys: esy-build-${{ matrix.os }}- - - name: Instal OCaml ${{ matrix.ocaml-compiler }} - run: esy add ocaml@${{ matrix.ocaml-compiler }} - - name: Install dependencies run: esy install diff --git a/esy.json b/esy.json index 81ab5e279..09d4ac5c3 100644 --- a/esy.json +++ b/esy.json @@ -16,7 +16,6 @@ "ocaml": " >= 4.3.0 < 4.15.0" }, "devDependencies": { - "@opam/ocaml-lsp-server": "1.15.1-4.14", "@opam/odoc": "*", "ocaml": "~4.14.0" }, From 555e229da0d258e27768781842ba81d81f22251b Mon Sep 17 00:00:00 2001 From: Sander Date: Sun, 30 Jun 2024 05:21:44 +0200 Subject: [PATCH 29/64] Fix 2695: local open + let bindings (#2716) * Add parser support for local open syntax. * add pretty printer support * Add history entry * improve fix * improve handling of local open * improve formatting * rebase / share code --------- Co-authored-by: Antonio Nuno Monteiro --- CHANGES.md | 1 + src/reason-parser/reason_attributes.ml | 9 ++++ src/reason-parser/reason_parser.mly | 52 +++++++++++-------- src/reason-parser/reason_pprint_ast.ml | 72 ++++++++++++++++---------- test/modules.t/input.re | 12 ++++- test/modules.t/run.t | 11 ++++ 6 files changed, 107 insertions(+), 50 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 5b061cb0d..69a3b6b0a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,7 @@ - Add `\u{hex-escape}` syntax (@anmonteiro, [#2738](https://github.com/reasonml/reason/pull/2738)) +- Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) ## 3.11.0 diff --git a/src/reason-parser/reason_attributes.ml b/src/reason-parser/reason_attributes.ml index c944eb840..12da0bcd8 100644 --- a/src/reason-parser/reason_attributes.ml +++ b/src/reason-parser/reason_attributes.ml @@ -41,6 +41,9 @@ let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : attrib | ({ attr_name = {txt="reason.preserve_braces"}; _} as attr) :: atTl -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with stylisticAttrs=attr::partition.stylisticAttrs} + | ({ attr_name = {txt="reason.openSyntaxNotation"}; _} as attr) :: atTl -> + let partition = partitionAttributes ~partDoc ~allowUncurry atTl in + {partition with stylisticAttrs=attr::partition.stylisticAttrs} | atHd :: atTl -> let partition = partitionAttributes ~partDoc ~allowUncurry atTl in {partition with stdAttrs=atHd::partition.stdAttrs} @@ -88,3 +91,9 @@ let maybe_remove_stylistic_attrs attrs should_preserve = | { attr_name = {txt="reason.raw_literal"}; _} -> true | _ -> false) attrs + +let is_open_notation_attr { attr_name = {txt}; _} = + txt = "reason.openSyntaxNotation" + +let has_open_notation_attr stylisticAttrs = + List.exists is_open_notation_attr stylisticAttrs diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 1af8d5bd8..053127a37 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -2481,7 +2481,7 @@ class_type_declaration_details: *) braced_expr: mark_position_exp - ( LBRACE seq_expr RBRACE + ( LBRACE seq_expr(SEMI?) RBRACE { add_brace_attr $2 } | LBRACE DOTDOTDOT expr_optional_constraint COMMA? RBRACE { let loc = mklocation $symbolstartpos $endpos in @@ -2503,28 +2503,28 @@ mark_position_exp { mkexp (Pexp_object $2) } ) {$1}; -seq_expr_no_seq [@recover.expr default_expr ()]: -| expr SEMI? { $1 } -| opt_LET_MODULE_ident module_binding_body SEMI seq_expr +seq_expr_no_seq [@recover.expr default_expr ()] (semi): +| expr semi { $1 } +| opt_LET_MODULE_ident module_binding_body SEMI seq_expr(SEMI?) { mkexp (Pexp_letmodule($1, $2, $4)) } -| item_attributes LET? OPEN override_flag as_loc(mod_longident) SEMI seq_expr +| item_attributes LET? OPEN override_flag as_loc(mod_longident) SEMI seq_expr(SEMI?) { let loc = (mklocation $startpos($1) $endpos($4)) in let me = Ast_helper.Mod.ident ~loc $5 in let od = Ast_helper.Opn.mk ~override:$4 ~loc me in let exp = mkexp (Pexp_open(od, $7)) in { exp with pexp_attributes = $1 } } -| str_exception_declaration SEMI seq_expr { +| str_exception_declaration SEMI seq_expr(SEMI?) { mkexp (Pexp_letexception ($1, $3)) } -| let_bindings SEMI seq_expr +| let_bindings SEMI seq_expr(SEMI?) { let loc = mklocation $startpos($1) $endpos($3) in expr_of_let_bindings ~loc $1 $3 } -| let_bindings SEMI? +| let_bindings semi { let loc = mklocation $symbolstartpos $endpos in expr_of_let_bindings ~loc $1 (ghunit ~loc ()) } -| as_loc(LETOP) letop_bindings SEMI seq_expr +| as_loc(LETOP) letop_bindings SEMI seq_expr(SEMI?) { let (pbop_pat, pbop_exp, rev_ands) = $2 in let ands = List.rev rev_ands in let pbop_loc = mklocation $symbolstartpos $endpos($2) in @@ -2532,15 +2532,15 @@ seq_expr_no_seq [@recover.expr default_expr ()]: mkexp ~loc:pbop_loc (Pexp_letop { let_; ands; body = $4}) } ; -seq_expr: +seq_expr(semi): mark_position_exp - ( seq_expr_no_seq + ( seq_expr_no_seq(semi) { $1 } - | item_extension_sugar mark_position_exp(seq_expr_no_seq) + | item_extension_sugar mark_position_exp(seq_expr_no_seq(SEMI?)) { expression_extension $1 $2 } - | expr SEMI seq_expr + | expr SEMI seq_expr(SEMI?) { mkexp (Pexp_sequence($1, $3)) } - | item_extension_sugar expr SEMI seq_expr + | item_extension_sugar expr SEMI seq_expr(SEMI?) { let loc = mklocation $startpos($1) $endpos($2) in mkexp (Pexp_sequence(expression_extension ~loc $1 $2, $4)) } ) { $1 } @@ -2874,10 +2874,10 @@ mark_position_exp | FUN optional_expr_extension match_cases(expr) %prec below_BAR { $2 (mkexp (Pexp_function $3)) } | SWITCH optional_expr_extension simple_expr_no_constructor - LBRACE match_cases(seq_expr) RBRACE + LBRACE match_cases(seq_expr(SEMI?)) RBRACE { $2 (mkexp (Pexp_match ($3, $5))) } | TRY optional_expr_extension simple_expr_no_constructor - LBRACE match_cases(seq_expr) RBRACE + LBRACE match_cases(seq_expr(SEMI?)) RBRACE { $2 (mkexp (Pexp_try ($3, $5))) } | IF optional_expr_extension parenthesized_expr simple_expr ioption(preceded(ELSE,expr)) @@ -3007,6 +3007,10 @@ parenthesized_expr: %inline bigarray_access: DOT LBRACE lseparated_nonempty_list(COMMA, expr) COMMA? RBRACE { $3 } +expr_list_or_seq_expr: + | expr_list { $1 } + | seq_expr(SEMI) { [$1] }; + (* The grammar of simple exprs changes slightly according to context: * - in most cases, calls (like f(x)) are allowed * - in some contexts, calls are forbidden @@ -3033,8 +3037,15 @@ parenthesized_expr: { may_tuple $startpos $endpos $2 } | E as_loc(POSTFIXOP) { mkexp(Pexp_apply(mkoperator $2, [Nolabel, $1])) } - | od=open_dot_declaration DOT LPAREN expr_list RPAREN - { mkexp(Pexp_open(od, may_tuple $startpos($3) $endpos($5) $4)) } + | od=open_dot_declaration DOT LPAREN expr_list_or_seq_expr RPAREN + { + let loc = mklocation $symbolstartpos $endpos in + let openSyntaxNotationAttribute = { + Ppxlib.Parsetree.attr_name = mkloc "reason.openSyntaxNotation" loc; + attr_payload = PStr []; + attr_loc = Location.none + } in + mkexp ~attrs:[openSyntaxNotationAttribute] (Pexp_open(od, may_tuple $startpos($3) $endpos($5) $4)) } | E DOT as_loc(label_longident) { mkexp(Pexp_field($1, $3)) } | od=open_dot_declaration DOT LBRACE RBRACE @@ -3119,11 +3130,6 @@ parenthesized_expr: mkinfixop $1 (mkoperator op) $3 } | E as_loc(MINUSGREATER) simple_expr_no_call { mkinfixop $1 (mkoperator {$2 with txt = "|."}) $3 } - | od=open_dot_declaration DOT LPAREN MODULE module_expr COLON package_type RPAREN - { let loc = mklocation $symbolstartpos $endpos in - mkexp (Pexp_open(od, - mkexp ~loc (Pexp_constraint (mkexp ~ghost:true ~loc (Pexp_pack $5), $7)))) - } | extension { mkexp (Pexp_extension $1) } ; diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index ba092976a..e3ea38f57 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -4342,7 +4342,7 @@ let printer = object(self:'self) | None -> raise (Invalid_argument "No match for unparsing expression") ) - method formatNonSequencyExpression e = + method formatNonSequencyExpression ?parent e = (* * Instead of printing: * let result = { open Fmt; strf(foo);} @@ -4364,7 +4364,18 @@ let printer = object(self:'self) * E.g., avoid M.(M2.v) being printed as M.M2.v * Or ReasonReact.(<> {string("Test")} ); *) - | _ -> makeList ~wrap:("(",")") ~break:IfNeed [self#unparseExpr e] + | _ -> ( + match parent with + | Some parent when has_open_notation_attr parent.pexp_attributes -> + makeList + ~break:IfNeed + ~inline:(true, false) + ~postSpace:true + ~wrap:("(",")") + ~sep:(SepFinal (";", "")) + (self#letList e) + | Some _ | None -> makeList ~wrap:("(",")") ~break:IfNeed [self#unparseExpr e] + ) (* It's not enough to only check if precedence of an infix left/right is @@ -5508,7 +5519,7 @@ let printer = object(self:'self) * list containing the location indicating start/end of the "let-item" and * its layout. *) let rec processLetList acc expr = - let {stdAttrs; arityAttrs; jsxAttrs} = + let {stdAttrs; arityAttrs; jsxAttrs; stylisticAttrs} = partitionAttributes ~allowUncurry:false expr.pexp_attributes in match (stdAttrs, expr.pexp_desc) with @@ -5534,26 +5545,35 @@ let printer = object(self:'self) (* Add this when check to make sure these are handled as regular "simple expressions" *) when not (self#isSeriesOfOpensFollowedByNonSequencyExpression {expr with pexp_attributes = []}) -> let overrideStr = match me.popen_override with | Override -> "!" | Fresh -> "" in - let openLayout = label ~space:true - (atom ("open" ^ overrideStr)) - (self#moduleExpressionToFormattedApplicationItems me.popen_expr) - in - let attrsOnOpen = - makeList ~inline:(true, true) ~postSpace:true ~break:Always - ((self#attributes attrs)@[openLayout]) - in - (* Just like the bindings, have to synthesize a location since the - * Pexp location is parsed (potentially) beginning with the open - * brace {} in the let sequence. *) - let layout = source_map ~loc:me.popen_loc attrsOnOpen in - let loc = { - me.popen_loc with - loc_start = { - me.popen_loc.loc_start with - pos_lnum = expr.pexp_loc.loc_start.pos_lnum - } - } in - processLetList ((loc, layout)::acc) e + if (has_open_notation_attr stylisticAttrs) then ( + (Location.none, label + (label + (self#moduleExpressionToFormattedApplicationItems me.popen_expr) + (atom ("."))) + (makeLetSequence ~wrap:("(", ")") (self#letList e))) :: acc + ) + else ( + let openLayout = label ~space:true + (atom ("open" ^ overrideStr)) + (self#moduleExpressionToFormattedApplicationItems me.popen_expr) + in + let attrsOnOpen = + makeList ~inline:(true, true) ~postSpace:true ~break:Always + ((self#attributes attrs)@[openLayout]) + in + (* Just like the bindings, have to synthesize a location since the + * Pexp location is parsed (potentially) beginning with the open + * brace {} in the let sequence. *) + let layout = source_map ~loc:me.popen_loc attrsOnOpen in + let loc = { + me.popen_loc with + loc_start = { + me.popen_loc.loc_start with + pos_lnum = expr.pexp_loc.loc_start.pos_lnum + } + } in + processLetList ((loc, layout)::acc) e + ) | ([], Pexp_letmodule (s, me, e)) -> let prefixText = "module" in let bindingName = atom ~loc:s.loc (moduleIdent s) in @@ -6448,9 +6468,9 @@ let printer = object(self:'self) (label (self#moduleExpressionToFormattedApplicationItems me.popen_expr) (atom ("."))) - (self#formatNonSequencyExpression e)) - else - Some (makeLetSequence (self#letList x)) + (self#formatNonSequencyExpression ~parent:x e)) + else + Some (makeLetSequence (self#letList e)) | Pexp_send (e, s) -> let needparens = match e.pexp_desc with | Pexp_apply (ee, _) -> diff --git a/test/modules.t/input.re b/test/modules.t/input.re index cf46b48f6..949967da2 100644 --- a/test/modules.t/input.re +++ b/test/modules.t/input.re @@ -499,4 +499,14 @@ module Lola2 = (C: Cat, D: Dog, L: Lion) => { module L = Lola1(); -module L2 = Lola2(Cat, Dog, Foo); \ No newline at end of file +module L2 = Lola2(Cat, Dog, Foo); + +let y = Promise.Ops.( + open Foo.Bar; + let a = 2 + Bar.( + let* x = Js.Promise.resolve(42); + let a = 1; + Js.Promise.resolve(x * 2) + ) +); diff --git a/test/modules.t/run.t b/test/modules.t/run.t index a23b89346..cb19ba460 100644 --- a/test/modules.t/run.t +++ b/test/modules.t/run.t @@ -665,4 +665,15 @@ Format modules module L = Lola1(); module L2 = Lola2(Cat, Dog, Foo); + + let y = + Promise.Ops.( + open Foo.Bar; + let a = 2; + Bar.( + let* x = Js.Promise.resolve(42); + let a = 1; + Js.Promise.resolve(x * 2); + ) + ); /* From http://stackoverflow.com/questions/1986374/ higher-order-type-constructors-and-functors-in-ocaml */ From bfb363d37ab3c5f982755104c85e766c2cfe44a2 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 6 Jul 2024 22:40:15 -0700 Subject: [PATCH 30/64] fix(printer): wrap `Ppat_alias (Ppat_constraint _, _)` in parentheses (#2747) --- src/reason-parser/reason_pprint_ast.ml | 1 + test/letop.t/input.re | 6 ++++++ test/letop.t/run.t | 6 ++++++ 3 files changed, 13 insertions(+) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index e3ea38f57..56be64e88 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3203,6 +3203,7 @@ let printer = object(self:'self) let raw_pattern = (self#pattern p) in let pattern_with_precedence = match p.ppat_desc with | Ppat_or (p1, p2) -> formatPrecedence (self#or_pattern p1 p2) + | Ppat_constraint _ -> makeList ~wrap:("(", ")") [ raw_pattern ] | _ -> raw_pattern in label ~space:true diff --git a/test/letop.t/input.re b/test/letop.t/input.re index 43451382d..0295364d0 100644 --- a/test/letop.t/input.re +++ b/test/letop.t/input.re @@ -26,3 +26,9 @@ let _ = { None; }; + +// test that the type annotation prints with parenthesis +let _ = { + let.opt (x : string) as _y = Some ("a"); + None +}; diff --git a/test/letop.t/run.t b/test/letop.t/run.t index 02455934e..31a7da3af 100644 --- a/test/letop.t/run.t +++ b/test/letop.t/run.t @@ -47,6 +47,12 @@ Print the formatted file None; }; + + // test that the type annotation prints with parenthesis + let _ = { + let.opt (x: string) as _y = Some("a"); + None; + }; Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re From 61f85c241a741f85e7656092fb0c067e6352187f Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 14:54:50 -0700 Subject: [PATCH 31/64] chore: remove bspack directory (#2748) --- bspacks/README.md | 75 --------------- bspacks/downloadSomeDependencies.sh | 60 ------------ bspacks/reason_bspack.sh | 70 -------------- bspacks/reason_bspack406.sh | 141 ---------------------------- 4 files changed, 346 deletions(-) delete mode 100644 bspacks/README.md delete mode 100755 bspacks/downloadSomeDependencies.sh delete mode 100755 bspacks/reason_bspack.sh delete mode 100755 bspacks/reason_bspack406.sh diff --git a/bspacks/README.md b/bspacks/README.md deleted file mode 100644 index 65fb73c35..000000000 --- a/bspacks/README.md +++ /dev/null @@ -1,75 +0,0 @@ -This subdirectory is used for packing up the entire Reason `refmt` into a -single file through BuckleScript's -[bspack](https://github.com/bloomberg/bucklescript/blob/master/jscomp/core/bspack_main.ml), -thus discarding all intermediate steps needed to build Reason, except for the -final `refmt` binary compilation. - -This makes our installation much friendlier to e.g. Windows. BuckleScript -currently includes the three bundles in its own repo, thus making Reason -first-class (Btw, BS also uses a few other pieces of code from Reason, in its -vendor/reason folder and jscomp/reason_outcome_printer). - -## Build (4.06 / BuckleScript v6 and above) - -We use this workflow for building `build/refmt_api.ml` and -`build/refmt_binary.ml` so we can easily vendor Reason for newer BuckleScript -releases. More details on that are in the [BuckleScript -CONTRIBUTING](https://github.com/BuckleScript/CONTRIBUTING.md) file. - -For inlining the right version number in the bundle, the script uses -`../reason.json` as the source of truth. - -**Note:** Currently you will need to build BuckleScript yourself to get access -to the `bspack.exe` executable. Also we skip the building of the `refmt.js` -artifact entirely here. Will maybe added back later as soon as we need it! - -**Instructions:** - -``` -cd bspacks - -opam switch 4.06.1 - -./downloadSomeDependencies.sh - -# Point to your locally built bspack.exe -BSPACK_EXE=~/Projects/bucklescript/jscomp/bin/bspack.exe ./reason_bspack406.sh -``` - -The bspacked files are also compiled to make sure that the bundle actually -compiles. You should then find all the relevant `.ml` files in the `./build` -directory, ready to be copied over to BuckleScript. - -## Legacy Build (4.02 / BuckleScript v5 and below) - -> This is an old workflow which also seem to be broken since `reerror` was -> merged. We discourage the use, unless you really need to build bspacked -> bundles for 4.02 based BuckleScript versions - -This whole process needs to happen with OCaml 4.02.3, so make sure you switch -to that version first: - -```sh -# Then switch to the right ocaml version and install all deps -opam switch 4.02.3 -``` - -Build / install the main Reason repo. Follow the instructions in https://github.com/facebook/reason/blob/master/docs/GETTING_STARTED_CONTRIBUTING.md#contributor-setup. - -Then, install the dependencies: - -```sh -opam install js_of_ocaml.3.0 -opam install utop -cd .. && npm install -``` - -Also, have `java` installed in your system. This is needed to use closure compiler to compress the final `refmt.js`. In most cases, this means installing the [Java Development Kit](http://www.oracle.com/technetwork/java/javase/downloads/jdk8-downloads-2133151.html). - -Now, from the project root run: - -```sh -version=VERSION_NUMBER_HERE npm run prepublishOnly -``` - -to pack up Reason into a single file. Check the extensive comments in both `sh` files here if something goes wrong. diff --git a/bspacks/downloadSomeDependencies.sh b/bspacks/downloadSomeDependencies.sh deleted file mode 100755 index e89dd4a0a..000000000 --- a/bspacks/downloadSomeDependencies.sh +++ /dev/null @@ -1,60 +0,0 @@ -set -xeo pipefail - -THIS_SCRIPT_DIR="$(cd "$( dirname "$0" )" && pwd)" - -if [ -z ${OCAML_VERSION+x} ]; then - echo "OCAML_VERSION not defined, defaulting to '4.06.1'..." - OCAML_VERSION=4.06.1 -fi - -echo "**This script is switching you to ocaml ${OCAML_VERSION} for the subsequent bspacking. Please switch back to your own version afterward. Thanks!**\n" - -# switch to 4.06.1. Bspacking means we're sending the final bundle to BuckleScript, which is still on 4.02 -opam switch $OCAML_VERSION - -# ============= -# first step, build ocaml-migrate-parsetree -# ============= -eval $(opam config env) - -OMP_ARTIFACTS_DIR="$THIS_SCRIPT_DIR/ocaml-migrate-parsetree" - -rm -rf $OMP_ARTIFACTS_DIR -mkdir $OMP_ARTIFACTS_DIR - -# ocaml-migrate-parsetree uses jbuilder to build, and having jBuilder inside the -# reason repo clashes with reason's own jbuilder build -TEMP_DIR_FOR_OMP=`mktemp -d` -echo "cloning ocaml-migrate-parsetree into $TEMP_DIR_FOR_OMP" -git clone https://github.com/ocaml-ppx/ocaml-migrate-parsetree.git $TEMP_DIR_FOR_OMP - -git clone https://github.com/ocaml-ppx/ppx_derivers $TEMP_DIR_FOR_OMP/ppx_derivers - -pushd $TEMP_DIR_FOR_OMP - -# pin it at a certain tag -git checkout v1.5.0 -# if there's any error, check if you have everything installed. You should -# already from opam pin-ing the reason repo (which depends on ocaml-migrate-parsetree) - -pushd ppx_derivers -git checkout 1.2.1 -make -popd - -make - -pushd ./_build/default/src - -rm -rf ./*.cm* -rm -rf ./*.o -rm -rf ./*.a - -# # bspack needs the fully processed files with ppx already applied to them, and -# # jBuilder keeps them around in files like `x.pp.ml`, so rename them to `x.ml` -for i in ./*.pp.{ml,mli}; do mv $i ${i/.pp/}; done - -popd -popd - -mv $TEMP_DIR_FOR_OMP/* $OMP_ARTIFACTS_DIR diff --git a/bspacks/reason_bspack.sh b/bspacks/reason_bspack.sh deleted file mode 100755 index 8209d3cc0..000000000 --- a/bspacks/reason_bspack.sh +++ /dev/null @@ -1,70 +0,0 @@ -# Legacy Note: -# This script is used for older 4.02 based bspacking processes. -# -# Use reason_bspack406.sh for bspacking refmt_api and refmt_binary for -# BuckleScript v6 and above (OCaml 4.06 based)! - -# exit if anything goes wrong -set -e - -# this script does 2 independent things: -# - pack the whole repo into a single refmt file for vendoring into bucklescript -# - generate the js version of refmt for web usage - -THIS_SCRIPT_DIR="$(cd "$( dirname "$0" )" && pwd)" - -echo "**This script is switching you to ocaml 4.02.3 for the subsequent bspacking. Please switch back to your own version afterward. Thanks!**\n" -opam switch 4.02.3 -eval $(opam config env) - -# Because OCaml 4.02 doesn't come with the `Result` module, it also needed stubbing out. -resultStub="module Result = struct type ('a, 'b) result = Ok of 'a | Error of 'b end open Result" - -menhirSuggestedLib=`menhir --suggest-menhirLib` - -# generated from the script ./downloadSomeDependencies.sh -ocamlMigrateParseTreeTargetDir="$THIS_SCRIPT_DIR/ocaml-migrate-parsetree/_build/default/src" -reasonTargetDir="$THIS_SCRIPT_DIR/.." -buildDir="$THIS_SCRIPT_DIR/build" - -REFMT_BINARY="$buildDir/refmt_binary" - -# clean some artifacts -rm -f "$REFMT_CLOSURE.*" -rm -rf $buildDir -mkdir $buildDir - -pushd $THIS_SCRIPT_DIR -# rebuild the project in case it was stale -make clean -C ../ -make pre_release -C ../ -make build -C ../ - -# ============= -# last step for the first task , we're done generating the single file that'll -# be coped over to bucklescript. On BS' side, it'll use a single compile command -# to turn this into a binary, like in -# https://github.com/BuckleScript/bucklescript/blob/2ad2310f18567aa13030cdf32adb007d297ee717/jscomp/bin/Makefile#L29 -# ============= -../node_modules/bs-platform/bin/bspack.exe \ - -main-export Refmt_impl \ - -prelude-str "$resultStub" \ - -I "$menhirSuggestedLib" \ - -I "$reasonTargetDir" \ - -I "$reasonTargetDir/_build/default/src/ppx/" \ - -I "$reasonTargetDir/_build/default/src/reason-merlin/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/easy_format/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/cmdliner/" \ - -I "$reasonTargetDir/_build/default/src/refmt/" \ - -I "$reasonTargetDir/_build/default/src/refmttype/" \ - -I "$ocamlMigrateParseTreeTargetDir" \ - -bs-MD \ - -o "$REFMT_BINARY.ml" - -# build REFMT_BINARY into an actual binary too. For testing purposes at the end -ocamlc -g -no-alias-deps -w -40 -I +compiler-libs ocamlcommon.cma "$REFMT_BINARY.ml" -o "$REFMT_BINARY.byte" - -# small integration test to check that the process went well -# for the native binary -echo "let f = (a) => 1" | "$REFMT_BINARY.byte" --parse re --print ml \ No newline at end of file diff --git a/bspacks/reason_bspack406.sh b/bspacks/reason_bspack406.sh deleted file mode 100755 index 4203490cb..000000000 --- a/bspacks/reason_bspack406.sh +++ /dev/null @@ -1,141 +0,0 @@ -# NOTE: -# -------- -# This script is derived from the original `./reason_bspack.sh` -# which is based on the 4.02 based BuckleScript bspack version. The script also -# does way more than this file, such as creating an closure-optimized refmt.js -# file. -# -# What this file is about: -# ----- -# For BuckleScript v6 and above (based on 4.06), -# we want to be able to build the `refmt_api` and `refmt_binary` build -# artifacts by leveraging an up to date bspack version. -# -# bspack itself is not vendored in bs-platform anymore, so the user of this -# script has to provide the bspack binary themselves (most likely as a local -# build from the bucklescript repo) -# -# We use the env variable BSPACK_EXE to populate the bspack path. -# -# Example Usage: -# ------- -# cd bspacks/ -# BSPACK_EXE=~/Projects/bucklescript/jscomp/bin/bspack.exe bash reason_bspack406.sh - -# exit if anything goes wrong -set -xeo pipefail - -# this script does 2 independent things: -# - pack the whole repo into a single refmt file for vendoring into bucklescript -# - generate the js version of refmt for web usage - -THIS_SCRIPT_DIR="$(cd "$( dirname "$0" )" && pwd)" - -# Automatically read the version from reason.json, so that dune builds the right Package.ml file (version, git_version, etc.) -export version=$(cat ../reason.json \ - | grep version \ - | head -1 \ - | awk -F: '{ print $2 }' \ - | sed 's/[",]//g') - -echo "**This script is switching you to ocaml 4.06.1 for the subsequent bspacking. Please switch back to your own version afterward. Thanks!**\n" -opam switch 4.06.1 -eval $(opam config env) - - -if [ -z ${BSPACK_EXE+x} ]; then - echo "Missing env variable 'BSPACK_EXE'" - echo "Example Usage:" - echo "BSPACK_EXE=~/bucklescript/jscomp/bin/bspack.exe bash reason_bspack406.sh" - exit 1 -fi - -echo "Using bspack located at '${BSPACK_EXE}'..." - -# Because OCaml 4.06 doesn't come with the `Result` module, it also needed stubbing out. -resultStub="module Result = struct type ('a, 'b) result = Ok of 'a | Error of 'b end open Result" - -menhirSuggestedLib=`menhir --suggest-menhirLib` - -# generated from the script ./downloadSomeDependencies.sh -ocamlMigrateParseTreeTargetDir="$THIS_SCRIPT_DIR/ocaml-migrate-parsetree/_build/default" -reasonTargetDir="$THIS_SCRIPT_DIR/.." -buildDir="$THIS_SCRIPT_DIR/build" - -REFMT_BINARY="$buildDir/refmt_binary" -REFMT_API="$buildDir/refmt_api" -REFMT_API_ENTRY="$buildDir/refmt_api_entry" -REFMT_API_FINAL="$buildDir/refmt_api_final" -REFMT_PRE_CLOSURE="$buildDir/refmt_pre_closure" - -REFMT_CLOSURE="$reasonTargetDir/refmt" - -# clean some artifacts -rm -f "$REFMT_CLOSURE.*" -rm -rf $buildDir -mkdir $buildDir - -pushd $THIS_SCRIPT_DIR -# rebuild the project in case it was stale -make clean -C ../ -make pre_release -C ../ -make build -C ../ - -# ============= -# last step for the first task , we're done generating the single file that'll -# be coped over to bucklescript. On BS' side, it'll use a single compile command -# to turn this into a binary, like in -# https://github.com/BuckleScript/bucklescript/blob/2ad2310f18567aa13030cdf32adb007d297ee717/jscomp/bin/Makefile#L29 -# ============= -$BSPACK_EXE \ - -main-export Refmt_impl \ - -prelude-str "$resultStub" \ - -I "$menhirSuggestedLib" \ - -I "$reasonTargetDir" \ - -I "$reasonTargetDir/_build/default/src/ppx/" \ - -I "$reasonTargetDir/_build/default/src/reason-merlin/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/easy_format/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/cmdliner/" \ - -I "$reasonTargetDir/_build/default/src/refmt/" \ - -I "$reasonTargetDir/_build/default/src/refmttype/" \ - -I "$ocamlMigrateParseTreeTargetDir/src" \ - -I "$ocamlMigrateParseTreeTargetDir/ppx_derivers/src" \ - -bs-MD \ - -o "$REFMT_BINARY.ml" - -# ============= -# Now, second task. Packing the repo again but with a new entry file, for JS -# consumption -# ============= - -# this one is left here as an intermediate file for the subsequent steps. We -# disregard the usual entry point that is refmt_impl above (which takes care of -# terminal flags parsing, etc.) and swap it with a new entry point, refmtJsApi (see below) -$BSPACK_EXE \ - -bs-main Reason_toolchain \ - -prelude-str "$resultStub" \ - -prelude "$reasonTargetDir/_build/default/src/refmt/package.ml" \ - -I "$menhirSuggestedLib" \ - -I "$reasonTargetDir/_build/default/src/ppx/" \ - -I "$reasonTargetDir/_build/default/src/reason-merlin/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/easy_format/" \ - -I "$reasonTargetDir/_build/default/src/reason-parser/vendor/cmdliner/" \ - -I "$reasonTargetDir/_build/default/src/refmt/" \ - -I "$reasonTargetDir/_build/default/src/refmttype/" \ - -I "$ocamlMigrateParseTreeTargetDir/src" \ - -I "$ocamlMigrateParseTreeTargetDir/ppx_derivers/src" \ - -bs-MD \ - -o "$REFMT_API.ml" - - -# This hack is required since the emitted code by bspack somehow adds -sed -i'.bak' -e 's/Migrate_parsetree__Ast_408/Migrate_parsetree.Ast_408/' build/*.ml - -# the `-no-alias-deps` flag is important. Not sure why... -# remove warning 40 caused by ocaml-migrate-parsetree -ocamlc -g -no-alias-deps -w -40 -I +compiler-libs ocamlcommon.cma "$REFMT_API.ml" -o "$REFMT_API.byte" - -# build REFMT_BINARY into an actual binary too. For testing purposes at the end -ocamlc -g -no-alias-deps -w -40 -I +compiler-libs ocamlcommon.cma "$REFMT_BINARY.ml" -o "$REFMT_BINARY.byte" From 6f68eecf71a0ad7fa388a01bf21920789311004a Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 17:31:52 -0700 Subject: [PATCH 32/64] feat: build `.bc` executable (#2749) --- dune | 5 +++++ src/refmt/dune | 2 +- src/refmt/{refmt_impl.ml => refmt.ml} | 0 3 files changed, 6 insertions(+), 1 deletion(-) rename src/refmt/{refmt_impl.ml => refmt.ml} (100%) diff --git a/dune b/dune index 4e1cfd734..8654e93f4 100644 --- a/dune +++ b/dune @@ -1 +1,6 @@ (dirs :standard \ node_modules js) + +; (install +; (package reason) +; (section bin) +; (files src/refmt/refmt.bc)) diff --git a/src/refmt/dune b/src/refmt/dune index 70419f88c..97ad91864 100644 --- a/src/refmt/dune +++ b/src/refmt/dune @@ -1,7 +1,7 @@ (executable - (name refmt_impl) (public_name refmt) (package reason) + (modes exe byte) (libraries reason reason.cmdliner dune-build-info)) (rule diff --git a/src/refmt/refmt_impl.ml b/src/refmt/refmt.ml similarity index 100% rename from src/refmt/refmt_impl.ml rename to src/refmt/refmt.ml From 58288788ed63bd9422adc5134786a09a67ba39ca Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 19:35:35 -0700 Subject: [PATCH 33/64] ci: add a Nix CI pipeline (#2751) * add nix ci * add pipeline * start at 4.14 * dont repro that --- .github/workflows/nix-build.yml | 63 +++++++++++++++++++++++ flake.nix | 5 +- nix/ci.nix | 33 ++++++++++++ nix/default.nix | 76 ++++++++++++++++++---------- {src/rtop => rtop}/dune | 0 {src/rtop => rtop}/reason_toploop.ml | 0 {src/rtop => rtop}/reason_util.ml | 0 {src/rtop => rtop}/reason_utop.ml | 0 {src/rtop => rtop}/rtop.ml | 0 test/dune | 10 +++- test/lib/dune | 2 +- 11 files changed, 157 insertions(+), 32 deletions(-) create mode 100644 .github/workflows/nix-build.yml create mode 100644 nix/ci.nix rename {src/rtop => rtop}/dune (100%) rename {src/rtop => rtop}/reason_toploop.ml (100%) rename {src/rtop => rtop}/reason_util.ml (100%) rename {src/rtop => rtop}/reason_utop.ml (100%) rename {src/rtop => rtop}/rtop.ml (100%) diff --git a/.github/workflows/nix-build.yml b/.github/workflows/nix-build.yml new file mode 100644 index 000000000..e0d9c879b --- /dev/null +++ b/.github/workflows/nix-build.yml @@ -0,0 +1,63 @@ +name: Nix Pipeline + +on: + pull_request: + push: + branches: + - main + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +jobs: + ubuntu-tests: + name: Build and test (Ubuntu) + + strategy: + matrix: + ocaml-version: + - 4_14 + - 5_0 + - 5_1 + # - 5_2 + + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + with: + submodules: 'recursive' + - uses: cachix/install-nix-action@v27 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - name: "Run nix-build" + run: nix-build ./nix/ci.nix --argstr ocamlVersion ${{ matrix.ocaml-version }} + + macos-tests: + name: Build and test (${{ matrix.os }}) + + strategy: + matrix: + os: + - macos-13 + - macos-14 + ocaml-version: + - 4_14 + - 5_0 + # - 5_2 + + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v4 + with: + submodules: 'recursive' + - uses: cachix/install-nix-action@v27 + with: + extra_nix_config: | + extra-substituters = https://anmonteiro.nix-cache.workers.dev + extra-trusted-public-keys = ocaml.nix-cache.com-1:/xI2h2+56rwFfKyyFVbkJSeGqSIYMC/Je+7XXqGKDIY= + - name: "Run nix-build" + run: nix-build ./nix/ci.nix --argstr ocamlVersion ${{ matrix.ocaml-version }} + diff --git a/flake.nix b/flake.nix index 2056c8d3f..cca34c441 100644 --- a/flake.nix +++ b/flake.nix @@ -14,11 +14,10 @@ pkgs = nixpkgs.legacyPackages."${system}".extend (self: super: { ocamlPackages = super.ocaml-ng.ocamlPackages_5_2; }); + packages = pkgs.callPackage ./nix { nix-filter = nix-filter.lib; }; in { - packages.default = pkgs.callPackage ./nix { - nix-filter = nix-filter.lib; - }; + packages = packages // { default = packages.reason; }; devShells = { default = pkgs.callPackage ./nix/shell.nix { reason = self.packages.${system}.default; diff --git a/nix/ci.nix b/nix/ci.nix new file mode 100644 index 000000000..31d8bc68b --- /dev/null +++ b/nix/ci.nix @@ -0,0 +1,33 @@ +{ ocamlVersion }: + +let + lock = builtins.fromJSON (builtins.readFile ./../flake.lock); + pkgs = + let + src = fetchGit { + url = with lock.nodes.nixpkgs.locked;"https://github.com/${owner}/${repo}"; + inherit (lock.nodes.nixpkgs.locked) rev; + allRefs = true; + }; + in + import src { + extraOverlays = [ + (self: super: { + ocamlPackages = super.ocaml-ng."ocamlPackages_${ocamlVersion}"; + }) + ]; + }; + nix-filter = import (fetchGit { + url = with lock.nodes.nix-filter.locked; "https://github.com/${owner}/${repo}"; + inherit (lock.nodes.nix-filter.locked) rev; + # inherit (lock.nodes.nixpkgs.original) ref; + allRefs = true; + }); + + inherit (pkgs) callPackage; + +in +callPackage ./. { + doCheck = true; + inherit nix-filter; +} diff --git a/nix/default.nix b/nix/default.nix index 44637b92c..6687a478f 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -1,31 +1,55 @@ -{ ocamlPackages, nix-filter }: - -ocamlPackages.buildDunePackage { - pname = "reason"; - version = "0.0.1-dev"; - - src = nix-filter.filter { - root = ./..; - include = [ - "dune" - "dune-project" - "reason.opam" - "rtop.opam" - "scripts" - "src" - "test" +{ ocamlPackages, nix-filter, doCheck ? false }: + +rec { + reason = ocamlPackages.buildDunePackage { + pname = "reason"; + version = "0.0.1-dev"; + + src = nix-filter.filter { + root = ./..; + include = [ + "dune" + "dune-project" + "reason.opam" + "scripts" + "src" + "test" + ]; + }; + + inherit doCheck; + + nativeBuildInputs = with ocamlPackages; [ cppo menhir ]; + propagatedBuildInputs = with ocamlPackages; [ + merlin-extend + menhirSdk + menhirLib + fix + ppx_derivers + ppxlib + dune-build-info ]; + }; - nativeBuildInputs = with ocamlPackages; [ cppo menhir ]; - propagatedBuildInputs = with ocamlPackages; [ - merlin-extend - menhirSdk - menhirLib - fix - ppx_derivers - ppxlib - dune-build-info - ]; + rtop = ocamlPackages.buildDunePackage { + pname = "rtop"; + version = "0.0.1-dev"; + + src = nix-filter.filter { + root = ./..; + include = [ + "dune" + "dune-project" + "rtop.opam" + "rtop" + "test" + ]; + }; + inherit doCheck; + + nativeBuildInputs = with ocamlPackages; [ cppo ]; + propagatedBuildInputs = [ reason ocamlPackages.utop ]; + }; } diff --git a/src/rtop/dune b/rtop/dune similarity index 100% rename from src/rtop/dune rename to rtop/dune diff --git a/src/rtop/reason_toploop.ml b/rtop/reason_toploop.ml similarity index 100% rename from src/rtop/reason_toploop.ml rename to rtop/reason_toploop.ml diff --git a/src/rtop/reason_util.ml b/rtop/reason_util.ml similarity index 100% rename from src/rtop/reason_util.ml rename to rtop/reason_util.ml diff --git a/src/rtop/reason_utop.ml b/rtop/reason_utop.ml similarity index 100% rename from src/rtop/reason_utop.ml rename to rtop/reason_utop.ml diff --git a/src/rtop/rtop.ml b/rtop/rtop.ml similarity index 100% rename from src/rtop/rtop.ml rename to rtop/rtop.ml diff --git a/test/dune b/test/dune index ce17c8bbe..e42072950 100644 --- a/test/dune +++ b/test/dune @@ -4,5 +4,11 @@ (REFMT_PRINT_WIDTH 50)))) (cram - (applies_to * \ lib) - (deps %{bin:ocamlc} %{bin:refmt} %{bin:outcome_printer} %{bin:rtop})) + (applies_to * \ lib rtopIntegration) + (package reason) + (deps %{bin:ocamlc} %{bin:refmt} %{bin:outcome_printer})) + +(cram + (applies_to rtopIntegration) + (package rtop) + (deps %{bin:ocamlc} %{bin:rtop})) diff --git a/test/lib/dune b/test/lib/dune index dbb434a4a..eadff1d00 100644 --- a/test/lib/dune +++ b/test/lib/dune @@ -7,5 +7,5 @@ (executable (public_name outcome_printer) (name outcometreePrinter) - (package rtop) + (package reason) (libraries reason)) From 2b610ac88d24bb7389172662836689754e47cada Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 21:35:38 -0700 Subject: [PATCH 34/64] fix: rtop on OCaml 5.2 (#2752) * fix: rtop on OCaml 5.2 * revert some things, add cppo to opam files --- dune-project | 4 +++- reason.opam | 1 + rtop.opam | 1 + rtop/dune | 6 ++++++ ...ason_toploop.ml => reason_toploop.cppo.ml} | 16 ++++++++++++++-- test/rtopIntegration.t | 19 ++++++++++--------- 6 files changed, 35 insertions(+), 12 deletions(-) rename rtop/{reason_toploop.ml => reason_toploop.cppo.ml} (63%) diff --git a/dune-project b/dune-project index 8e321b74f..3a9b4ab96 100644 --- a/dune-project +++ b/dune-project @@ -44,6 +44,7 @@ (>= "0.6")) fix ppx_derivers + cppo (ppxlib (>= "0.28.0")))) @@ -60,4 +61,5 @@ (reason (= :version)) (utop - (>= "2.0")))) + (>= "2.0")) + cppo)) diff --git a/reason.opam b/reason.opam index 93cb11124..d66de74ce 100644 --- a/reason.opam +++ b/reason.opam @@ -23,6 +23,7 @@ depends: [ "merlin-extend" {>= "0.6"} "fix" "ppx_derivers" + "cppo" "ppxlib" {>= "0.28.0"} "odoc" {with-doc} ] diff --git a/rtop.opam b/rtop.opam index decac463f..a1182b438 100644 --- a/rtop.opam +++ b/rtop.opam @@ -17,6 +17,7 @@ depends: [ "ocaml" {>= "4.03" & < "5.3"} "reason" {= version} "utop" {>= "2.0"} + "cppo" "odoc" {with-doc} ] build: [ diff --git a/rtop/dune b/rtop/dune index 94e58d3ca..a4d0a88e1 100644 --- a/rtop/dune +++ b/rtop/dune @@ -11,6 +11,12 @@ utop reason.ocaml-migrate-parsetree)) +(rule + (targets reason_toploop.ml) + (deps reason_toploop.cppo.ml) + (action + (run cppo -V OCAML:%{ocaml_version} %{deps} -o %{targets}))) + (executable (name rtop) (public_name rtop) diff --git a/rtop/reason_toploop.ml b/rtop/reason_toploop.cppo.ml similarity index 63% rename from rtop/reason_toploop.ml rename to rtop/reason_toploop.cppo.ml index 623c9ab00..f4bd69d09 100644 --- a/rtop/reason_toploop.ml +++ b/rtop/reason_toploop.cppo.ml @@ -12,8 +12,20 @@ let main () = print_endline "Reason is incompatible with camlp4!" else begin Toploop.parse_toplevel_phrase := Reason_util.correctly_catch_parse_errors - (fun x -> Reason_toolchain.To_current.copy_toplevel_phrase - (Reason_toolchain.RE.toplevel_phrase x)); + (fun x -> + let r = Reason_toolchain.To_current.copy_toplevel_phrase + (Reason_toolchain.RE.toplevel_phrase x) + in +#if OCAML_VERSION >= (5,2,0) +(* NOTE(anmonteiro): after https://github.com/ocaml/ocaml/pull/12029, we get a + + Fatal error: exception Invalid_argument("index out of bounds") + Raised by primitive operation at Toploop.ends_with_lf in file "toplevel/toploop.ml" + + Setting `lex_eof_reached` seems to avoid whatever check upstream is doing. *) + x.lex_eof_reached <- true; +#endif + r); Toploop.parse_use_file := Reason_util.correctly_catch_parse_errors (fun x -> List.map Reason_toolchain.To_current.copy_toplevel_phrase (Reason_toolchain.RE.use_file x)); diff --git a/test/rtopIntegration.t b/test/rtopIntegration.t index 1a70c76a8..8c67e1d1b 100644 --- a/test/rtopIntegration.t +++ b/test/rtopIntegration.t @@ -1,15 +1,16 @@ -# Context: https://github.com/reasonml/reason/pull/674 +Context: https://github.com/reasonml/reason/pull/674 -# We can't directly call `rtop -stdin` because it circumvents what we're trying to -# test. See rtop.sh for the reason. We want to make sure utop's reason -# integration is legit, +We can't directly call `rtop -stdin` because it circumvents what we're trying to +test. See rtop.sh for the reason. We want to make sure utop's reason +integration is legit, -# `utop -stdin` wouldn't work because it somehow processes the code before -# invoking the reason plugin, so `echo someReasonCode | utop -stdin` would -# always error. +`utop -stdin` wouldn't work because it somehow processes the code before +invoking the reason plugin, so `echo someReasonCode | utop -stdin` would +always error. + +Given the above, we're gonna test that utop integration works by piping code +into it and asserting the existence of some output. -# Given the above, we're gonna test that utop integration works by piping code -# into it and asserting the existence of some output. $ echo "let f = a => a;" | rtop | grep -o "let f: 'a => 'a = ;" let f: 'a => 'a = ; From dd64ae2e9d963c4c43ec91867c8d3b2be10d8f0c Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 22:50:26 -0700 Subject: [PATCH 35/64] ci: enable tests on OCaml 5.2 (#2754) --- .github/workflows/nix-build.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/nix-build.yml b/.github/workflows/nix-build.yml index e0d9c879b..df38437f6 100644 --- a/.github/workflows/nix-build.yml +++ b/.github/workflows/nix-build.yml @@ -20,7 +20,7 @@ jobs: - 4_14 - 5_0 - 5_1 - # - 5_2 + - 5_2 runs-on: ubuntu-latest steps: @@ -46,7 +46,7 @@ jobs: ocaml-version: - 4_14 - 5_0 - # - 5_2 + - 5_2 runs-on: ${{ matrix.os }} steps: From 1eea108f71a839abc9896f080257eb06e2209640 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 23:41:42 -0700 Subject: [PATCH 36/64] outcome printer: `@bs` to `@mel` (#2755) * outcome printer: `@bs` to `@mel` * add changelog entry --- CHANGES.md | 1 + src/reason-parser/reason_oprint.ml | 16 +++++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 69a3b6b0a..d97e9a144 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,6 +3,7 @@ - Add `\u{hex-escape}` syntax (@anmonteiro, [#2738](https://github.com/reasonml/reason/pull/2738)) - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) +- outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) ## 3.11.0 diff --git a/src/reason-parser/reason_oprint.ml b/src/reason-parser/reason_oprint.ml index 0951e83b2..5fb0572e8 100644 --- a/src/reason-parser/reason_oprint.ml +++ b/src/reason-parser/reason_oprint.ml @@ -329,7 +329,9 @@ and print_simple_out_type ppf = (* same for `Js.Internal.fn(...)`. Either might shown *) | Otyp_constr ( (Oide_dot ( - (Oide_dot ((Oide_ident { printed_name = "Js" }), "Internal") | Oide_ident { printed_name = "Js_internal" }), + (Oide_dot + ((Oide_ident { printed_name = "Js" }), "Internal") + | Oide_ident { printed_name = "Js_internal" }), ("fn" | "meth" as name) ) as id), ([Otyp_variant(_, Ovar_fields [variant, _, tys], _, _); result] as tyl) @@ -361,7 +363,7 @@ and print_simple_out_type ppf = | res -> begin match name with | "fn" -> print_out_type_1 ~uncurried:true ppf res - | "meth" -> fprintf ppf "@[<0>(%a)@ [@bs.meth]@]" (print_out_type_1 ~uncurried:false) res + | "meth" -> fprintf ppf "@[<0>(%a)@ [@mel.meth]@]" (print_out_type_1 ~uncurried:false) res | _ -> assert false end end @@ -394,7 +396,7 @@ and print_simple_out_type ppf = pp_close_box ppf () end | res -> - fprintf ppf "@[<0>(%a)@ [@bs.this]@]" (print_out_type_1 ~uncurried:false) res + fprintf ppf "@[<0>(%a)@ [@mel.this]@]" (print_out_type_1 ~uncurried:false) res end (* also BuckleScript-specific. Turns Js.t({. foo: bar}) into {. "foo": bar} *) | Otyp_constr ( @@ -703,14 +705,14 @@ and print_out_sig_item ppf = let printAttributes ppf = List.iter (fun a -> fprintf ppf "[@@%s]" a.oattr_name) in let keyword = if oval_prims = [] then "let" else "external" in let (hackyBucklescriptExternalAnnotation, rhsValues) = List.partition (fun item -> - (* "BS:" is considered as a bucklescript external annotation, `[@bs.module]` and the sort. + (* "BS:" is considered as a bucklescript external annotation, `[@mel.module]` and the sort. - "What's going on here? Isn't [@bs.foo] supposed to be an attribute in oval_attributes?" + "What's going on here? Isn't [@mel.foo] supposed to be an attribute in oval_attributes?" Usually yes. But here, we're intercepting things a little too late. BuckleScript already finished its pre/post-processing work before we get to print anything. The original attribute is already gone, replaced by a "BS:asdfasdfasd" thing here. *) - String.length item >= 3 && item.[0] = 'B' && item.[1] = 'S' && item.[2] = ':' + String.length item >= 4 && item.[0] = 'M' && item.[1] = 'E' && item.[1] = 'L' && item.[3] = ':' ) oval_prims in let print_right_hand_side ppf = function @@ -720,7 +722,7 @@ and print_out_sig_item ppf = List.iter (fun s -> fprintf ppf "@ \"%s\"" s) sl in fprintf ppf "@[<2>%a%a%s %a:@ %a%a@]" - (fun ppf -> List.iter (fun _ -> fprintf ppf "[@@bs...]@ ")) hackyBucklescriptExternalAnnotation + (fun ppf -> List.iter (fun _ -> fprintf ppf "[@@mel...]@ ")) hackyBucklescriptExternalAnnotation printAttributes oval_attributes keyword value_ident oval_name From e626622c675e5d9b98ded76aad6cf517ac10a0ef Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 23:56:38 -0700 Subject: [PATCH 37/64] support `external%foo` (#2750) * support `external%foo` * add changelog entry --- CHANGES.md | 1 + src/reason-parser/reason_parser.mly | 22 ++++++++++++++++++---- src/reason-parser/reason_pprint_ast.ml | 9 ++++++--- test/extensions.t/input.re | 6 ++++++ test/extensions.t/run.t | 4 ++++ 5 files changed, 35 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index d97e9a144..9fd8b7551 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ [#2738](https://github.com/reasonml/reason/pull/2738)) - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) +- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) ## 3.11.0 diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 053127a37..868333f33 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1671,13 +1671,27 @@ structure_item: { let (ext_attrs, ext_id) = $2 in struct_item_extension ($1@ext_attrs, ext_id) $3 } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type EQUAL primitive_declaration + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc)) } + let pstr_prim = + mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)) + in + match $3 with + | None -> pstr_prim + | Some ext -> + struct_item_extension ext [pstr_prim] + } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type SEMI + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - mkstr (Pstr_primitive (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc)) } + let pstr_prim = + mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)) + in + match $3 with + | None -> pstr_prim + | Some ext -> + struct_item_extension ext [pstr_prim] + } | type_declarations { let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) } | str_type_extension diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 56be64e88..8b28e3857 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -6725,12 +6725,13 @@ let printer = object(self:'self) * format everything together in a ~postSpace:true (inline, inline) list for nicer breaking *) - method primitive_declaration vd = + method primitive_declaration ?extension vd = + let external_label = add_extension_sugar "external" extension in let lblBefore = label ~space:true (makeList - [(makeList ~postSpace:true [atom "external"; protectIdentifier vd.pval_name.txt]); (atom ":")]) + [(makeList ~postSpace:true [atom external_label; protectIdentifier vd.pval_name.txt]); (atom ":")]) (self#core_type vd.pval_type) in let primDecl = @@ -7608,8 +7609,10 @@ let printer = object(self:'self) match item.pstr_desc with | Pstr_extension ((extension, PStr [item]), attrs) -> begin match item.pstr_desc with - (* In case of a value, the extension gets inlined `let%private a = 1` *) + (* In case of a value or `external`, the extension gets inlined + `let%private a = 1` *) | Pstr_value (rf, vb_list) -> self#bindings ~extension (rf, vb_list) + | Pstr_primitive vd -> self#primitive_declaration ~extension vd | _ -> self#attach_std_item_attrs attrs (self#payload "%%" extension (PStr [item])) end | _ -> self#structure_item item diff --git a/test/extensions.t/input.re b/test/extensions.t/input.re index 2bbeab3c2..483ba2fc2 100644 --- a/test/extensions.t/input.re +++ b/test/extensions.t/input.re @@ -383,3 +383,9 @@ let predicate = /* Attributes shoudn't be inlined and always break */ [@warning "-8"] let a = 3; + +[%%foo external x: int => int = ""]; +[%%foo external x: int => int = "caml_prim"]; +external%foo x: int => int = "caml_prim"; + + diff --git a/test/extensions.t/run.t b/test/extensions.t/run.t index 459bfe2e4..8a883e525 100644 --- a/test/extensions.t/run.t +++ b/test/extensions.t/run.t @@ -385,3 +385,7 @@ Format extensions /* Attributes shoudn't be inlined and always break */ [@warning "-8"] let a = 3; + + external%foo x: int => int; + external%foo x: int => int = "caml_prim"; + external%foo x: int => int = "caml_prim"; From 37fbb2dc7265250fa302fa62febd1024b447fa48 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 7 Jul 2024 23:57:10 -0700 Subject: [PATCH 38/64] fix: outcome printer migration 5.2 -> 5.1 for labeled args (#2753) * fix: outcome printer migration 5.2 -> 5.1 for labeled args * fix rtop error message test on 5.2 * add changelog entry --- CHANGES.md | 1 + src/reason-parser/reason_oprint.ml | 42 +++++++++---------- .../src/migrate_parsetree_51_52_migrate.ml | 11 ++++- .../src/migrate_parsetree_52_51_migrate.ml | 4 +- test/rtopIntegration.t | 4 +- 5 files changed, 34 insertions(+), 28 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 9fd8b7551..ddc0644da 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,7 @@ [#2738](https://github.com/reasonml/reason/pull/2738)) - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) +- Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753)) - support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) ## 3.11.0 diff --git a/src/reason-parser/reason_oprint.ml b/src/reason-parser/reason_oprint.ml index 5fb0572e8..f1d7a9f1c 100644 --- a/src/reason-parser/reason_oprint.ml +++ b/src/reason-parser/reason_oprint.ml @@ -85,7 +85,8 @@ *) open Format -module Outcometree = Reason_omp.Ast_414.Outcometree +module Reason_ast = Reason_omp.Ast_414 +module Outcometree = Reason_ast.Outcometree open Outcometree exception Ellipsis @@ -241,16 +242,26 @@ let pr_present = let pr_vars = print_list (fun ppf s -> fprintf ppf "'%s" s) (fun ppf -> fprintf ppf "@ ") -type label = - | Nonlabeled - | Labeled of string - | Optional of string - let get_label lbl = - if lbl = "" then Nonlabeled + if lbl = "" then Reason_ast.Asttypes.Nolabel else if String.get lbl 0 = '?' then Optional (String.sub lbl 1 @@ String.length lbl - 1) - else Labeled lbl + else Labelled lbl + +let get_arg_suffix ppf lab = + match get_label lab with + | Nolabel -> "" + | Labelled lab -> + pp_print_string ppf "~"; + pp_print_string ppf lab; + pp_print_string ppf ": "; + "" + | Optional lab -> + pp_print_string ppf "~"; + pp_print_string ppf lab; + pp_print_string ppf ": "; + "=?" + let rec print_out_type ppf = function @@ -264,20 +275,7 @@ let rec print_out_type ppf = print_out_type_1 ~uncurried:false ppf ty and print_arg ppf (lab, typ) = - let suffix = - match get_label lab with - | Nonlabeled -> "" - | Labeled lab -> - pp_print_string ppf "~"; - pp_print_string ppf lab; - pp_print_string ppf ": "; - "" - | Optional lab -> - pp_print_string ppf "~"; - pp_print_string ppf lab; - pp_print_string ppf ": "; - "=?" - in + let suffix = get_arg_suffix ppf lab in print_out_type_2 ppf typ; pp_print_string ppf suffix; diff --git a/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml b/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml index d2d31a076..a0c66bf62 100644 --- a/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_51_52_migrate.ml @@ -1,6 +1,13 @@ open Stdlib0 module From = Ast_51 module To = Ast_52 + +let get_label lbl = + if lbl = "" then Ast_52.Asttypes.Nolabel + else if String.get lbl 0 = '?' then + Optional (String.sub lbl 1 @@ String.length lbl - 1) + else Labelled lbl + let rec copy_out_type_extension : Ast_51.Outcometree.out_type_extension -> Ast_52.Outcometree.out_type_extension @@ -170,7 +177,7 @@ and copy_out_class_type : ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_51.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_52.Outcometree.Octy_arrow - ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_class_type x2)) + (get_label x0, (copy_out_type x1), (copy_out_class_type x2)) | Ast_51.Outcometree.Octy_signature (x0, x1) -> Ast_52.Outcometree.Octy_signature ((Option.map copy_out_type x0), @@ -218,7 +225,7 @@ and copy_out_type : | Ast_51.Outcometree.Otyp_open -> Ast_52.Outcometree.Otyp_open | Ast_51.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_52.Outcometree.Otyp_arrow - ((if x0 = "" then Nolabel else Labelled x0), (copy_out_type x1), (copy_out_type x2)) + (get_label x0, (copy_out_type x1), (copy_out_type x2)) | Ast_51.Outcometree.Otyp_class (x0, x1) -> Ast_52.Outcometree.Otyp_class ((copy_out_ident x0), (List.map copy_out_type x1)) diff --git a/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml b/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml index cce254369..a8ec5b84a 100644 --- a/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml +++ b/src/vendored-omp/src/migrate_parsetree_52_51_migrate.ml @@ -170,7 +170,7 @@ and copy_out_class_type : ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_52.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_51.Outcometree.Octy_arrow - ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_class_type x2)) + ((match x0 with Nolabel -> "" | Labelled s -> s | Optional s -> "?" ^ s), (copy_out_type x1), (copy_out_class_type x2)) | Ast_52.Outcometree.Octy_signature (x0, x1) -> Ast_51.Outcometree.Octy_signature ((Option.map copy_out_type x0), @@ -216,7 +216,7 @@ and copy_out_type : Ast_51.Outcometree.Otyp_alias {non_gen; aliased=(copy_out_type x0); alias=x1} | Ast_52.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_51.Outcometree.Otyp_arrow - ((match x0 with Nolabel -> "" | Labelled s | Optional s -> s), (copy_out_type x1), (copy_out_type x2)) + ((match x0 with Nolabel -> "" | Labelled s -> s | Optional s -> "?" ^ s), (copy_out_type x1), (copy_out_type x2)) | Ast_52.Outcometree.Otyp_class (x0, x1) -> Ast_51.Outcometree.Otyp_class ((copy_out_ident x0), (List.map copy_out_type x1)) diff --git a/test/rtopIntegration.t b/test/rtopIntegration.t index 8c67e1d1b..4a7763673 100644 --- a/test/rtopIntegration.t +++ b/test/rtopIntegration.t @@ -14,5 +14,5 @@ into it and asserting the existence of some output. $ echo "let f = a => a;" | rtop | grep -o "let f: 'a => 'a = ;" let f: 'a => 'a = ; - $ echo "let f = (a) => 1 + \"hi\";" | rtop | grep -o "This expression has type string but an expression was expected of type" - This expression has type string but an expression was expected of type + $ echo "let f = (a) => 1 + \"hi\";" | rtop | grep -o "This expression has type" + This expression has type From fb0b60c54d8c34f6843416b36913ea9f8d80ffbc Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 19 Jul 2024 20:52:22 -0700 Subject: [PATCH 39/64] fix: disable menhir deprecations (#2758) * fix: disable menhir deprecations * wip --- .github/workflows/opam-ci.yml | 2 +- src/menhir-recover/main.ml | 2 +- src/menhir-recover/synthesis.ml | 2 +- src/reason-parser/menhir_error_processor.ml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/opam-ci.yml b/.github/workflows/opam-ci.yml index 719d3e0ae..2497fb84f 100644 --- a/.github/workflows/opam-ci.yml +++ b/.github/workflows/opam-ci.yml @@ -64,7 +64,7 @@ jobs: run: opam exec -- dune build -p reason,rtop - name: Test - run: opam exec -- dune runtest + run: opam exec -- dune runtest -p reason,rtop - name: Save cache when not Windows uses: actions/cache/save@v3 diff --git a/src/menhir-recover/main.ml b/src/menhir-recover/main.ml index b8eb09f72..f04d49b9d 100644 --- a/src/menhir-recover/main.ml +++ b/src/menhir-recover/main.ml @@ -42,7 +42,7 @@ let () = fprintf ppf " - on %a, reduce %d:\n %a\n" Print.terminal t (p :> int) Print.production p - ) (Lr1.reductions st); + ) (Lr1.reductions st [@alert "-deprecated"]); ); Production.iter (fun (p : production) -> fprintf ppf "\n# Production p%d\n%a" diff --git a/src/menhir-recover/synthesis.ml b/src/menhir-recover/synthesis.ml index b27ebf833..440495380 100644 --- a/src/menhir-recover/synthesis.ml +++ b/src/menhir-recover/synthesis.ml @@ -197,7 +197,7 @@ struct const bottom else if pos = prod_len then let can_reduce = List.exists - (fun (_,prods) -> List.mem prod prods) (Lr1.reductions st) + (fun (_,prods) -> List.mem prod prods) (Lr1.reductions st [@alert "-deprecated"]) in const (if can_reduce then (cost_of_prod prod, [Reduce prod]) diff --git a/src/reason-parser/menhir_error_processor.ml b/src/reason-parser/menhir_error_processor.ml index 6fddf3d9e..84b4eee87 100644 --- a/src/reason-parser/menhir_error_processor.ml +++ b/src/reason-parser/menhir_error_processor.ml @@ -28,7 +28,7 @@ let states_transitioning_on pred = let keep_state lr1 = (* There are two kind of transitions (leading to SHIFT or REDUCE), detect those who accept identifiers *) - List.exists (fun (term, _) -> pred (T term)) (Lr1.reductions lr1) || + List.exists (fun (term, _) -> pred (T term)) (Lr1.reductions lr1 [@alert "-deprecated"]) || List.exists (fun (sym, _) -> pred sym) (Lr1.transitions lr1) in (* Now we filter the list of all states and keep the interesting ones *) From 7fe8a14b9c98379314adef4979adff55a6b3cfc5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Fri, 19 Jul 2024 21:59:39 -0700 Subject: [PATCH 40/64] remove lexer literal_overflow (#2757) * remove lexer literal_overflow * add a test --- src/reason-parser/reason_errors.ml | 4 ---- src/reason-parser/reason_errors.mli | 1 - test/basics.t/input.re | 4 ++-- test/general-syntax-re.t/input.re | 6 ++++++ test/general-syntax-re.t/run.t | 5 +++++ 5 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/reason-parser/reason_errors.ml b/src/reason-parser/reason_errors.ml index e5ea39342..89d2d74e9 100644 --- a/src/reason-parser/reason_errors.ml +++ b/src/reason-parser/reason_errors.ml @@ -20,7 +20,6 @@ type lexing_error = | Unterminated_string | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string - | Literal_overflow of string | Invalid_literal of string type ast_error = @@ -79,9 +78,6 @@ let format_lexing_error ppf = function Ocaml_util.print_loc loc | Keyword_as_label kwd -> fprintf ppf "`%s' is a keyword, it cannot be used as label name" kwd - | Literal_overflow ty -> - fprintf ppf "Integer literal exceeds the range of representable \ - integers of type %s" ty | Invalid_literal s -> fprintf ppf "Invalid literal %s" s diff --git a/src/reason-parser/reason_errors.mli b/src/reason-parser/reason_errors.mli index b9f7b8489..2a8ac2e6c 100644 --- a/src/reason-parser/reason_errors.mli +++ b/src/reason-parser/reason_errors.mli @@ -17,7 +17,6 @@ type lexing_error = | Unterminated_string | Unterminated_string_in_comment of Location.t * Location.t | Keyword_as_label of string - | Literal_overflow of string | Invalid_literal of string type ast_error = diff --git a/test/basics.t/input.re b/test/basics.t/input.re index 18ef43ad9..3b9921f7c 100644 --- a/test/basics.t/input.re +++ b/test/basics.t/input.re @@ -29,9 +29,9 @@ let l2 = let argIsUnderscore1 = _ => 34; let argIsUnderscore2 = (_ => 34); - + let argIsUnderscore3 = _ : int => 34; - + let argIsUnderscore4 = (_ : int => 34); let argIsUnderscore5 = (_: int) => 34; diff --git a/test/general-syntax-re.t/input.re b/test/general-syntax-re.t/input.re index a579f2f01..7fc15217d 100644 --- a/test/general-syntax-re.t/input.re +++ b/test/general-syntax-re.t/input.re @@ -1276,3 +1276,9 @@ class y = { open OM; as self; }; + +// Arbitrary precision literals + +let x = 1G; +let x = 1.123g; + diff --git a/test/general-syntax-re.t/run.t b/test/general-syntax-re.t/run.t index 2d62820ef..83fbf6c70 100644 --- a/test/general-syntax-re.t/run.t +++ b/test/general-syntax-re.t/run.t @@ -1462,3 +1462,8 @@ Format general implementation syntax open OM; as self; }; + + // Arbitrary precision literals + + let x = 1G; + let x = 1.123g; From 1c5a499e92737c1a3a60d4bca1e52548e0064561 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 19:05:09 -0700 Subject: [PATCH 41/64] update vendored cmdliner (#2759) * update vendored cmdliner * fix * fix for 4.06 * more 4.06 fixes * wip * more * more --- .../vendor/cmdliner/cmdliner_arg.ml | 361 ++++ .../vendor/cmdliner/cmdliner_arg.mli | 98 + .../vendor/cmdliner/cmdliner_base.ml | 341 ++++ .../vendor/cmdliner/cmdliner_base.mli | 60 + .../vendor/cmdliner/cmdliner_cline.ml | 203 ++ .../vendor/cmdliner/cmdliner_cline.mli | 20 + .../vendor/cmdliner/cmdliner_cmd.ml | 30 + .../vendor/cmdliner/cmdliner_cmd.mli | 24 + .../vendor/cmdliner/cmdliner_docgen.ml | 395 ++++ .../vendor/cmdliner/cmdliner_docgen.mli | 11 + .../vendor/cmdliner/cmdliner_eval.ml | 282 +++ .../vendor/cmdliner/cmdliner_eval.mli | 50 + .../vendor/cmdliner/cmdliner_exit.ml | 4 + .../vendor/cmdliner/cmdliner_exit.mli | 4 + .../vendor/cmdliner/cmdliner_info.ml | 225 +++ .../vendor/cmdliner/cmdliner_info.mli | 139 ++ .../vendor/cmdliner/cmdliner_manpage.ml | 527 +++++ .../vendor/cmdliner/cmdliner_manpage.mli | 84 + .../vendor/cmdliner/cmdliner_msg.ml | 106 + .../vendor/cmdliner/cmdliner_msg.mli | 40 + .../vendor/cmdliner/cmdliner_term.ml | 95 + .../vendor/cmdliner/cmdliner_term.mli | 45 + .../cmdliner/cmdliner_term_deprecated.ml | 77 + .../vendor/cmdliner/cmdliner_trie.ml | 80 + .../vendor/cmdliner/cmdliner_trie.mli | 18 + src/reason-parser/vendor/cmdliner/dune | 5 +- .../vendor/cmdliner/vendored_cmdliner.ml | 1458 +------------- .../vendor/cmdliner/vendored_cmdliner.mli | 1712 ++++++++--------- src/refmt/refmt.ml | 12 +- src/refmt/refmt_args.ml | 6 +- test/comments-ml.t/run.t | 6 +- 31 files changed, 4176 insertions(+), 2342 deletions(-) create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_arg.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_arg.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_base.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_base.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_cline.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_cline.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_cmd.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_cmd.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_docgen.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_docgen.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_eval.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_eval.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_exit.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_exit.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_info.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_info.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_manpage.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_manpage.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_msg.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_msg.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_term.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_term.mli create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_term_deprecated.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_trie.ml create mode 100644 src/reason-parser/vendor/cmdliner/cmdliner_trie.mli diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_arg.ml b/src/reason-parser/vendor/cmdliner/cmdliner_arg.ml new file mode 100644 index 000000000..c6ae9e996 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_arg.ml @@ -0,0 +1,361 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let rev_compare n0 n1 = compare n1 n0 + +(* Invalid_argument strings **) + +let err_not_opt = "Option argument without name" +let err_not_pos = "Positional argument with a name" + +(* Documentation formatting helpers *) + +let strf = Printf.sprintf +let doc_quote = Cmdliner_base.quote +let doc_alts = Cmdliner_base.alts_str +let doc_alts_enum ?quoted enum = doc_alts ?quoted (List.map fst enum) + +let str_of_pp pp v = pp Format.str_formatter v; Format.flush_str_formatter () + +(* Argument converters *) + +type 'a parser = string -> [ `Ok of 'a | `Error of string ] +type 'a printer = Format.formatter -> 'a -> unit + +type 'a conv = 'a parser * 'a printer +type 'a converter = 'a conv + +let default_docv = "VALUE" +let conv ?docv (parse, print) = + let parse s = match parse s with Ok v -> `Ok v | Error (`Msg e) -> `Error e in + parse, print + +let conv' ?docv (parse, print) = + let parse s = match parse s with Ok v -> `Ok v | Error e -> `Error e in + parse, print + +let pconv ?docv conv = conv + +let conv_parser (parse, _) = + fun s -> match parse s with `Ok v -> Ok v | `Error e -> Error (`Msg e) + +let conv_printer (_, print) = print +let conv_docv _ = default_docv + +let err_invalid s kind = `Msg (strf "invalid value '%s', expected %s" s kind) +let parser_of_kind_of_string ~kind k_of_string = + fun s -> match k_of_string s with + | None -> Error (err_invalid s kind) + | Some v -> Ok v + +let some = Cmdliner_base.some +let some' = Cmdliner_base.some' + +(* Argument information *) + +type env = Cmdliner_info.Env.info +let env_var = Cmdliner_info.Env.info + +type 'a t = 'a Cmdliner_term.t +type info = Cmdliner_info.Arg.t +let info = Cmdliner_info.Arg.v + +(* Arguments *) + +let ( & ) f x = f x + +let err e = Error (`Parse e) + +let parse_to_list parser s = match parser s with +| `Ok v -> `Ok [v] +| `Error _ as e -> e + +let report_deprecated_env ei e = match Cmdliner_info.Env.info_deprecated e with +| None -> () +| Some msg -> + let var = Cmdliner_info.Env.info_var e in + let msg = String.concat "" ["environment variable "; var; ": "; msg ] in + let err_fmt = Cmdliner_info.Eval.err_ppf ei in + Cmdliner_msg.pp_err err_fmt ei ~err:msg + +let try_env ei a parse ~absent = match Cmdliner_info.Arg.env a with +| None -> Ok absent +| Some env -> + let var = Cmdliner_info.Env.info_var env in + match Cmdliner_info.Eval.env_var ei var with + | None -> Ok absent + | Some v -> + match parse v with + | `Error e -> err (Cmdliner_msg.err_env_parse env ~err:e) + | `Ok v -> report_deprecated_env ei env; Ok v + +let arg_to_args = Cmdliner_info.Arg.Set.singleton +let list_to_args f l = + let add acc v = Cmdliner_info.Arg.Set.add (f v) acc in + List.fold_left add Cmdliner_info.Arg.Set.empty l + +let flag a = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let convert ei cl = match Cmdliner_cline.opt_arg cl a with + | [] -> try_env ei a Cmdliner_base.env_bool_parse ~absent:false + | [_, _, None] -> Ok true + | [_, f, Some v] -> err (Cmdliner_msg.err_flag_value f v) + | (_, f, _) :: (_ ,g, _) :: _ -> err (Cmdliner_msg.err_opt_repeated f g) + in + arg_to_args a, convert + +let flag_all a = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let a = Cmdliner_info.Arg.make_all_opts a in + let convert ei cl = match Cmdliner_cline.opt_arg cl a with + | [] -> + try_env ei a (parse_to_list Cmdliner_base.env_bool_parse) ~absent:[] + | l -> + try + let truth (_, f, v) = match v with + | None -> true + | Some v -> failwith (Cmdliner_msg.err_flag_value f v) + in + Ok (List.rev_map truth l) + with Failure e -> err e + in + arg_to_args a, convert + +let vflag v l = + let convert _ cl = + let rec aux fv = function + | (v, a) :: rest -> + begin match Cmdliner_cline.opt_arg cl a with + | [] -> aux fv rest + | [_, f, None] -> + begin match fv with + | None -> aux (Some (f, v)) rest + | Some (g, _) -> failwith (Cmdliner_msg.err_opt_repeated g f) + end + | [_, f, Some v] -> failwith (Cmdliner_msg.err_flag_value f v) + | (_, f, _) :: (_, g, _) :: _ -> + failwith (Cmdliner_msg.err_opt_repeated g f) + end + | [] -> match fv with None -> v | Some (_, v) -> v + in + try Ok (aux None l) with Failure e -> err e + in + let flag (_, a) = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else a + in + list_to_args flag l, convert + +let vflag_all v l = + let convert _ cl = + let rec aux acc = function + | (fv, a) :: rest -> + begin match Cmdliner_cline.opt_arg cl a with + | [] -> aux acc rest + | l -> + let fval (k, f, v) = match v with + | None -> (k, fv) + | Some v -> failwith (Cmdliner_msg.err_flag_value f v) + in + aux (List.rev_append (List.rev_map fval l) acc) rest + end + | [] -> + if acc = [] then v else List.rev_map snd (List.sort rev_compare acc) + in + try Ok (aux [] l) with Failure e -> err e + in + let flag (_, a) = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + Cmdliner_info.Arg.make_all_opts a + in + list_to_args flag l, convert + +let parse_opt_value parse f v = match parse v with +| `Ok v -> v +| `Error err -> failwith (Cmdliner_msg.err_opt_parse f ~err) + +let opt ?vopt (parse, print) v a = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in + let kind = match vopt with + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) + in + let a = Cmdliner_info.Arg.make_opt ~absent ~kind a in + let convert ei cl = match Cmdliner_cline.opt_arg cl a with + | [] -> try_env ei a parse ~absent:v + | [_, f, Some v] -> + (try Ok (parse_opt_value parse f v) with Failure e -> err e) + | [_, f, None] -> + begin match vopt with + | None -> err (Cmdliner_msg.err_opt_value_missing f) + | Some optv -> Ok optv + end + | (_, f, _) :: (_, g, _) :: _ -> err (Cmdliner_msg.err_opt_repeated g f) + in + arg_to_args a, convert + +let opt_all ?vopt (parse, print) v a = + if Cmdliner_info.Arg.is_pos a then invalid_arg err_not_opt else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy "") + in + let kind = match vopt with + | None -> Cmdliner_info.Arg.Opt + | Some dv -> Cmdliner_info.Arg.Opt_vopt (str_of_pp print dv) + in + let a = Cmdliner_info.Arg.make_opt_all ~absent ~kind a in + let convert ei cl = match Cmdliner_cline.opt_arg cl a with + | [] -> try_env ei a (parse_to_list parse) ~absent:v + | l -> + let parse (k, f, v) = match v with + | Some v -> (k, parse_opt_value parse f v) + | None -> match vopt with + | None -> failwith (Cmdliner_msg.err_opt_value_missing f) + | Some dv -> (k, dv) + in + try Ok (List.rev_map snd + (List.sort rev_compare (List.rev_map parse l))) with + | Failure e -> err e + in + arg_to_args a, convert + +(* Positional arguments *) + +let parse_pos_value parse a v = match parse v with +| `Ok v -> v +| `Error err -> failwith (Cmdliner_msg.err_pos_parse a ~err) + +let pos ?(rev = false) k (parse, print) v a = + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Doc d as a when d <> "" -> a + | _ -> Cmdliner_info.Arg.Val (lazy (str_of_pp print v)) + in + let pos = Cmdliner_info.Arg.pos ~rev ~start:k ~len:(Some 1) in + let a = Cmdliner_info.Arg.make_pos_abs ~absent ~pos a in + let convert ei cl = match Cmdliner_cline.pos_arg cl a with + | [] -> try_env ei a parse ~absent:v + | [v] -> + (try Ok (parse_pos_value parse a v) with Failure e -> err e) + | _ -> assert false + in + arg_to_args a, convert + +let pos_list pos (parse, _) v a = + if Cmdliner_info.Arg.is_opt a then invalid_arg err_not_pos else + let a = Cmdliner_info.Arg.make_pos ~pos a in + let convert ei cl = match Cmdliner_cline.pos_arg cl a with + | [] -> try_env ei a (parse_to_list parse) ~absent:v + | l -> + try Ok (List.rev (List.rev_map (parse_pos_value parse a) l)) with + | Failure e -> err e + in + arg_to_args a, convert + +let all = Cmdliner_info.Arg.pos ~rev:false ~start:0 ~len:None +let pos_all c v a = pos_list all c v a + +let pos_left ?(rev = false) k = + let start = if rev then k + 1 else 0 in + let len = if rev then None else Some k in + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) + +let pos_right ?(rev = false) k = + let start = if rev then 0 else k + 1 in + let len = if rev then Some k else None in + pos_list (Cmdliner_info.Arg.pos ~rev ~start ~len) + +(* Arguments as terms *) + +let absent_error args = + let make_req a acc = + let req_a = Cmdliner_info.Arg.make_req a in + Cmdliner_info.Arg.Set.add req_a acc + in + Cmdliner_info.Arg.Set.fold make_req args Cmdliner_info.Arg.Set.empty + +let value a = a + +let err_arg_missing args = + err @@ Cmdliner_msg.err_arg_missing (Cmdliner_info.Arg.Set.choose args) + +let required (args, convert) = + let args = absent_error args in + let convert ei cl = match convert ei cl with + | Ok (Some v) -> Ok v + | Ok None -> err_arg_missing args + | Error _ as e -> e + in + args, convert + +let non_empty (al, convert) = + let args = absent_error al in + let convert ei cl = match convert ei cl with + | Ok [] -> err_arg_missing args + | Ok l -> Ok l + | Error _ as e -> e + in + args, convert + +let last (args, convert) = + let convert ei cl = match convert ei cl with + | Ok [] -> err_arg_missing args + | Ok l -> Ok (List.hd (List.rev l)) + | Error _ as e -> e + in + args, convert + +(* Predefined arguments *) + +let man_fmts = + ["auto", `Auto; "pager", `Pager; "groff", `Groff; "plain", `Plain] + +let man_fmt_docv = "FMT" +let man_fmts_enum = Cmdliner_base.enum man_fmts +let man_fmts_alts = doc_alts_enum man_fmts +let man_fmts_doc kind = + strf "Show %s in format $(docv). The value $(docv) must be %s. \ + With $(b,auto), the format is $(b,pager) or $(b,plain) whenever \ + the $(b,TERM) env var is $(b,dumb) or undefined." + kind man_fmts_alts + +let man_format = + let doc = man_fmts_doc "output" in + let docv = man_fmt_docv in + value & opt man_fmts_enum `Pager & info ["man-format"] ~docv ~doc + +let stdopt_version ~docs = + value & flag & info ["version"] ~docs ~doc:"Show version information." + +let stdopt_help ~docs = + let doc = man_fmts_doc "this help" in + let docv = man_fmt_docv in + value & opt ~vopt:(Some `Auto) (some man_fmts_enum) None & + info ["help"] ~docv ~docs ~doc + +(* Predefined converters. *) + +let bool = Cmdliner_base.bool +let char = Cmdliner_base.char +let int = Cmdliner_base.int +let nativeint = Cmdliner_base.nativeint +let int32 = Cmdliner_base.int32 +let int64 = Cmdliner_base.int64 +let float = Cmdliner_base.float +let string = Cmdliner_base.string +let enum = Cmdliner_base.enum +let file = Cmdliner_base.file +let dir = Cmdliner_base.dir +let non_dir_file = Cmdliner_base.non_dir_file +let list = Cmdliner_base.list +let array = Cmdliner_base.array +let pair = Cmdliner_base.pair +let t2 = Cmdliner_base.t2 +let t3 = Cmdliner_base.t3 +let t4 = Cmdliner_base.t4 diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_arg.mli b/src/reason-parser/vendor/cmdliner/cmdliner_arg.mli new file mode 100644 index 000000000..1166b13b4 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_arg.mli @@ -0,0 +1,98 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command line arguments as terms. *) + +type 'a parser = string -> [ `Ok of 'a | `Error of string ] +type 'a printer = Format.formatter -> 'a -> unit +type 'a conv = 'a parser * 'a printer +type 'a converter = 'a conv + +val conv : + ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> + 'a conv + +val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> 'a conv + +val pconv : ?docv:string -> 'a parser * 'a printer -> 'a conv +val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) +val conv_printer : 'a conv -> 'a printer +val conv_docv : 'a conv -> string + +val parser_of_kind_of_string : + kind:string -> (string -> 'a option) -> + (string -> ('a, [`Msg of string]) result) + +val some : ?none:string -> 'a converter -> 'a option converter +val some' : ?none:'a -> 'a converter -> 'a option converter + +type env = Cmdliner_info.Env.info +val env_var : ?deprecated:string -> ?docs:string -> ?doc:string -> string -> env + +type 'a t = 'a Cmdliner_term.t + +type info +val info : + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:env -> string list -> info + +val ( & ) : ('a -> 'b) -> 'a -> 'b + +val flag : info -> bool t +val flag_all : info -> bool list t +val vflag : 'a -> ('a * info) list -> 'a t +val vflag_all : 'a list -> ('a * info) list -> 'a list t +val opt : ?vopt:'a -> 'a converter -> 'a -> info -> 'a t +val opt_all : ?vopt:'a -> 'a converter -> 'a list -> info -> 'a list t + +val pos : ?rev:bool -> int -> 'a converter -> 'a -> info -> 'a t +val pos_all : 'a converter -> 'a list -> info -> 'a list t +val pos_left : ?rev:bool -> int -> 'a converter -> 'a list -> info -> 'a list t +val pos_right : ?rev:bool -> int -> 'a converter -> 'a list -> info -> 'a list t + +(** {1 As terms} *) + +val value : 'a t -> 'a Cmdliner_term.t +val required : 'a option t -> 'a Cmdliner_term.t +val non_empty : 'a list t -> 'a list Cmdliner_term.t +val last : 'a list t -> 'a Cmdliner_term.t + +(** {1 Predefined arguments} *) + +val man_format : Cmdliner_manpage.format Cmdliner_term.t +val stdopt_version : docs:string -> bool Cmdliner_term.t +val stdopt_help : docs:string -> Cmdliner_manpage.format option Cmdliner_term.t + +(** {1 Converters} *) + +val bool : bool converter +val char : char converter +val int : int converter +val nativeint : nativeint converter +val int32 : int32 converter +val int64 : int64 converter +val float : float converter +val string : string converter +val enum : (string * 'a) list -> 'a converter +val file : string converter +val dir : string converter +val non_dir_file : string converter +val list : ?sep:char -> 'a converter -> 'a list converter +val array : ?sep:char -> 'a converter -> 'a array converter +val pair : ?sep:char -> 'a converter -> 'b converter -> ('a * 'b) converter +val t2 : ?sep:char -> 'a converter -> 'b converter -> ('a * 'b) converter + +val t3 : + ?sep:char -> 'a converter ->'b converter -> 'c converter -> + ('a * 'b * 'c) converter + +val t4 : + ?sep:char -> 'a converter ->'b converter -> 'c converter -> 'd converter -> + ('a * 'b * 'c * 'd) converter + +val doc_quote : string -> string +val doc_alts : ?quoted:bool -> string list -> string +val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_base.ml b/src/reason-parser/vendor/cmdliner/cmdliner_base.ml new file mode 100644 index 000000000..f1c659ca8 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_base.ml @@ -0,0 +1,341 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let strf = Printf.sprintf + +(* Unique ids *) + +let uid = + (* Thread-safe UIDs, Oo.id (object end) was used before. + Note this won't be thread-safe in multicore, we should use + Atomic but this is >= 4.12 and we have 4.08 for now. *) + let c = ref 0 in + fun () -> + let id = !c in + incr c; if id > !c then assert false (* too many ids *) else id + +(* Edit distance *) + +let edit_distance s0 s1 = + let minimum (a : int) (b : int) (c : int) : int = min a (min b c) in + let s0,s1 = if String.length s0 <= String.length s1 then s0,s1 else s1,s0 in + let m = String.length s0 and n = String.length s1 in + let rec rows row0 row i = match i > n with + | true -> row0.(m) + | false -> + row.(0) <- i; + for j = 1 to m do + if s0.[j - 1] = s1.[i - 1] then row.(j) <- row0.(j - 1) else + row.(j) <- minimum (row0.(j - 1) + 1) (row0.(j) + 1) (row.(j - 1) + 1) + done; + rows row row0 (i + 1) + in + rows (Array.init (m + 1) (fun x -> x)) (Array.make (m + 1) 0) 1 + +let suggest s candidates = + let add (min, acc) name = + let d = edit_distance s name in + if d = min then min, (name :: acc) else + if d < min then d, [name] else + min, acc + in + let dist, suggs = List.fold_left add (max_int, []) candidates in + if dist < 3 (* suggest only if not too far *) then suggs else [] + +(* Invalid argument strings *) + +let err_empty_list = "empty list" +let err_incomplete_enum ss = + strf "Arg.enum: missing printable string for a value, other strings are: %s" + (String.concat ", " ss) + +(* Formatting tools *) + +let pp = Format.fprintf +let pp_sp = Format.pp_print_space +let pp_str = Format.pp_print_string +let pp_char = Format.pp_print_char +let pp_text = Format.pp_print_text +let pp_lines ppf s = + let rec stop_at sat ~start ~max s = + if start > max then start else + if sat s.[start] then start else + stop_at sat ~start:(start + 1) ~max s + in + let sub s start stop ~max = + if start = stop then "" else + if start = 0 && stop > max then s else + String.sub s start (stop - start) + in + let is_nl c = c = '\n' in + let max = String.length s - 1 in + let rec loop start s = match stop_at is_nl ~start ~max s with + | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) + | stop -> + Format.pp_print_string ppf (sub s start stop ~max); + Format.pp_force_newline ppf (); + loop (stop + 1) s + in + loop 0 s + +let pp_tokens ~spaces ppf s = (* collapse white and hint spaces (maybe) *) + let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false in + let i_max = String.length s - 1 in + let flush start stop = pp_str ppf (String.sub s start (stop - start + 1)) in + let rec skip_white i = + if i > i_max then i else + if is_space s.[i] then skip_white (i + 1) else i + in + let rec loop start i = + if i > i_max then flush start i_max else + if not (is_space s.[i]) then loop start (i + 1) else + let next_start = skip_white i in + (flush start (i - 1); if spaces then pp_sp ppf () else pp_char ppf ' '; + if next_start > i_max then () else loop next_start next_start) + in + loop 0 0 + +(* Converter (end-user) error messages *) + +let quote s = strf "'%s'" s +let alts_str ?quoted alts = + let quote = match quoted with + | None -> strf "$(b,%s)" + | Some quoted -> if quoted then quote else (fun s -> s) + in + match alts with + | [] -> invalid_arg err_empty_list + | [a] -> (quote a) + | [a; b] -> strf "either %s or %s" (quote a) (quote b) + | alts -> + let rev_alts = List.rev alts in + strf "one of %s or %s" + (String.concat ", " (List.rev_map quote (List.tl rev_alts))) + (quote (List.hd rev_alts)) + +let err_multi_def ~kind name doc v v' = + strf "%s %s defined twice (doc strings are '%s' and '%s')" + kind name (doc v) (doc v') + +let err_ambiguous ~kind s ~ambs = + strf "%s %s ambiguous and could be %s" kind (quote s) + (alts_str ~quoted:true ambs) + +let err_unknown ?(dom = []) ?(hints = []) ~kind v = + let hints = match hints, dom with + | [], [] -> "." + | [], dom -> strf ", must be %s." (alts_str ~quoted:true dom) + | hints, _ -> strf ", did you mean %s?" (alts_str ~quoted:true hints) + in + strf "unknown %s %s%s" kind (quote v) hints + +let err_no kind s = strf "no %s %s" (quote s) kind +let err_not_dir s = strf "%s is not a directory" (quote s) +let err_is_dir s = strf "%s is a directory" (quote s) +let err_element kind s exp = + strf "invalid element in %s ('%s'): %s" kind s exp + +let err_invalid kind s exp = strf "invalid %s %s, %s" kind (quote s) exp +let err_invalid_val = err_invalid "value" +let err_sep_miss sep s = + err_invalid_val s (strf "missing a '%c' separator" sep) + +(* Converters *) + +type 'a parser = string -> [ `Ok of 'a | `Error of string ] +type 'a printer = Format.formatter -> 'a -> unit +type 'a conv = 'a parser * 'a printer + +let some ?(none = "") (parse, print) = + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in + let print ppf v = match v with + | None -> Format.pp_print_string ppf none + | Some v -> print ppf v + in + parse, print + +let some' ?none (parse, print) = + let parse s = match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e in + let print ppf = function + | None -> (match none with None -> () | Some v -> print ppf v) + | Some v -> print ppf v + in + parse, print + +let bool = + let parse s = try `Ok (bool_of_string s) with + | Invalid_argument _ -> + `Error (err_invalid_val s (alts_str ~quoted:true ["true"; "false"])) + in + parse, Format.pp_print_bool + +let char = + let parse s = match String.length s = 1 with + | true -> `Ok s.[0] + | false -> `Error (err_invalid_val s "expected a character") + in + parse, pp_char + +let parse_with t_of_str exp s = + try `Ok (t_of_str s) with Failure _ -> `Error (err_invalid_val s exp) + +let int = + parse_with int_of_string "expected an integer", Format.pp_print_int + +let int32 = + parse_with Int32.of_string "expected a 32-bit integer", + (fun ppf -> pp ppf "%ld") + +let int64 = + parse_with Int64.of_string "expected a 64-bit integer", + (fun ppf -> pp ppf "%Ld") + +let nativeint = + parse_with Nativeint.of_string "expected a processor-native integer", + (fun ppf -> pp ppf "%nd") + +let float = + parse_with float_of_string "expected a floating point number", + Format.pp_print_float + +let string = (fun s -> `Ok s), pp_str +let enum sl = + if sl = [] then invalid_arg err_empty_list else + let t = Cmdliner_trie.of_list sl in + let parse s = match Cmdliner_trie.find t s with + | `Ok _ as r -> r + | `Ambiguous -> + let ambs = List.sort compare (Cmdliner_trie.ambiguities t s) in + `Error (err_ambiguous ~kind:"enum value" s ~ambs) + | `Not_found -> + let alts = List.rev (List.rev_map (fun (s, _) -> s) sl) in + `Error (err_invalid_val s ("expected " ^ (alts_str ~quoted:true alts))) + in + let print ppf v = + let sl_inv = List.rev_map (fun (s,v) -> (v,s)) sl in + try pp_str ppf (List.assoc v sl_inv) + with Not_found -> invalid_arg (err_incomplete_enum (List.map fst sl)) + in + parse, print + +let file = + let parse s = match Sys.file_exists s with + | true -> `Ok s + | false -> `Error (err_no "file or directory" s) + in + parse, pp_str + +let dir = + let parse s = match Sys.file_exists s with + | true -> if Sys.is_directory s then `Ok s else `Error (err_not_dir s) + | false -> `Error (err_no "directory" s) + in + parse, pp_str + +let non_dir_file = + let parse s = match Sys.file_exists s with + | true -> if not (Sys.is_directory s) then `Ok s else `Error (err_is_dir s) + | false -> `Error (err_no "file" s) + in + parse, pp_str + +let split_and_parse sep parse s = (* raises [Failure] *) + let parse sub = match parse sub with + | `Error e -> failwith e | `Ok v -> v + in + let rec split accum j = + let i = try String.rindex_from s j sep with Not_found -> -1 in + if (i = -1) then + let p = String.sub s 0 (j + 1) in + if p <> "" then parse p :: accum else accum + else + let p = String.sub s (i + 1) (j - i) in + let accum' = if p <> "" then parse p :: accum else accum in + split accum' (i - 1) + in + split [] (String.length s - 1) + +let list ?(sep = ',') (parse, pp_e) = + let parse s = try `Ok (split_and_parse sep parse s) with + | Failure e -> `Error (err_element "list" s e) + in + let rec print ppf = function + | v :: l -> pp_e ppf v; if (l <> []) then (pp_char ppf sep; print ppf l) + | [] -> () + in + parse, print + +let array ?(sep = ',') (parse, pp_e) = + let parse s = try `Ok (Array.of_list (split_and_parse sep parse s)) with + | Failure e -> `Error (err_element "array" s e) + in + let print ppf v = + let max = Array.length v - 1 in + for i = 0 to max do pp_e ppf v.(i); if i <> max then pp_char ppf sep done + in + parse, print + +let split_left sep s = + try + let i = String.index s sep in + let len = String.length s in + Some ((String.sub s 0 i), (String.sub s (i + 1) (len - i - 1))) + with Not_found -> None + +let pair ?(sep = ',') (pa0, pr0) (pa1, pr1) = + let parser s = match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some (v0, v1) -> + match pa0 v0, pa1 v1 with + | `Ok v0, `Ok v1 -> `Ok (v0, v1) + | `Error e, _ | _, `Error e -> `Error (err_element "pair" s e) + in + let printer ppf (v0, v1) = pp ppf "%a%c%a" pr0 v0 sep pr1 v1 in + parser, printer + +let t2 = pair +let t3 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) = + let parse s = match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some (v0, s) -> + match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some (v1, v2) -> + match pa0 v0, pa1 v1, pa2 v2 with + | `Ok v0, `Ok v1, `Ok v2 -> `Ok (v0, v1, v2) + | `Error e, _, _ | _, `Error e, _ | _, _, `Error e -> + `Error (err_element "triple" s e) + in + let print ppf (v0, v1, v2) = + pp ppf "%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2 + in + parse, print + +let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) = + let parse s = match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some(v0, s) -> + match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some (v1, s) -> + match split_left sep s with + | None -> `Error (err_sep_miss sep s) + | Some (v2, v3) -> + match pa0 v0, pa1 v1, pa2 v2, pa3 v3 with + | `Ok v1, `Ok v2, `Ok v3, `Ok v4 -> `Ok (v1, v2, v3, v4) + | `Error e, _, _, _ | _, `Error e, _, _ | _, _, `Error e, _ + | _, _, _, `Error e -> `Error (err_element "quadruple" s e) + in + let print ppf (v0, v1, v2, v3) = + pp ppf "%a%c%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2 sep pr3 v3 + in + parse, print + +let env_bool_parse s = match String.lowercase_ascii s with +| "" | "false" | "no" | "n" | "0" -> `Ok false +| "true" | "yes" | "y" | "1" -> `Ok true +| s -> + let alts = alts_str ~quoted:true ["true"; "yes"; "false"; "no" ] in + `Error (err_invalid_val s alts) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_base.mli b/src/reason-parser/vendor/cmdliner/cmdliner_base.mli new file mode 100644 index 000000000..3b12e7351 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_base.mli @@ -0,0 +1,60 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** A few helpful base definitions. *) + +val uid : unit -> int +(** [uid ()] is new unique for the program run. *) + +val suggest : string -> string list -> string list +(** [suggest near candidates] suggest values from [candidates] + not too far from [near]. *) + +(** {1:fmt Formatting helpers} *) + +val pp_text : Format.formatter -> string -> unit +val pp_lines : Format.formatter -> string -> unit +val pp_tokens : spaces:bool -> Format.formatter -> string -> unit + +(** {1:err Error message helpers} *) + +val quote : string -> string +val alts_str : ?quoted:bool -> string list -> string +val err_ambiguous : kind:string -> string -> ambs:string list -> string +val err_unknown : + ?dom:string list -> ?hints:string list -> kind:string -> string -> string +val err_multi_def : + kind:string -> string -> ('b -> string) -> 'b -> 'b -> string + +(** {1:conv Textual OCaml value converters} *) + +type 'a parser = string -> [ `Ok of 'a | `Error of string ] +type 'a printer = Format.formatter -> 'a -> unit +type 'a conv = 'a parser * 'a printer + +val some : ?none:string -> 'a conv -> 'a option conv +val some' : ?none:'a -> 'a conv -> 'a option conv +val bool : bool conv +val char : char conv +val int : int conv +val nativeint : nativeint conv +val int32 : int32 conv +val int64 : int64 conv +val float : float conv +val string : string conv +val enum : (string * 'a) list -> 'a conv +val file : string conv +val dir : string conv +val non_dir_file : string conv +val list : ?sep:char -> 'a conv -> 'a list conv +val array : ?sep:char -> 'a conv -> 'a array conv +val pair : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv +val t2 : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv +val t3 : ?sep:char -> 'a conv ->'b conv -> 'c conv -> ('a * 'b * 'c) conv +val t4 : + ?sep:char -> 'a conv -> 'b conv -> 'c conv -> 'd conv -> + ('a * 'b * 'c * 'd) conv + +val env_bool_parse : bool parser diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_cline.ml b/src/reason-parser/vendor/cmdliner/cmdliner_cline.ml new file mode 100644 index 000000000..cc817024a --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_cline.ml @@ -0,0 +1,203 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* A command line stores pre-parsed information about the command + line's arguments in a more structured way. Given the + Cmdliner_info.arg values mentioned in a term and Sys.argv + (without exec name) we parse the command line into a map of + Cmdliner_info.arg values to [arg] values (see below). This map is used by + the term's closures to retrieve and convert command line arguments + (see the Cmdliner_arg module). *) + +let err_multi_opt_name_def name a a' = + Cmdliner_base.err_multi_def + ~kind:"option name" name Cmdliner_info.Arg.doc a a' + +module Amap = Map.Make (Cmdliner_info.Arg) + +type arg = (* unconverted argument data as found on the command line. *) +| O of (int * string * (string option)) list (* (pos, name, value) of opt. *) +| P of string list + +type t = arg Amap.t (* command line, maps arg_infos to arg value. *) + +let get_arg cl a = try Amap.find a cl with Not_found -> assert false +let opt_arg cl a = match get_arg cl a with O l -> l | _ -> assert false +let pos_arg cl a = match get_arg cl a with P l -> l | _ -> assert false +let actual_args cl a = match get_arg cl a with +| P args -> args +| O l -> + let extract_args (_pos, name, value) = + name :: (match value with None -> [] | Some v -> [v]) + in + List.concat (List.map extract_args l) + +let arg_info_indexes args = + (* from [args] returns a trie mapping the names of optional arguments to + their arg_info, a list with all arg_info for positional arguments and + a cmdline mapping each arg_info to an empty [arg]. *) + let rec loop optidx posidx cl = function + | [] -> optidx, posidx, cl + | a :: l -> + match Cmdliner_info.Arg.is_pos a with + | true -> loop optidx (a :: posidx) (Amap.add a (P []) cl) l + | false -> + let add t name = match Cmdliner_trie.add t name a with + | `New t -> t + | `Replaced (a', _) -> invalid_arg (err_multi_opt_name_def name a a') + in + let names = Cmdliner_info.Arg.opt_names a in + let optidx = List.fold_left add optidx names in + loop optidx posidx (Amap.add a (O []) cl) l + in + loop Cmdliner_trie.empty [] Amap.empty (Cmdliner_info.Arg.Set.elements args) + +(* Optional argument parsing *) + +let is_opt s = String.length s > 1 && s.[0] = '-' +let is_short_opt s = String.length s = 2 && s.[0] = '-' + +let parse_opt_arg s = (* (name, value) of opt arg, assert len > 1. *) + let l = String.length s in + if s.[1] <> '-' then (* short opt *) + if l = 2 then s, None else + String.sub s 0 2, Some (String.sub s 2 (l - 2)) (* with glued opt arg *) + else try (* long opt *) + let i = String.index s '=' in + String.sub s 0 i, Some (String.sub s (i + 1) (l - i - 1)) + with Not_found -> s, None + +let hint_matching_opt optidx s = + (* hint options that could match [s] in [optidx]. FIXME explain this is + a bit obscure. *) + if String.length s <= 2 then [] else + let short_opt, long_opt = + if s.[1] <> '-' + then s, Printf.sprintf "-%s" s + else String.sub s 1 (String.length s - 1), s + in + let short_opt, _ = parse_opt_arg short_opt in + let long_opt, _ = parse_opt_arg long_opt in + let all = Cmdliner_trie.ambiguities optidx "-" in + match List.mem short_opt all, Cmdliner_base.suggest long_opt all with + | false, [] -> [] + | false, l -> l + | true, [] -> [short_opt] + | true, l -> if List.mem short_opt l then l else short_opt :: l + +let parse_opt_args ~peek_opts optidx cl args = + (* returns an updated [cl] cmdline according to the options found in [args] + with the trie index [optidx]. Positional arguments are returned in order + in a list. *) + let rec loop errs k cl pargs = function + | [] -> List.rev errs, cl, List.rev pargs + | "--" :: args -> List.rev errs, cl, (List.rev_append pargs args) + | s :: args -> + if not (is_opt s) then loop errs (k + 1) cl (s :: pargs) args else + let name, value = parse_opt_arg s in + match Cmdliner_trie.find optidx name with + | `Ok a -> + let value, args = match value, Cmdliner_info.Arg.opt_kind a with + | Some v, Cmdliner_info.Arg.Flag when is_short_opt name -> + None, ("-" ^ v) :: args + | Some _, _ -> value, args + | None, Cmdliner_info.Arg.Flag -> value, args + | None, _ -> + match args with + | [] -> None, args + | v :: rest -> if is_opt v then None, args else Some v, rest + in + let arg = O ((k, name, value) :: opt_arg cl a) in + loop errs (k + 1) (Amap.add a arg cl) pargs args + | `Not_found when peek_opts -> loop errs (k + 1) cl pargs args + | `Not_found -> + let hints = hint_matching_opt optidx s in + let err = Cmdliner_base.err_unknown ~kind:"option" ~hints name in + loop (err :: errs) (k + 1) cl pargs args + | `Ambiguous -> + let ambs = Cmdliner_trie.ambiguities optidx name in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"option" name ~ambs in + loop (err :: errs) (k + 1) cl pargs args + in + let errs, cl, pargs = loop [] 0 cl [] args in + if errs = [] then Ok (cl, pargs) else + let err = String.concat "\n" errs in + Error (err, cl, pargs) + +let take_range start stop l = + let rec loop i acc = function + | [] -> List.rev acc + | v :: vs -> + if i < start then loop (i + 1) acc vs else + if i <= stop then loop (i + 1) (v :: acc) vs else + List.rev acc + in + loop 0 [] l + +let process_pos_args posidx cl pargs = + (* returns an updated [cl] cmdline in which each positional arg mentioned + in the list index posidx, is given a value according the list + of positional arguments values [pargs]. *) + if pargs = [] then + let misses = List.filter Cmdliner_info.Arg.is_req posidx in + if misses = [] then Ok cl else + Error (Cmdliner_msg.err_pos_misses misses, cl) + else + let last = List.length pargs - 1 in + let pos rev k = if rev then last - k else k in + let rec loop misses cl max_spec = function + | [] -> misses, cl, max_spec + | a :: al -> + let apos = Cmdliner_info.Arg.pos_kind a in + let rev = Cmdliner_info.Arg.pos_rev apos in + let start = pos rev (Cmdliner_info.Arg.pos_start apos) in + let stop = match Cmdliner_info.Arg.pos_len apos with + | None -> pos rev last + | Some n -> pos rev (Cmdliner_info.Arg.pos_start apos + n - 1) + in + let start, stop = if rev then stop, start else start, stop in + let args = take_range start stop pargs in + let max_spec = max stop max_spec in + let cl = Amap.add a (P args) cl in + let misses = match Cmdliner_info.Arg.is_req a && args = [] with + | true -> a :: misses + | false -> misses + in + loop misses cl max_spec al + in + let misses, cl, max_spec = loop [] cl (-1) posidx in + if misses <> [] then Error (Cmdliner_msg.err_pos_misses misses, cl) else + if last <= max_spec then Ok cl else + let excess = take_range (max_spec + 1) last pargs in + Error (Cmdliner_msg.err_pos_excess excess, cl) + +let create ?(peek_opts = false) al args = + let optidx, posidx, cl = arg_info_indexes al in + match parse_opt_args ~peek_opts optidx cl args with + | Ok (cl, _) when peek_opts -> Ok cl + | Ok (cl, pargs) -> process_pos_args posidx cl pargs + | Error (errs, cl, _) -> Error (errs, cl) + +let deprecated_msgs cl = + let add i arg acc = match Cmdliner_info.Arg.deprecated i with + | None -> acc + | Some msg -> + let plural l = if List.length l > 1 then "s " else " " in + match arg with + | O [] | P [] -> acc (* Should not happen *) + | O os -> + let plural = plural os in + let names = List.map (fun (_, n, _) -> n) os in + let names = String.concat " " (List.map Cmdliner_base.quote names) in + let msg = "option" :: plural :: names :: ": " :: msg :: [] in + String.concat "" msg :: acc + | P args -> + let plural = plural args in + let args = String.concat " " (List.map Cmdliner_base.quote args) in + let msg = "argument" :: plural :: args :: ": " :: msg :: [] in + String.concat "" msg :: acc + in + Amap.fold add cl [] diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_cline.mli b/src/reason-parser/vendor/cmdliner/cmdliner_cline.mli new file mode 100644 index 000000000..f9075b01d --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_cline.mli @@ -0,0 +1,20 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command lines. *) + +type t + +val create : + ?peek_opts:bool -> Cmdliner_info.Arg.Set.t -> string list -> + (t, string * t) result + +val opt_arg : t -> Cmdliner_info.Arg.t -> (int * string * (string option)) list +val pos_arg : t -> Cmdliner_info.Arg.t -> string list +val actual_args : t -> Cmdliner_info.Arg.t -> string list +(** Actual command line arguments from the command line *) + +val is_opt : string -> bool +val deprecated_msgs : t -> string list diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_cmd.ml b/src/reason-parser/vendor/cmdliner/cmdliner_cmd.ml new file mode 100644 index 000000000..0cff096bc --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_cmd.ml @@ -0,0 +1,30 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Commands *) + +(* Command info *) + +type info = Cmdliner_info.Cmd.t +let info = Cmdliner_info.Cmd.v + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +let get_info = function Cmd (i, _) | Group (i, _) -> i +let children_infos = function +| Cmd _ -> [] | Group (_, (_, cs)) -> List.map get_info cs + +let v i (args, p) = Cmd (Cmdliner_info.Cmd.add_args i args, p) +let group ?default i cmds = + let args, parser = match default with + | None -> None, None | Some (args, p) -> Some args, Some p + in + let children = List.map get_info cmds in + let i = Cmdliner_info.Cmd.with_children i ~args ~children in + Group (i, (parser, cmds)) + +let name c = Cmdliner_info.Cmd.name (get_info c) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_cmd.mli b/src/reason-parser/vendor/cmdliner/cmdliner_cmd.mli new file mode 100644 index 000000000..f2e3062ca --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_cmd.mli @@ -0,0 +1,24 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Commands and their information. *) + +type info = Cmdliner_info.Cmd.t + +val info : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Cmdliner_info.Env.info list -> ?exits:Cmdliner_info.Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + +type 'a t = +| Cmd of info * 'a Cmdliner_term.parser +| Group of info * ('a Cmdliner_term.parser option * 'a t list) + +val v : info -> 'a Cmdliner_term.t -> 'a t +val group : ?default:'a Cmdliner_term.t -> info -> 'a t list -> 'a t +val name : 'a t -> string +val get_info : 'a t -> info diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_docgen.ml b/src/reason-parser/vendor/cmdliner/cmdliner_docgen.ml new file mode 100644 index 000000000..3a36df5c4 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_docgen.ml @@ -0,0 +1,395 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let rev_compare n0 n1 = compare n1 n0 +let strf = Printf.sprintf + +let order_args a0 a1 = + match Cmdliner_info.Arg.is_opt a0, Cmdliner_info.Arg.is_opt a1 with + | true, true -> (* optional by name *) + let key names = + let k = List.hd (List.sort rev_compare names) in + let k = String.lowercase_ascii k in + if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k + in + compare + (key @@ Cmdliner_info.Arg.opt_names a0) + (key @@ Cmdliner_info.Arg.opt_names a1) + | false, false -> (* positional by variable *) + compare + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a0) + (String.lowercase_ascii @@ Cmdliner_info.Arg.docv a1) + | true, false -> -1 (* positional first *) + | false, true -> 1 (* optional after *) + +let esc = Cmdliner_manpage.escape +let cmd_name t = esc @@ Cmdliner_info.Cmd.name t + +let sorted_items_to_blocks ~boilerplate:b items = + (* Items are sorted by section and then rev. sorted by appearance. + We gather them by section in correct order in a `Block and prefix + them with optional boilerplate *) + let boilerplate = match b with None -> (fun _ -> None) | Some b -> b in + let mk_block sec acc = match boilerplate sec with + | None -> (sec, `Blocks acc) + | Some b -> (sec, `Blocks (b :: acc)) + in + let rec loop secs sec acc = function + | (sec', it) :: its when sec' = sec -> loop secs sec (it :: acc) its + | (sec', it) :: its -> loop (mk_block sec acc :: secs) sec' [it] its + | [] -> (mk_block sec acc) :: secs + in + match items with + | [] -> [] + | (sec, it) :: its -> loop [] sec [it] its + +(* Doc string variables substitutions. *) + +let env_info_subst ~subst e = function +| "env" -> Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e)) +| id -> subst id + +let exit_info_subst ~subst e = function +| "status" -> Some (strf "%d" (fst @@ Cmdliner_info.Exit.info_codes e)) +| "status_max" -> Some (strf "%d" (snd @@ Cmdliner_info.Exit.info_codes e)) +| id -> subst id + +let arg_info_subst ~subst a = function +| "docv" -> + Some (strf "$(i,%s)" @@ esc (Cmdliner_info.Arg.docv a)) +| "opt" when Cmdliner_info.Arg.is_opt a -> + Some (strf "$(b,%s)" @@ esc (Cmdliner_info.Arg.opt_name_sample a)) +| "env" as id -> + begin match Cmdliner_info.Arg.env a with + | Some e -> env_info_subst ~subst e id + | None -> subst id + end +| id -> subst id + +let cmd_info_subst ei = function +| "tname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.cmd ei)) +| "mname" -> Some (strf "$(b,%s)" @@ cmd_name (Cmdliner_info.Eval.main ei)) +| "iname" -> + let cmd = Cmdliner_info.Eval.cmd ei :: Cmdliner_info.Eval.parents ei in + let cmd = String.concat " " (List.rev_map Cmdliner_info.Cmd.name cmd) in + Some (strf "$(b,%s)" cmd) +| _ -> None + +(* Command docs *) + +let invocation ?(sep = " ") ?(parents = []) cmd = + let names = List.rev_map Cmdliner_info.Cmd.name (cmd :: parents) in + esc @@ String.concat sep names + +let synopsis_pos_arg a = + let v = match Cmdliner_info.Arg.docv a with "" -> "ARG" | v -> v in + let v = strf "$(i,%s)" (esc v) in + let v = (if Cmdliner_info.Arg.is_req a then strf "%s" else strf "[%s]") v in + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with + | None -> v ^ "…" + | Some 1 -> v + | Some n -> + let rec loop n acc = if n <= 0 then acc else loop (n - 1) (v :: acc) in + String.concat " " (loop n []) + +let synopsis_opt_arg a n = + let var = match Cmdliner_info.Arg.docv a with "" -> "VAL" | v -> v in + match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Flag -> strf "$(b,%s)" (esc n) + | Cmdliner_info.Arg.Opt -> + if String.length n > 2 + then strf "$(b,%s)=$(i,%s)" (esc n) (esc var) + else strf "$(b,%s) $(i,%s)" (esc n) (esc var) + | Cmdliner_info.Arg.Opt_vopt _ -> + if String.length n > 2 + then strf "$(b,%s)[=$(i,%s)]" (esc n) (esc var) + else strf "$(b,%s) [$(i,%s)]" (esc n) (esc var) + +let deprecated cmd = match Cmdliner_info.Cmd.deprecated cmd with +| None -> "" | Some _ -> "(Deprecated) " + +let synopsis ?parents cmd = match Cmdliner_info.Cmd.children cmd with +| [] -> + let rev_cli_order (a0, _) (a1, _) = + Cmdliner_info.Arg.rev_pos_cli_order a0 a1 + in + let args = Cmdliner_info.Cmd.args cmd in + let oargs, pargs = Cmdliner_info.Arg.(Set.partition is_opt args) in + let oargs = + (* Keep only those that are listed in the s_options section and + that are not [--version] or [--help]. * *) + let keep a = + let drop_names n = n = "--help" || n = "--version" in + Cmdliner_info.Arg.docs a = Cmdliner_manpage.s_options && + not (List.exists drop_names (Cmdliner_info.Arg.opt_names a)) + in + let oargs = Cmdliner_info.Arg.Set.(elements (filter keep oargs)) in + let count = List.length oargs in + let any_option = "[$(i,OPTION)]…" in + if count = 0 || count > 3 then any_option else + let syn a = + strf "[%s]" (synopsis_opt_arg a (Cmdliner_info.Arg.opt_name_sample a)) + in + let oargs = List.sort order_args oargs in + let oargs = String.concat " " (List.map syn oargs) in + String.concat " " [oargs; any_option] + in + let pargs = + let pargs = Cmdliner_info.Arg.Set.elements pargs in + if pargs = [] then "" else + let pargs = List.map (fun a -> a, synopsis_pos_arg a) pargs in + let pargs = List.sort rev_cli_order pargs in + String.concat " " ("" (* add a space *) :: List.rev_map snd pargs) + in + strf "%s$(b,%s) %s%s" + (deprecated cmd) (invocation ?parents cmd) oargs pargs +| _cmds -> + let subcmd = match Cmdliner_info.Cmd.has_args cmd with + | false -> "$(i,COMMAND)" | true -> "[$(i,COMMAND)]" + in + strf "%s$(b,%s) %s …" (deprecated cmd) (invocation ?parents cmd) subcmd + +let cmd_docs ei = match Cmdliner_info.(Cmd.children (Eval.cmd ei)) with +| [] -> [] +| cmds -> + let add_cmd acc cmd = + let syn = synopsis cmd in + (Cmdliner_info.Cmd.docs cmd, `I (syn, Cmdliner_info.Cmd.doc cmd)) :: acc + in + let by_sec_by_rev_name (s0, `I (c0, _)) (s1, `I (c1, _)) = + let c = compare s0 s1 in + if c <> 0 then c else compare c1 c0 (* N.B. reverse *) + in + let cmds = List.fold_left add_cmd [] cmds in + let cmds = List.sort by_sec_by_rev_name cmds in + let cmds = (cmds :> (string * Cmdliner_manpage.block) list) in + sorted_items_to_blocks ~boilerplate:None cmds + +(* Argument docs *) + +let arg_man_item_label a = + let s = match Cmdliner_info.Arg.is_pos a with + | true -> strf "$(i,%s)" (esc @@ Cmdliner_info.Arg.docv a) + | false -> + let names = List.sort compare (Cmdliner_info.Arg.opt_names a) in + String.concat ", " (List.rev_map (synopsis_opt_arg a) names) + in + match Cmdliner_info.Arg.deprecated a with + | None -> s | Some _ -> "(Deprecated) " ^ s + +let arg_to_man_item ~errs ~subst ~buf a = + let subst = arg_info_subst ~subst a in + let or_env ~value a = match Cmdliner_info.Arg.env a with + | None -> "" + | Some e -> + let value = if value then " or" else "absent " in + strf "%s $(b,%s) env" value (esc @@ Cmdliner_info.Env.info_var e) + in + let absent = match Cmdliner_info.Arg.absent a with + | Cmdliner_info.Arg.Err -> "required" + | Cmdliner_info.Arg.Doc "" -> strf "%s" (or_env ~value:false a) + | Cmdliner_info.Arg.Doc s -> + let s = Cmdliner_manpage.subst_vars ~errs ~subst buf s in + strf "absent=%s%s" s (or_env ~value:true a) + | Cmdliner_info.Arg.Val v -> + match Lazy.force v with + | "" -> strf "%s" (or_env ~value:false a) + | v -> strf "absent=$(b,%s)%s" (esc v) (or_env ~value:true a) + in + let optvopt = match Cmdliner_info.Arg.opt_kind a with + | Cmdliner_info.Arg.Opt_vopt v -> strf "default=$(b,%s)" (esc v) + | _ -> "" + in + let argvdoc = match optvopt, absent with + | "", "" -> "" + | s, "" | "", s -> strf " (%s)" s + | s, s' -> strf " (%s) (%s)" s s' + in + let doc = Cmdliner_info.Arg.doc a in + let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in + (Cmdliner_info.Arg.docs a, `I (arg_man_item_label a ^ argvdoc, doc)) + +let arg_docs ~errs ~subst ~buf ei = + let by_sec_by_arg a0 a1 = + let c = compare (Cmdliner_info.Arg.docs a0) (Cmdliner_info.Arg.docs a1) in + if c <> 0 then c else + let c = + match Cmdliner_info.Arg.deprecated a0, Cmdliner_info.Arg.deprecated a1 + with + | None, None | Some _, Some _ -> 0 + | None, Some _ -> -1 | Some _, None -> 1 + in + if c <> 0 then c else order_args a0 a1 + in + let keep_arg a acc = + if not Cmdliner_info.Arg.(is_pos a && (docv a = "" || doc a = "")) + then (a :: acc) else acc + in + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let args = Cmdliner_info.Arg.Set.fold keep_arg args [] in + let args = List.sort by_sec_by_arg args in + let args = List.rev_map (arg_to_man_item ~errs ~subst ~buf) args in + sorted_items_to_blocks ~boilerplate:None args + +(* Exit statuses doc *) + +let exit_boilerplate sec = match sec = Cmdliner_manpage.s_exit_status with +| false -> None +| true -> Some (Cmdliner_manpage.s_exit_status_intro) + +let exit_docs ~errs ~subst ~buf ~has_sexit ei = + let by_sec (s0, _) (s1, _) = compare s0 s1 in + let add_exit_item acc e = + let subst = exit_info_subst ~subst e in + let min, max = Cmdliner_info.Exit.info_codes e in + let doc = Cmdliner_info.Exit.info_doc e in + let label = if min = max then strf "%d" min else strf "%d-%d" min max in + let item = `I (label, Cmdliner_manpage.subst_vars ~errs ~subst buf doc) in + (Cmdliner_info.Exit.info_docs e, item) :: acc + in + let exits = Cmdliner_info.Cmd.exits @@ Cmdliner_info.Eval.cmd ei in + let exits = List.sort Cmdliner_info.Exit.info_order exits in + let exits = List.fold_left add_exit_item [] exits in + let exits = List.stable_sort by_sec (* sort by section *) exits in + let boilerplate = if has_sexit then None else Some exit_boilerplate in + sorted_items_to_blocks ~boilerplate exits + +(* Environment doc *) + +let env_boilerplate sec = match sec = Cmdliner_manpage.s_environment with +| false -> None +| true -> Some (Cmdliner_manpage.s_environment_intro) + +let env_docs ~errs ~subst ~buf ~has_senv ei = + let add_env_item ~subst (seen, envs as acc) e = + if Cmdliner_info.Env.Set.mem e seen then acc else + let seen = Cmdliner_info.Env.Set.add e seen in + let var = strf "$(b,%s)" @@ esc (Cmdliner_info.Env.info_var e) in + let var = match Cmdliner_info.Env.info_deprecated e with + | None -> var | Some _ -> "(Deprecated) " ^ var in + let doc = Cmdliner_info.Env.info_doc e in + let doc = Cmdliner_manpage.subst_vars ~errs ~subst buf doc in + let envs = (Cmdliner_info.Env.info_docs e, `I (var, doc)) :: envs in + seen, envs + in + let add_arg_env a acc = match Cmdliner_info.Arg.env a with + | None -> acc + | Some e -> add_env_item ~subst:(arg_info_subst ~subst a) acc e + in + let add_env acc e = add_env_item ~subst:(env_info_subst ~subst e) acc e in + let by_sec_by_rev_name (s0, `I (v0, _)) (s1, `I (v1, _)) = + let c = compare s0 s1 in + if c <> 0 then c else compare v1 v0 (* N.B. reverse *) + in + (* Arg envs before term envs is important here: if the same is mentioned + both in an arg and in a term the substs of the arg are allowed. *) + let args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let tenvs = Cmdliner_info.Cmd.envs @@ Cmdliner_info.Eval.cmd ei in + let init = Cmdliner_info.Env.Set.empty, [] in + let acc = Cmdliner_info.Arg.Set.fold add_arg_env args init in + let _, envs = List.fold_left add_env acc tenvs in + let envs = List.sort by_sec_by_rev_name envs in + let envs = (envs :> (string * Cmdliner_manpage.block) list) in + let boilerplate = if has_senv then None else Some env_boilerplate in + sorted_items_to_blocks ~boilerplate envs + +(* xref doc *) + +let xref_docs ~errs ei = + let main = Cmdliner_info.Eval.main ei in + let to_xref = function + | `Main -> Cmdliner_info.Cmd.name main, 1 + | `Tool tool -> tool, 1 + | `Page (name, sec) -> name, sec + | `Cmd c -> + (* N.B. we are handling only the first subcommand level here *) + let cmds = Cmdliner_info.Cmd.children main in + let mname = Cmdliner_info.Cmd.name main in + let is_cmd cmd = Cmdliner_info.Cmd.name cmd = c in + if List.exists is_cmd cmds then strf "%s-%s" mname c, 1 else + (Format.fprintf errs "xref %s: no such command name@." c; "doc-err", 0) + in + let xref_str (name, sec) = strf "%s(%d)" (esc name) sec in + let xrefs = Cmdliner_info.Cmd.man_xrefs @@ Cmdliner_info.Eval.cmd ei in + let xrefs = match main == Cmdliner_info.Eval.cmd ei with + | true -> List.filter (fun x -> x <> `Main) xrefs (* filter out default *) + | false -> xrefs + in + let xrefs = List.fold_left (fun acc x -> to_xref x :: acc) [] xrefs in + let xrefs = List.(rev_map xref_str (sort rev_compare xrefs)) in + if xrefs = [] then [] else + [Cmdliner_manpage.s_see_also, `P (String.concat ", " xrefs)] + +(* Man page construction *) + +let ensure_s_name ei sm = + if Cmdliner_manpage.(smap_has_section sm ~sec:s_name) then sm else + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let tname = (deprecated cmd) ^ invocation ~sep:"-" ~parents cmd in + let tdoc = Cmdliner_info.Cmd.doc cmd in + let tagline = if tdoc = "" then "" else strf " - %s" tdoc in + let tagline = `P (strf "%s%s" tname tagline) in + Cmdliner_manpage.(smap_append_block sm ~sec:s_name tagline) + +let ensure_s_synopsis ei sm = + if Cmdliner_manpage.(smap_has_section sm ~sec:s_synopsis) then sm else + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = `P (synopsis ~parents cmd) in + Cmdliner_manpage.(smap_append_block sm ~sec:s_synopsis synopsis) + +let insert_cmd_man_docs ~errs ei sm = + let buf = Buffer.create 200 in + let subst = cmd_info_subst ei in + let ins sm (sec, b) = Cmdliner_manpage.smap_append_block sm ~sec b in + let has_senv = Cmdliner_manpage.(smap_has_section sm ~sec:s_environment) in + let has_sexit = Cmdliner_manpage.(smap_has_section sm ~sec:s_exit_status) in + let sm = List.fold_left ins sm (cmd_docs ei) in + let sm = List.fold_left ins sm (arg_docs ~errs ~subst ~buf ei) in + let sm = List.fold_left ins sm (exit_docs ~errs ~subst ~buf ~has_sexit ei)in + let sm = List.fold_left ins sm (env_docs ~errs ~subst ~buf ~has_senv ei) in + let sm = List.fold_left ins sm (xref_docs ~errs ei) in + sm + +let text ~errs ei = + let man = Cmdliner_info.Cmd.man @@ Cmdliner_info.Eval.cmd ei in + let sm = Cmdliner_manpage.smap_of_blocks man in + let sm = ensure_s_name ei sm in + let sm = ensure_s_synopsis ei sm in + let sm = insert_cmd_man_docs ei ~errs sm in + Cmdliner_manpage.smap_to_blocks sm + +let title ei = + let main = Cmdliner_info.Eval.main ei in + let exec = String.capitalize_ascii (Cmdliner_info.Cmd.name main) in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let name = String.uppercase_ascii (invocation ~sep:"-" ~parents cmd) in + let center_header = esc @@ strf "%s Manual" exec in + let left_footer = + let version = match Cmdliner_info.Cmd.version main with + | None -> "" | Some v -> " " ^ v + in + esc @@ strf "%s%s" exec version + in + name, 1, "", left_footer, center_header + +let man ~errs ei = title ei, text ~errs ei + +let pp_man ~errs fmt ppf ei = + Cmdliner_manpage.print + ~errs ~subst:(cmd_info_subst ei) fmt ppf (man ~errs ei) + +(* Plain synopsis for usage *) + +let pp_plain_synopsis ~errs ppf ei = + let buf = Buffer.create 100 in + let subst = cmd_info_subst ei in + let cmd = Cmdliner_info.Eval.cmd ei in + let parents = Cmdliner_info.Eval.parents ei in + let synopsis = synopsis ~parents cmd in + let syn = Cmdliner_manpage.doc_to_plain ~errs ~subst buf synopsis in + Format.fprintf ppf "@[%s@]" syn diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_docgen.mli b/src/reason-parser/vendor/cmdliner/cmdliner_docgen.mli new file mode 100644 index 000000000..e57929d05 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_docgen.mli @@ -0,0 +1,11 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +val pp_man : + errs:Format.formatter -> Cmdliner_manpage.format -> Format.formatter -> + Cmdliner_info.Eval.t -> unit + +val pp_plain_synopsis : + errs:Format.formatter -> Format.formatter -> Cmdliner_info.Eval.t -> unit diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_eval.ml b/src/reason-parser/vendor/cmdliner/cmdliner_eval.ml new file mode 100644 index 000000000..e4b50be10 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_eval.ml @@ -0,0 +1,282 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] +type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_info.Exit.code ] + +let err_help s = "Term error, help requested for unknown command " ^ s +let err_argv = "argv array must have at least one element" + +let add_stdopts ei = + let docs = Cmdliner_info.Cmd.stdopts_docs @@ Cmdliner_info.Eval.cmd ei in + let vargs, vers = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> Cmdliner_info.Arg.Set.empty, None + | Some _ -> + let args, _ as vers = Cmdliner_arg.stdopt_version ~docs in + args, Some vers + in + let help = Cmdliner_arg.stdopt_help ~docs in + let args = Cmdliner_info.Arg.Set.union vargs (fst help) in + let cmd = Cmdliner_info.Cmd.add_args (Cmdliner_info.Eval.cmd ei) args in + help, vers, Cmdliner_info.Eval.with_cmd ei cmd + +let parse_error_term err ei cl = Error (`Parse err) + +type 'a eval_result = + ('a, [ Cmdliner_term.term_escape + | `Exn of exn * Printexc.raw_backtrace + | `Parse of string + | `Std_help of Cmdliner_manpage.format | `Std_version ]) result + +let run_parser ~catch ei cl f = try (f ei cl :> 'a eval_result) with +| exn when catch -> + let bt = Printexc.get_raw_backtrace () in + Error (`Exn (exn, bt)) + +let try_eval_stdopts ~catch ei cl help version = + match run_parser ~catch ei cl (snd help) with + | Ok (Some fmt) -> Some (Error (`Std_help fmt)) + | Error _ as err -> Some err + | Ok None -> + match version with + | None -> None + | Some version -> + match run_parser ~catch ei cl (snd version) with + | Ok false -> None + | Ok true -> Some (Error (`Std_version)) + | Error _ as err -> Some err + +let do_help help_ppf err_ppf ei fmt cmd = + let ei = match cmd with + | None (* help of main command requested *) -> + let env _ = assert false in + let cmd = Cmdliner_info.Eval.main ei in + let ei' = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf in + begin match Cmdliner_info.Eval.parents ei with + | [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) ei' + | _ -> let _, _, ei = add_stdopts ei' in ei + end + | Some cmd -> + try + (* For now we simply keep backward compat. [cmd] should be + a name from main's children. *) + let main = Cmdliner_info.Eval.main ei in + let is_cmd t = Cmdliner_info.Cmd.name t = cmd in + let children = Cmdliner_info.Cmd.children main in + let cmd = List.find is_cmd children in + let _, _, ei = add_stdopts (Cmdliner_info.Eval.with_cmd ei cmd) in + ei + with Not_found -> invalid_arg (err_help cmd) + in + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei + +let do_result help_ppf err_ppf ei = function +| Ok v -> Ok (`Ok v) +| Error res -> + match res with + | `Std_help fmt -> + Cmdliner_docgen.pp_man ~errs:err_ppf fmt help_ppf ei; Ok `Help + | `Std_version -> + Cmdliner_msg.pp_version help_ppf ei; Ok `Version + | `Parse err -> + Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:false ~err; + Error `Parse + | `Help (fmt, cmd) -> do_help help_ppf err_ppf ei fmt cmd; Ok `Help + | `Exn (e, bt) -> Cmdliner_msg.pp_backtrace err_ppf ei e bt; (Error `Exn) + | `Error (usage, err) -> + (if usage + then Cmdliner_msg.pp_err_usage err_ppf ei ~err_lines:true ~err + else Cmdliner_msg.pp_err err_ppf ei ~err); + (Error `Term) + +let cmd_name_trie cmds = + let add acc cmd = + let i = Cmdliner_cmd.get_info cmd in + let name = Cmdliner_info.Cmd.name i in + match Cmdliner_trie.add acc name cmd with + | `New t -> t + | `Replaced (cmd', _) -> + let i' = Cmdliner_cmd.get_info cmd' and kind = "command" in + invalid_arg @@ + Cmdliner_base.err_multi_def ~kind name Cmdliner_info.Cmd.doc i i' + in + List.fold_left add Cmdliner_trie.empty cmds + +let cmd_name_dom cmds = + let cmd_name c = Cmdliner_info.Cmd.name (Cmdliner_cmd.get_info c) in + List.sort String.compare (List.rev_map cmd_name cmds) + +let find_term args cmd = + let never_term _ _ = assert false in + let stop args_rest args_rev parents cmd = + let args = List.rev_append args_rev args_rest in + match (cmd : 'a Cmdliner_cmd.t) with + | Cmd (i, t) -> + args, t, i, parents, Ok () + | Group (i, (Some t, children)) -> + args, t, i, parents, Ok () + | Group (i, (None, children)) -> + let dom = cmd_name_dom children in + let err = Cmdliner_msg.err_cmd_missing ~dom in + args, never_term, i, parents, Error err + in + let rec loop args_rev parents cmd = function + | ("--" :: _ | [] as rest) -> stop rest args_rev parents cmd + | (arg :: _ as rest) when Cmdliner_cline.is_opt arg -> + stop rest args_rev parents cmd + | arg :: args -> + match cmd with + | Cmd (i, t) -> + let args = List.rev_append args_rev (arg :: args) in + args, t, i, parents, Ok () + | Group (i, (t, children)) -> + let index = cmd_name_trie children in + match Cmdliner_trie.find index arg with + | `Ok cmd -> loop args_rev (i :: parents) cmd args + | `Not_found -> + let args = List.rev_append args_rev (arg :: args) in + let all = Cmdliner_trie.ambiguities index "" in + let hints = Cmdliner_base.suggest arg all in + let dom = cmd_name_dom children in + let kind = "command" in + let err = Cmdliner_base.err_unknown ~kind ~dom ~hints arg in + args, never_term, i, parents, Error err + | `Ambiguous -> + let args = List.rev_append args_rev (arg :: args) in + let ambs = Cmdliner_trie.ambiguities index arg in + let ambs = List.sort compare ambs in + let err = Cmdliner_base.err_ambiguous ~kind:"command" arg ~ambs in + args, never_term, i, parents, Error err + in + loop [] [] cmd args + +let env_default v = try Some (Sys.getenv v) with Not_found -> None +let remove_exec argv = + try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv + +let do_deprecated_msgs err_ppf cl ei = + let cmd = Cmdliner_info.Eval.cmd ei in + let msgs = Cmdliner_cline.deprecated_msgs cl in + let msgs = match Cmdliner_info.Cmd.deprecated cmd with + | None -> msgs + | Some msg -> + let name = Cmdliner_base.quote (Cmdliner_info.Cmd.name cmd) in + String.concat "" ("command " :: name :: ": " :: msg :: []) :: msgs + in + if msgs <> [] + then Cmdliner_msg.pp_err err_ppf ei ~err:(String.concat "\n" msgs) + +let eval_value + ?help:(help_ppf = Format.std_formatter) + ?err:(err_ppf = Format.err_formatter) + ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) cmd + = + let args, f, cmd, parents, res = find_term (remove_exec argv) cmd in + let ei = Cmdliner_info.Eval.v ~cmd ~parents ~env ~err_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let res = match res with + | Error msg -> (* Command lookup error, we still prioritize stdargs *) + let cl = match Cmdliner_cline.create term_args args with + | Error (_, cl) -> cl | Ok cl -> cl + in + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, msg)) + end + | Ok () -> + match Cmdliner_cline.create term_args args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> Error (`Error (true, e)) + end + | Ok cl -> + match try_eval_stdopts ~catch ei cl help version with + | Some e -> e + | None -> + do_deprecated_msgs err_ppf cl ei; + run_parser ~catch ei cl f + in + do_result help_ppf err_ppf ei res + +let eval_peek_opts + ?(version_opt = false) ?(env = env_default) ?(argv = Sys.argv) t + : 'a option * ('a eval_ok, eval_error) result + = + let args, f = t in + let version = if version_opt then Some "dummy" else None in + let cmd = Cmdliner_info.Cmd.v ?version "dummy" in + let cmd = Cmdliner_info.Cmd.add_args cmd args in + let null_ppf = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) in + let ei = Cmdliner_info.Eval.v ~cmd ~parents:[] ~env ~err_ppf:null_ppf in + let help, version, ei = add_stdopts ei in + let term_args = Cmdliner_info.Cmd.args @@ Cmdliner_info.Eval.cmd ei in + let cli_args = remove_exec argv in + let v, ret = + match Cmdliner_cline.create ~peek_opts:true term_args cli_args with + | Error (e, cl) -> + begin match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> None, e + | None -> None, Error (`Error (true, e)) + end + | Ok cl -> + let ret = run_parser ~catch:true ei cl f in + let v = match ret with Ok v -> Some v | Error _ -> None in + match try_eval_stdopts ~catch:true ei cl help version with + | Some e -> v, e + | None -> v, ret + in + let ret = match ret with + | Ok v -> Ok (`Ok v) + | Error `Std_help _ -> Ok `Help + | Error `Std_version -> Ok `Version + | Error `Parse _ -> Error `Parse + | Error `Help _ -> Ok `Help + | Error `Exn _ -> Error `Exn + | Error `Error _ -> Error `Term + in + (v, ret) + +let exit_status_of_result ?(term_err = Cmdliner_info.Exit.cli_error) = function +| Ok (`Ok _ | `Help | `Version) -> Cmdliner_info.Exit.ok +| Error `Term -> term_err +| Error `Parse -> Cmdliner_info.Exit.cli_error +| Error `Exn -> Cmdliner_info.Exit.internal_error + +let eval_value' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok _ as v) -> v + | ret -> `Exit (exit_status_of_result ?term_err ret) + +let eval ?help ?err ?catch ?env ?argv ?term_err cmd = + exit_status_of_result ?term_err @@ + eval_value ?help ?err ?catch ?env ?argv cmd + +let eval' ?help ?err ?catch ?env ?argv ?term_err cmd = + match eval_value ?help ?err ?catch ?env ?argv cmd with + | Ok (`Ok c) -> c + | r -> exit_status_of_result ?term_err r + +let pp_err ppf cmd ~msg = (* FIXME move that to Cmdliner_msgs *) + let name = Cmdliner_cmd.name cmd in + Format.fprintf ppf "%s: @[%a@]@." name Cmdliner_base.pp_lines msg + +let eval_result + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r + +let eval_result' + ?help ?(err = Format.err_formatter) ?catch ?env ?argv ?term_err cmd + = + match eval_value ?help ~err ?catch ?env ?argv cmd with + | Ok (`Ok (Ok c)) -> c + | Ok (`Ok (Error msg)) -> pp_err err cmd ~msg; Cmdliner_info.Exit.some_error + | r -> exit_status_of_result ?term_err r diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_eval.mli b/src/reason-parser/vendor/cmdliner/cmdliner_eval.mli new file mode 100644 index 000000000..27194b80f --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_eval.mli @@ -0,0 +1,50 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2022 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Command evaluation *) + +(** {1:eval Evaluating commands} *) + +type 'a eval_ok = [ `Ok of 'a | `Version | `Help ] +type eval_error = [ `Parse | `Term | `Exn ] +type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_info.Exit.code ] + +val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a Cmdliner_cmd.t -> + ('a eval_ok, eval_error) result + +val eval_value' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> 'a Cmdliner_cmd.t -> 'a eval_exit + +val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Cmdliner_term.t -> + 'a option * ('a eval_ok, eval_error) result + +val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> unit Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:int -> int Cmdliner_cmd.t -> Cmdliner_info.Exit.code + +val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> (unit, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code + +val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Cmdliner_info.Exit.code -> + (Cmdliner_info.Exit.code, string) result Cmdliner_cmd.t -> + Cmdliner_info.Exit.code diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_exit.ml b/src/reason-parser/vendor/cmdliner/cmdliner_exit.ml new file mode 100644 index 000000000..2231518d5 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_exit.ml @@ -0,0 +1,4 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_exit.mli b/src/reason-parser/vendor/cmdliner/cmdliner_exit.mli new file mode 100644 index 000000000..2231518d5 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_exit.mli @@ -0,0 +1,4 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_info.ml b/src/reason-parser/vendor/cmdliner/cmdliner_info.ml new file mode 100644 index 000000000..75b4e2019 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_info.ml @@ -0,0 +1,225 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Exit codes *) + +module Exit = struct + type code = int + + let ok = 0 + let some_error = 123 + let cli_error = 124 + let internal_error = 125 + + type info = + { codes : code * code; (* min, max *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?(docs = Cmdliner_manpage.s_exit_status) ?(doc = "undocumented") ?max min + = + let max = match max with None -> min | Some max -> max in + { codes = (min, max); doc; docs } + + let info_codes i = i.codes + let info_code i = fst i.codes + let info_doc i = i.doc + let info_docs i = i.docs + let info_order i0 i1 = compare i0.codes i1.codes + let defaults = + [ info ok ~doc:"on success."; + info some_error + ~doc:"on indiscriminate errors reported on standard error."; + info cli_error ~doc:"on command line parsing errors."; + info internal_error ~doc:"on unexpected internal errors (bugs)."; ] +end + +(* Environment variables *) + +module Env = struct + type var = string + type info = (* information about an environment variable. *) + { id : int; (* unique id for the env var. *) + deprecated : string option; + var : string; (* the variable. *) + doc : string; (* help. *) + docs : string; } (* title of help section where listed. *) + + let info + ?deprecated + ?(docs = Cmdliner_manpage.s_environment) ?(doc = "See option $(opt).") var + = + { id = Cmdliner_base.uid (); deprecated; var; doc; docs } + + let info_deprecated i = i.deprecated + let info_var i = i.var + let info_doc i = i.doc + let info_docs i = i.docs + let info_compare i0 i1 = compare i0.id i1.id + + module Set = Set.Make (struct type t = info let compare = info_compare end) +end + +(* Arguments *) + +module Arg = struct + type absence = Err | Val of string Lazy.t | Doc of string + type opt_kind = Flag | Opt | Opt_vopt of string + + type pos_kind = (* information about a positional argument. *) + { pos_rev : bool; (* if [true] positions are counted from the end. *) + pos_start : int; (* start positional argument. *) + pos_len : int option } (* number of arguments or [None] if unbounded. *) + + let pos ~rev:pos_rev ~start:pos_start ~len:pos_len = + { pos_rev; pos_start; pos_len} + + let pos_rev p = p.pos_rev + let pos_start p = p.pos_start + let pos_len p = p.pos_len + + type t = (* information about a command line argument. *) + { id : int; (* unique id for the argument. *) + deprecated : string option; (* deprecation message *) + absent : absence; (* behaviour if absent. *) + env : Env.info option; (* environment variable for default value. *) + doc : string; (* help. *) + docv : string; (* variable name for the argument in help. *) + docs : string; (* title of help section where listed. *) + pos : pos_kind; (* positional arg kind. *) + opt_kind : opt_kind; (* optional arg kind. *) + opt_names : string list; (* names (for opt args). *) + opt_all : bool; } (* repeatable (for opt args). *) + + let dumb_pos = pos ~rev:false ~start:(-1) ~len:None + + let v ?deprecated ?(absent = "") ?docs ?(docv = "") ?(doc = "") ?env names = + let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in + let opt_names = List.map dash names in + let docs = match docs with + | Some s -> s + | None -> + match names with + | [] -> Cmdliner_manpage.s_arguments + | _ -> Cmdliner_manpage.s_options + in + { id = Cmdliner_base.uid (); deprecated; absent = Doc absent; + env; doc; docv; docs; pos = dumb_pos; opt_kind = Flag; opt_names; + opt_all = false; } + + let id a = a.id + let deprecated a = a.deprecated + let absent a = a.absent + let env a = a.env + let doc a = a.doc + let docv a = a.docv + let docs a = a.docs + let pos_kind a = a.pos + let opt_kind a = a.opt_kind + let opt_names a = a.opt_names + let opt_all a = a.opt_all + let opt_name_sample a = + (* First long or short name (in that order) in the list; this + allows the client to control which name is shown *) + let rec find = function + | [] -> List.hd a.opt_names + | n :: ns -> if (String.length n) > 2 then n else find ns + in + find a.opt_names + + let make_req a = { a with absent = Err } + let make_all_opts a = { a with opt_all = true } + let make_opt ~absent ~kind:opt_kind a = { a with absent; opt_kind } + let make_opt_all ~absent ~kind:opt_kind a = + { a with absent; opt_kind; opt_all = true } + + let make_pos ~pos a = { a with pos } + let make_pos_abs ~absent ~pos a = { a with absent; pos } + + let is_opt a = a.opt_names <> [] + let is_pos a = a.opt_names = [] + let is_req a = a.absent = Err + + let pos_cli_order a0 a1 = (* best-effort order on the cli. *) + let c = compare (a0.pos.pos_rev) (a1.pos.pos_rev) in + if c <> 0 then c else + if a0.pos.pos_rev + then compare a1.pos.pos_start a0.pos.pos_start + else compare a0.pos.pos_start a1.pos.pos_start + + let rev_pos_cli_order a0 a1 = pos_cli_order a1 a0 + + let compare a0 a1 = compare a0.id a1.id + module Set = Set.Make (struct type nonrec t = t let compare = compare end) +end + +(* Commands *) + +module Cmd = struct + type t = + { name : string; (* name of the cmd. *) + version : string option; (* version (for --version). *) + deprecated : string option; (* deprecation message *) + doc : string; (* one line description of cmd. *) + docs : string; (* title of man section where listed (commands). *) + sdocs : string; (* standard options, title of section where listed. *) + exits : Exit.info list; (* exit codes for the cmd. *) + envs : Env.info list; (* env vars that influence the cmd. *) + man : Cmdliner_manpage.block list; (* man page text. *) + man_xrefs : Cmdliner_manpage.xref list; (* man cross-refs. *) + args : Arg.Set.t; (* Command arguments. *) + has_args : bool; (* [true] if has own parsing term. *) + children : t list; } (* Children, if any. *) + + let v + ?deprecated ?(man_xrefs = [`Main]) ?(man = []) ?(envs = []) + ?(exits = Exit.defaults) ?(sdocs = Cmdliner_manpage.s_common_options) + ?(docs = Cmdliner_manpage.s_commands) ?(doc = "") ?version name + = + { name; version; deprecated; doc; docs; sdocs; exits; + envs; man; man_xrefs; args = Arg.Set.empty; + has_args = true; children = [] } + + let name t = t.name + let version t = t.version + let deprecated t = t.deprecated + let doc t = t.doc + let docs t = t.docs + let stdopts_docs t = t.sdocs + let exits t = t.exits + let envs t = t.envs + let man t = t.man + let man_xrefs t = t.man_xrefs + let args t = t.args + let has_args t = t.has_args + let children t = t.children + let add_args t args = { t with args = Arg.Set.union args t.args } + let with_children cmd ~args ~children = + let has_args, args = match args with + | None -> false, cmd.args + | Some args -> true, Arg.Set.union args cmd.args + in + { cmd with has_args; args; children } +end + +(* Evaluation *) + +module Eval = struct + type t = (* information about the evaluation context. *) + { cmd : Cmd.t; (* cmd being evaluated. *) + parents : Cmd.t list; (* parents of cmd, root is last. *) + env : string -> string option; (* environment variable lookup. *) + err_ppf : Format.formatter (* error formatter *) } + + let v ~cmd ~parents ~env ~err_ppf = { cmd; parents; env; err_ppf } + + let cmd e = e.cmd + let parents e = e.parents + let env_var e v = e.env v + let err_ppf e = e.err_ppf + let main e = match List.rev e.parents with [] -> e.cmd | m :: _ -> m + let with_cmd ei cmd = { ei with cmd } +end diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_info.mli b/src/reason-parser/vendor/cmdliner/cmdliner_info.mli new file mode 100644 index 000000000..76ea15bc8 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_info.mli @@ -0,0 +1,139 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Exit codes, environment variables, arguments, commands and eval information. + + These information types gathers untyped data used to parse command + lines report errors and format man pages. *) + +(** Exit codes. *) +module Exit : sig + type code = int + val ok : code + val some_error : code + val cli_error : code + val internal_error : code + + type info + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + val info_code : info -> code + val info_codes : info -> code * code + val info_doc : info -> string + val info_docs : info -> string + val info_order : info -> info -> int + val defaults : info list +end + +(** Environment variables. *) +module Env : sig + type var = string + type info + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + val info_var : info -> string + val info_doc : info -> string + val info_docs : info -> string + val info_deprecated : info -> string option + + module Set : Set.S with type elt = info +end + +(** Arguments *) +module Arg : sig + + type absence = + | Err (** an error is reported. *) + | Val of string Lazy.t (** if <> "", takes the given default value. *) + | Doc of string + (** if <> "", a doc string interpreted in the doc markup language. *) + (** The type for what happens if the argument is absent from the cli. *) + + type opt_kind = + | Flag (** without value, just a flag. *) + | Opt (** with required value. *) + | Opt_vopt of string (** with optional value, takes given default. *) + (** The type for optional argument kinds. *) + + type pos_kind + val pos : rev:bool -> start:int -> len:int option -> pos_kind + val pos_rev : pos_kind -> bool + val pos_start : pos_kind -> int + val pos_len : pos_kind -> int option + + type t + val v : + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Env.info -> string list -> t + + val id : t -> int + val deprecated : t -> string option + val absent : t -> absence + val env : t -> Env.info option + val doc : t -> string + val docv : t -> string + val docs : t -> string + val opt_names : t -> string list (* has dashes *) + val opt_name_sample : t -> string (* warning must be an opt arg *) + val opt_kind : t -> opt_kind + val pos_kind : t -> pos_kind + + val make_req : t -> t + val make_all_opts : t -> t + val make_opt : absent:absence -> kind:opt_kind -> t -> t + val make_opt_all : absent:absence -> kind:opt_kind -> t -> t + val make_pos : pos:pos_kind -> t -> t + val make_pos_abs : absent:absence -> pos:pos_kind -> t -> t + + val is_opt : t -> bool + val is_pos : t -> bool + val is_req : t -> bool + + val pos_cli_order : t -> t -> int + val rev_pos_cli_order : t -> t -> int + + val compare : t -> t -> int + module Set : Set.S with type elt = t +end + +(** Commands. *) +module Cmd : sig + type t + val v : + ?deprecated:string -> + ?man_xrefs:Cmdliner_manpage.xref list -> ?man:Cmdliner_manpage.block list -> + ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> t + + val name : t -> string + val version : t -> string option + val deprecated : t -> string option + val doc : t -> string + val docs : t -> string + val stdopts_docs : t -> string + val exits : t -> Exit.info list + val envs : t -> Env.info list + val man : t -> Cmdliner_manpage.block list + val man_xrefs : t -> Cmdliner_manpage.xref list + val args : t -> Arg.Set.t + val has_args : t -> bool + val children : t -> t list + val add_args : t -> Arg.Set.t -> t + val with_children : t -> args:Arg.Set.t option -> children:t list -> t +end + +(** Evaluation. *) +module Eval : sig + type t + val v : + cmd:Cmd.t -> parents:Cmd.t list -> env:(string -> string option) -> + err_ppf:Format.formatter -> t + + val cmd : t -> Cmd.t + val main : t -> Cmd.t + val parents : t -> Cmd.t list + val env_var : t -> string -> string option + val err_ppf : t -> Format.formatter + val with_cmd : t -> Cmd.t -> t +end diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_manpage.ml b/src/reason-parser/vendor/cmdliner/cmdliner_manpage.ml new file mode 100644 index 000000000..63c12b2c9 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_manpage.ml @@ -0,0 +1,527 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Manpages *) + +type block = + [ `S of string | `P of string | `Pre of string | `I of string * string + | `Noblank | `Blocks of block list ] + +type title = string * int * string * string * string + +type t = title * block list + +type xref = + [ `Main | `Cmd of string | `Tool of string | `Page of string * int ] + +(* Standard sections *) + +let s_name = "NAME" +let s_synopsis = "SYNOPSIS" +let s_description = "DESCRIPTION" +let s_commands = "COMMANDS" +let s_arguments = "ARGUMENTS" +let s_options = "OPTIONS" +let s_common_options = "COMMON OPTIONS" +let s_exit_status = "EXIT STATUS" +let s_exit_status_intro = `P "$(iname) exits with:" + +let s_environment = "ENVIRONMENT" +let s_environment_intro = + `P "These environment variables affect the execution of $(iname):" + +let s_files = "FILES" +let s_examples = "EXAMPLES" +let s_bugs = "BUGS" +let s_authors = "AUTHORS" +let s_see_also = "SEE ALSO" +let s_none = "cmdliner-none" + +(* Section order *) + +let s_created = "" +let order = + [| s_name; s_synopsis; s_description; s_created; s_commands; + s_arguments; s_options; s_common_options; s_exit_status; + s_environment; s_files; s_examples; s_bugs; s_authors; s_see_also; + s_none; |] + +let order_synopsis = 1 +let order_created = 3 + +let section_of_order i = order.(i) +let section_to_order ~on_unknown s = + let max = Array.length order - 1 in + let rec loop i = match i > max with + | true -> on_unknown + | false -> if order.(i) = s then i else loop (i + 1) + in + loop 0 + +(* Section maps + + Section maps, maps section names to their section order and reversed + content blocks (content is not reversed in `Block blocks). The sections + are listed in reversed order. Unknown sections get the order of the last + known section. *) + +type smap = (string * (int * block list)) list + +let smap_of_blocks bs = (* N.B. this flattens `Blocks, not t.r. *) + let rec loop s s_o rbs smap = function + | [] -> s, s_o, rbs, smap + | `S new_sec :: bs -> + let new_o = section_to_order ~on_unknown:s_o new_sec in + loop new_sec new_o [] ((s, (s_o, rbs)):: smap) bs + | `Blocks blist :: bs -> + let s, s_o, rbs, rmap = loop s s_o rbs smap blist (* not t.r. *) in + loop s s_o rbs rmap bs + | (`P _ | `Pre _ | `I _ | `Noblank as c) :: bs -> + loop s s_o (c :: rbs) smap bs + in + let first, (bs : block list) = match bs with + | `S s :: bs -> s, bs + | `Blocks (`S s :: blist) :: bs -> s, (`Blocks blist) :: bs + | _ -> "", bs + in + let first_o = section_to_order ~on_unknown:order_synopsis first in + let s, s_o, rc, smap = loop first first_o [] [] bs in + (s, (s_o, rc)) :: smap + +let smap_to_blocks smap = (* N.B. this leaves `Blocks content untouched. *) + let rec loop acc smap s = function + | b :: rbs -> loop (b :: acc) smap s rbs + | [] -> + let acc = if s = "" then acc else `S s :: acc in + match smap with + | [] -> acc + | (_, (_, [])) :: smap -> loop acc smap "" [] (* skip empty section *) + | (s, (_, rbs)) :: smap -> + if s = s_none + then loop acc smap "" [] (* skip *) + else loop acc smap s rbs + in + loop [] smap "" [] + +let smap_has_section smap ~sec = List.exists (fun (s, _) -> sec = s) smap +let smap_append_block smap ~sec b = + let o = section_to_order ~on_unknown:order_created sec in + let try_insert = + let rec loop max_lt_o left = function + | (s', (o, rbs)) :: right when s' = sec -> + Ok (List.rev_append ((sec, (o, b :: rbs)) :: left) right) + | (_, (o', _) as s) :: right -> + let max_lt_o = if o' < o then max o' max_lt_o else max_lt_o in + loop max_lt_o (s :: left) right + | [] -> + if max_lt_o <> -1 then Error max_lt_o else + Ok (List.rev ((sec, (o, [b])) :: left)) + in + loop (-1) [] smap + in + match try_insert with + | Ok smap -> smap + | Error insert_before -> + let rec loop left = function + | (s', (o', _)) :: _ as right when o' = insert_before -> + List.rev_append ((sec, (o, [b])) :: left) right + | s :: ss -> loop (s :: left) ss + | [] -> assert false + in + loop [] smap + +(* Formatting tools *) + +let strf = Printf.sprintf +let pf = Format.fprintf +let pp_str = Format.pp_print_string +let pp_char = Format.pp_print_char +let pp_indent ppf c = for i = 1 to c do pp_char ppf ' ' done +let pp_lines = Cmdliner_base.pp_lines +let pp_tokens = Cmdliner_base.pp_tokens + +(* Cmdliner markup handling *) + +let err e fmt = pf e ("cmdliner error: " ^^ fmt ^^ "@.") +let err_unescaped ~errs c s = err errs "unescaped %C in %S" c s +let err_malformed ~errs s = err errs "Malformed $(…) in %S" s +let err_unclosed ~errs s = err errs "Unclosed $(…) in %S" s +let err_undef ~errs id s = err errs "Undefined variable $(%s) in %S" id s +let err_illegal_esc ~errs c s = err errs "Illegal escape char %C in %S" c s +let err_markup ~errs dir s = + err errs "Unknown cmdliner markup $(%c,…) in %S" dir s + +let is_markup_dir = function 'i' | 'b' -> true | _ -> false +let is_markup_esc = function '$' | '\\' | '(' | ')' -> true | _ -> false +let markup_need_esc = function '\\' | '$' -> true | _ -> false +let markup_text_need_esc = function '\\' | '$' | ')' -> true | _ -> false + +let escape s = (* escapes [s] from doc language. *) + let max_i = String.length s - 1 in + let rec escaped_len i l = + if i > max_i then l else + if markup_text_need_esc s.[i] then escaped_len (i + 1) (l + 2) else + escaped_len (i + 1) (l + 1) + in + let escaped_len = escaped_len 0 0 in + if escaped_len = String.length s then s else + let b = Bytes.create escaped_len in + let rec loop i k = + if i > max_i then Bytes.unsafe_to_string b else + let c = String.unsafe_get s i in + if not (markup_text_need_esc c) + then (Bytes.unsafe_set b k c; loop (i + 1) (k + 1)) + else (Bytes.unsafe_set b k '\\'; Bytes.unsafe_set b (k + 1) c; + loop (i + 1) (k + 2)) + in + loop 0 0 + +let subst_vars ~errs ~subst b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let skip_escape k start i = + if i > max_i then err_unescaped ~errs '\\' s else k start (i + 1) + in + let rec skip_markup k start i = + if i > max_i then (err_unclosed ~errs s; k start i) else + match s.[i] with + | '\\' -> skip_escape (skip_markup k) start (i + 1) + | ')' -> k start (i + 1) + | c -> skip_markup k start (i + 1) + in + let rec add_subst start i = + if i > max_i then (err_unclosed ~errs s; loop start i) else + if s.[i] <> ')' then add_subst start (i + 1) else + let id = String.sub s start (i - start) in + let next = i + 1 in + begin match subst id with + | None -> err_undef ~errs id s; Buffer.add_string b "undefined"; + | Some v -> Buffer.add_string b v + end; + loop next next + and loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> skip_escape loop start next + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> skip_markup loop start (min + 1) + | _ -> + let start_id = next + 1 in + flush start (i - 1); add_subst start_id start_id + end + | _ -> err_unescaped ~errs '$' s; loop start next + end; + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let add_markup_esc ~errs k b s start next target_need_escape target_escape = + let max_i = String.length s - 1 in + if next > max_i then err_unescaped ~errs '\\' s else + match s.[next] with + | c when not (is_markup_esc s.[next]) -> + err_illegal_esc ~errs c s; + k (next + 1) (next + 1) + | c -> + (if target_need_escape c then target_escape b c else Buffer.add_char b c); + k (next + 1) (next + 1) + +let add_markup_text ~errs k b s start target_need_escape target_escape = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let rec loop start i = + if i > max_i then (err_unclosed ~errs s; flush start max_i) else + let next = i + 1 in + match s.[i] with + | '\\' -> (* unescape *) + flush start (i - 1); + add_markup_esc ~errs loop b s start next + target_need_escape target_escape + | ')' -> flush start (i - 1); k next next + | c when markup_text_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c when target_need_escape c -> + flush start (i - 1); target_escape b c; loop next next + | c -> loop start next + in + loop start start + +(* Plain text output *) + +let markup_to_plain ~errs b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let need_escape _ = false in + let escape _ _ = assert false in + let rec loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> + flush start (i - 1); + add_markup_esc ~errs loop b s start next need_escape escape + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> + let markup = s.[min - 1] in + if not (is_markup_dir markup) + then (err_markup ~errs markup s; loop start next) else + let start_data = min + 1 in + (flush start (i - 1); + add_markup_text ~errs loop b s start_data need_escape escape) + | _ -> + err_malformed ~errs s; loop start next + end + | _ -> err_unescaped ~errs '$' s; loop start next + end + | c when markup_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let doc_to_plain ~errs ~subst b s = + markup_to_plain ~errs b (subst_vars ~errs ~subst b s) + +let p_indent = 7 (* paragraph indentation. *) +let l_indent = 4 (* label indentation. *) + +let pp_plain_blocks ~errs subst ppf ts = + let b = Buffer.create 1024 in + let markup t = doc_to_plain ~errs b ~subst t in + let pp_tokens ppf t = pp_tokens ~spaces:true ppf t in + let rec blank_line = function + | `Noblank :: ts -> loop ts + | ts -> Format.pp_print_cut ppf (); loop ts + and loop = function + | [] -> () + | t :: ts -> + match t with + | `Noblank -> loop ts + | `Blocks bs -> loop (bs @ ts) + | `P s -> + pf ppf "%a@[%a@]@," pp_indent p_indent pp_tokens (markup s); + blank_line ts + | `S s -> pf ppf "@[%a@]@," pp_tokens (markup s); loop ts + | `Pre s -> + pf ppf "%a@[%a@]@," pp_indent p_indent pp_lines (markup s); + blank_line ts + | `I (label, s) -> + let label = markup label and s = markup s in + pf ppf "@[%a@[%a@]" pp_indent p_indent pp_tokens label; + begin match s with + | "" -> pf ppf "@]@," + | s -> + let ll = String.length label in + if ll < l_indent + then (pf ppf "%a@[%a@]@]@," pp_indent (l_indent - ll) pp_tokens s) + else (pf ppf "@\n%a@[%a@]@]@," + pp_indent (p_indent + l_indent) pp_tokens s) + end; + blank_line ts + in + loop ts + +let pp_plain_page ~errs subst ppf (_, text) = + pf ppf "@[%a@]" (pp_plain_blocks ~errs subst) text + +(* Groff output *) + +let markup_to_groff ~errs b s = + let max_i = String.length s - 1 in + let flush start stop = match start > max_i with + | true -> () + | false -> Buffer.add_substring b s start (stop - start + 1) + in + let need_escape = function '.' | '\'' | '-' | '\\' -> true | _ -> false in + let escape b c = Printf.bprintf b "\\N'%d'" (Char.code c) in + let rec end_text start i = Buffer.add_string b "\\fR"; loop start i + and loop start i = + if i > max_i then flush start max_i else + let next = i + 1 in + match s.[i] with + | '\\' -> + flush start (i - 1); + add_markup_esc ~errs loop b s start next need_escape escape + | '$' -> + if next > max_i then err_unescaped ~errs '$' s else + begin match s.[next] with + | '(' -> + let min = next + 2 in + if min > max_i then (err_unclosed ~errs s; loop start next) else + begin match s.[min] with + | ',' -> + let start_data = min + 1 in + flush start (i - 1); + begin match s.[min - 1] with + | 'i' -> Buffer.add_string b "\\fI" + | 'b' -> Buffer.add_string b "\\fB" + | markup -> err_markup ~errs markup s + end; + add_markup_text ~errs end_text b s start_data need_escape escape + | _ -> err_malformed ~errs s; loop start next + end + | _ -> err_unescaped ~errs '$' s; flush start (i - 1); loop next next + end + | c when markup_need_esc c -> + err_unescaped ~errs c s; flush start (i - 1); loop next next + | c when need_escape c -> + flush start (i - 1); escape b c; loop next next + | c -> loop start next + in + (Buffer.clear b; loop 0 0; Buffer.contents b) + +let doc_to_groff ~errs ~subst b s = + markup_to_groff ~errs b (subst_vars ~errs ~subst b s) + +let pp_groff_blocks ~errs subst ppf text = + let buf = Buffer.create 1024 in + let markup t = doc_to_groff ~errs ~subst buf t in + let pp_tokens ppf t = pp_tokens ~spaces:false ppf t in + let rec pp_block = function + | `Blocks bs -> List.iter pp_block bs (* not T.R. *) + | `P s -> pf ppf "@\n.P@\n%a" pp_tokens (markup s) + | `Pre s -> pf ppf "@\n.P@\n.nf@\n%a@\n.fi" pp_lines (markup s) + | `S s -> pf ppf "@\n.SH %a" pp_tokens (markup s) + | `Noblank -> pf ppf "@\n.sp -1" + | `I (l, s) -> + pf ppf "@\n.TP 4@\n%a@\n%a" pp_tokens (markup l) pp_tokens (markup s) + in + List.iter pp_block text + +let pp_groff_page ~errs subst ppf ((n, s, a1, a2, a3), t) = + pf ppf ".\\\" Pipe this output to groff -m man -K utf8 -T utf8 | less -R@\n\ + .\\\"@\n\ + .mso an.tmac@\n\ + .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\ + .\\\" Disable hyphenation and ragged-right@\n\ + .nh@\n\ + .ad l\ + %a@?" + n s a1 a2 a3 (pp_groff_blocks ~errs subst) t + +(* Printing to a pager *) + +let pp_to_temp_file pp_v v = + try + let exec = Filename.basename Sys.argv.(0) in + let file, oc = Filename.open_temp_file exec "out" in + let ppf = Format.formatter_of_out_channel oc in + pp_v ppf v; Format.pp_print_flush ppf (); close_out oc; + at_exit (fun () -> try Sys.remove file with Sys_error e -> ()); + Some file + with Sys_error _ -> None + +let tmp_file_for_pager () = + try + let exec = Filename.basename Sys.argv.(0) in + let file = Filename.temp_file exec "tty" in + at_exit (fun () -> try Sys.remove file with Sys_error e -> ()); + Some file + with Sys_error _ -> None + +let find_cmd cmds = + let find_win32 (cmd, _args) = + (* `where` does not support full path lookups *) + if String.equal (Filename.basename cmd) cmd + then (Sys.command (strf "where %s 1> NUL 2> NUL" cmd) = 0) + else Sys.file_exists cmd + in + let find_posix (cmd, _args) = + Sys.command (strf "command -v %s 1>/dev/null 2>/dev/null" cmd) = 0 + in + let find = if Sys.win32 then find_win32 else find_posix in + try Some (List.find find cmds) with Not_found -> None + +let pp_to_pager print ppf v = + let pager = + let cmds = ["less", ""; "more", ""] in + let cmds = try (Sys.getenv "PAGER", "") :: cmds with Not_found -> cmds in + let cmds = try (Sys.getenv "MANPAGER", "") :: cmds with Not_found -> cmds in + find_cmd cmds + in + match pager with + | None -> print `Plain ppf v + | Some (pager, opts) -> + let pager = match Sys.win32 with + | false -> "LESS=FRX " ^ pager ^ opts + | true -> "set LESS=FRX && " ^ pager ^ opts + in + let groffer = + let cmds = + ["mandoc", " -m man -K utf-8 -T utf8"; + "groff", " -m man -K utf8 -T utf8"; + "nroff", ""] + in + find_cmd cmds + in + let cmd = match groffer with + | None -> + begin match pp_to_temp_file (print `Plain) v with + | None -> None + | Some f -> Some (strf "%s < %s" pager f) + end + | Some (groffer, opts) -> + let groffer = groffer ^ opts in + begin match pp_to_temp_file (print `Groff) v with + | None -> None + | Some f when Sys.win32 -> + (* For some obscure reason the pipe below does not + work. We need to use a temporary file. + https://github.com/dbuenzli/cmdliner/issues/166 *) + begin match tmp_file_for_pager () with + | None -> None + | Some tmp -> + Some (strf "%s <%s >%s && %s <%s" groffer f tmp pager tmp) + end + | Some f -> + Some (strf "%s < %s | %s" groffer f pager) + end + in + match cmd with + | None -> print `Plain ppf v + | Some cmd -> if (Sys.command cmd) <> 0 then print `Plain ppf v + +(* Output *) + +type format = [ `Auto | `Pager | `Plain | `Groff ] + +let rec print + ?(errs = Format.err_formatter) ?(subst = fun x -> None) fmt ppf page + = + match fmt with + | `Pager -> pp_to_pager (print ~errs ~subst) ppf page + | `Plain -> pp_plain_page ~errs subst ppf page + | `Groff -> pp_groff_page ~errs subst ppf page + | `Auto -> + let fmt = + match Sys.getenv "TERM" with + | exception Not_found when Sys.win32 -> `Pager + | exception Not_found -> `Plain + | "dumb" -> `Plain + | _ -> `Pager + in + print ~errs ~subst fmt ppf page diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_manpage.mli b/src/reason-parser/vendor/cmdliner/cmdliner_manpage.mli new file mode 100644 index 000000000..679fcaac0 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_manpage.mli @@ -0,0 +1,84 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Manpages. + + See {!Cmdliner.Manpage}. *) + +type block = + [ `S of string | `P of string | `Pre of string | `I of string * string + | `Noblank | `Blocks of block list ] + +val escape : string -> string +(** [escape s] escapes [s] from the doc language. *) + +type title = string * int * string * string * string + +type t = title * block list + +type xref = + [ `Main | `Cmd of string | `Tool of string | `Page of string * int ] + +(** {1 Standard section names} *) + +val s_name : string +val s_synopsis : string +val s_description : string +val s_commands : string +val s_arguments : string +val s_options : string +val s_common_options : string +val s_exit_status : string +val s_environment : string +val s_files : string +val s_bugs : string +val s_examples : string +val s_authors : string +val s_see_also : string +val s_none : string + +(** {1 Section maps} + + Used for handling the merging of metadata doc strings. *) + +type smap +val smap_of_blocks : block list -> smap +val smap_to_blocks : smap -> block list +val smap_has_section : smap -> sec:string -> bool +val smap_append_block : smap -> sec:string -> block -> smap +(** [smap_append_block smap sec b] appends [b] at the end of section + [sec] creating it at the right place if needed. *) + +(** {1 Content boilerplate} *) + +val s_exit_status_intro : block +val s_environment_intro : block + +(** {1 Output} *) + +type format = [ `Auto | `Pager | `Plain | `Groff ] +val print : + ?errs:Format.formatter -> ?subst:(string -> string option) -> format -> + Format.formatter -> t -> unit + +(** {1 Printers and escapes used by Cmdliner module} *) + +val subst_vars : + errs:Format.formatter -> subst:(string -> string option) -> Buffer.t -> + string -> string +(** [subst b ~subst s], using [b], substitutes in [s] variables of the form + "$(doc)" by their [subst] definition. This leaves escapes and markup + directives $(markup,…) intact. + + @raise Invalid_argument in case of illegal syntax. *) + +val doc_to_plain : + errs:Format.formatter -> subst:(string -> string option) -> Buffer.t -> + string -> string +(** [doc_to_plain b ~subst s] using [b], substitutes in [s] variables by + their [subst] definition and renders cmdliner directives to plain + text. + + @raise Invalid_argument in case of illegal syntax. *) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_msg.ml b/src/reason-parser/vendor/cmdliner/cmdliner_msg.ml new file mode 100644 index 000000000..f6bc55a1f --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_msg.ml @@ -0,0 +1,106 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +let strf = Printf.sprintf +let quote = Cmdliner_base.quote + +let pp = Format.fprintf +let pp_text = Cmdliner_base.pp_text +let pp_lines = Cmdliner_base.pp_lines + +(* Environment variable errors *) + +let err_env_parse env ~err = + let var = Cmdliner_info.Env.info_var env in + strf "environment variable %s: %s" (quote var) err + +(* Positional argument errors *) + +let err_pos_excess excess = + strf "too many arguments, don't know what to do with %s" + (String.concat ", " (List.map quote excess)) + +let err_pos_miss a = match Cmdliner_info.Arg.docv a with +| "" -> "a required argument is missing" +| v -> strf "required argument %s is missing" v + +let err_pos_misses = function +| [] -> assert false +| [a] -> err_pos_miss a +| args -> + let add_arg acc a = match Cmdliner_info.Arg.docv a with + | "" -> "ARG" :: acc + | argv -> argv :: acc + in + let rev_args = List.sort Cmdliner_info.Arg.rev_pos_cli_order args in + let args = List.fold_left add_arg [] rev_args in + let args = String.concat ", " args in + strf "required arguments %s are missing" args + +let err_pos_parse a ~err = match Cmdliner_info.Arg.docv a with +| "" -> err +| argv -> + match Cmdliner_info.Arg.(pos_len @@ pos_kind a) with + | Some 1 -> strf "%s argument: %s" argv err + | None | Some _ -> strf "%s… arguments: %s" argv err + +(* Optional argument errors *) + +let err_flag_value flag v = + strf "option %s is a flag, it cannot take the argument %s" + (quote flag) (quote v) + +let err_opt_value_missing f = strf "option %s needs an argument" (quote f) +let err_opt_parse f ~err = strf "option %s: %s" (quote f) err +let err_opt_repeated f f' = + if f = f' then strf "option %s cannot be repeated" (quote f) else + strf "options %s and %s cannot be present at the same time" + (quote f) (quote f') + +(* Argument errors *) + +let err_arg_missing a = + if Cmdliner_info.Arg.is_pos a then err_pos_miss a else + strf "required option %s is missing" (Cmdliner_info.Arg.opt_name_sample a) + +let err_cmd_missing ~dom = + strf "required COMMAND name is missing, must be %s." + (Cmdliner_base.alts_str ~quoted:true dom) + +(* Other messages *) + +let exec_name ei = Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei + +let pp_version ppf ei = + match Cmdliner_info.Cmd.version @@ Cmdliner_info.Eval.main ei with + | None -> assert false + | Some v -> pp ppf "@[%a@]@." Cmdliner_base.pp_text v + +let pp_try_help ppf ei = + let rcmds = Cmdliner_info.Eval.(cmd ei :: parents ei) in + match List.rev_map Cmdliner_info.Cmd.name rcmds with + | [] -> assert false + | [n] -> pp ppf "@[<2>Try '%s --help' for more information.@]" n + | n :: _ as cmds -> + let cmds = String.concat " " cmds in + pp ppf "@[<2>Try '%s --help' or '%s --help' for more information.@]" + cmds n + +let pp_err ppf ei ~err = pp ppf "%s: @[%a@]@." (exec_name ei) pp_lines err + +let pp_err_usage ppf ei ~err_lines ~err = + let pp_err = if err_lines then pp_lines else pp_text in + pp ppf "@[%s: @[%a@]@,@[Usage: @[%a@]@]@,%a@]@." + (exec_name ei) pp_err err (Cmdliner_docgen.pp_plain_synopsis ~errs:ppf) ei + pp_try_help ei + +let pp_backtrace ppf ei e bt = + let bt = Printexc.raw_backtrace_to_string bt in + let bt = + let len = String.length bt in + if len > 0 then String.sub bt 0 (len - 1) (* remove final '\n' *) else bt + in + pp ppf "%s: @[internal error, uncaught exception:@\n%a@]@." + (exec_name ei) pp_lines (strf "%s\n%s" (Printexc.to_string e) bt) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_msg.mli b/src/reason-parser/vendor/cmdliner/cmdliner_msg.mli new file mode 100644 index 000000000..ff6b4f2b9 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_msg.mli @@ -0,0 +1,40 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Messages for the end-user. *) + +(** {1:env_err Environment variable errors} *) + +val err_env_parse : Cmdliner_info.Env.info -> err:string -> string + +(** {1:pos_err Positional argument errors} *) + +val err_pos_excess : string list -> string +val err_pos_misses : Cmdliner_info.Arg.t list -> string +val err_pos_parse : Cmdliner_info.Arg.t -> err:string -> string + +(** {1:opt_err Optional argument errors} *) + +val err_flag_value : string -> string -> string +val err_opt_value_missing : string -> string +val err_opt_parse : string -> err:string -> string +val err_opt_repeated : string -> string -> string + +(** {1:arg_err Argument errors} *) + +val err_arg_missing : Cmdliner_info.Arg.t -> string +val err_cmd_missing : dom:string list -> string + +(** {1:msgs Other messages} *) + +val pp_version : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_try_help : Format.formatter -> Cmdliner_info.Eval.t -> unit +val pp_err : Format.formatter -> Cmdliner_info.Eval.t -> err:string -> unit +val pp_err_usage : + Format.formatter -> Cmdliner_info.Eval.t -> err_lines:bool -> err:string -> unit + +val pp_backtrace : + Format.formatter -> + Cmdliner_info.Eval.t -> exn -> Printexc.raw_backtrace -> unit diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_term.ml b/src/reason-parser/vendor/cmdliner/cmdliner_term.ml new file mode 100644 index 000000000..c65b74695 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_term.ml @@ -0,0 +1,95 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +type term_escape = + [ `Error of bool * string + | `Help of Cmdliner_manpage.format * string option ] + +type 'a parser = + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> + ('a, [ `Parse of string | term_escape ]) result + +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser + +let const v = Cmdliner_info.Arg.Set.empty, (fun _ _ -> Ok v) +let app (args_f, f) (args_v, v) = + Cmdliner_info.Arg.Set.union args_f args_v, + fun ei cl -> match (f ei cl) with + | Error _ as e -> e + | Ok f -> + match v ei cl with + | Error _ as e -> e + | Ok v -> Ok (f v) + +let map f v = app (const f) v +let product v0 v1 = app (app (const (fun x y -> (x, y))) v0) v1 + +(* +module Syntax = struct + let ( let+ ) v f = map f v + let ( and+ ) = product +end +*) + +(* Terms *) + +let ( $ ) = app + +type 'a ret = [ `Ok of 'a | term_escape ] + +let ret (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (`Ok v) -> Ok v + | Ok (`Error _ as err) -> Error err + | Ok (`Help _ as help) -> Error help + | Error _ as e -> e + +let term_result ?(usage = false) (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Error (usage, e)) + | Error _ as e -> e + +let map_error f = function + | Ok x -> Ok x + | Error e -> Error (f e) +let term_result' ?usage t = + let wrap = app (const (map_error (fun e -> `Msg e))) t in + term_result ?usage wrap + +let cli_parse_result (al, v) = + al, fun ei cl -> match v ei cl with + | Ok (Ok _ as ok) -> ok + | Ok (Error (`Msg e)) -> Error (`Parse e) + | Error _ as e -> e + +let cli_parse_result' t = + let wrap = app (const (map_error (fun e -> `Msg e))) t in + cli_parse_result wrap + +let main_name = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> Ok (Cmdliner_info.Cmd.name @@ Cmdliner_info.Eval.main ei)) + +let choice_names = + Cmdliner_info.Arg.Set.empty, + (fun ei _ -> + (* N.B. this keeps everything backward compatible. We return the command + names of main's children *) + let name t = Cmdliner_info.Cmd.name t in + let choices = Cmdliner_info.Cmd.children (Cmdliner_info.Eval.main ei) in + Ok (List.rev_map name choices)) + +let with_used_args (al, v) : (_ * string list) t = + al, fun ei cl -> + match v ei cl with + | Ok x -> + let actual_args arg_info acc = + let args = Cmdliner_cline.actual_args cl arg_info in + List.rev_append args acc + in + let used = List.rev (Cmdliner_info.Arg.Set.fold actual_args al []) in + Ok (x, used) + | Error _ as e -> e diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_term.mli b/src/reason-parser/vendor/cmdliner/cmdliner_term.mli new file mode 100644 index 000000000..003978c3d --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_term.mli @@ -0,0 +1,45 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Terms *) + +type term_escape = + [ `Error of bool * string + | `Help of Cmdliner_manpage.format * string option ] + +type 'a parser = + Cmdliner_info.Eval.t -> Cmdliner_cline.t -> + ('a, [ `Parse of string | term_escape ]) result +(** Type type for command line parser. given static information about + the command line and a command line to parse returns an OCaml value. *) + +type 'a t = Cmdliner_info.Arg.Set.t * 'a parser +(** The type for terms. The list of arguments it can parse and the parsing + function that does so. *) + +val const : 'a -> 'a t +val app : ('a -> 'b) t -> 'a t -> 'b t +val map : ('a -> 'b) -> 'a t -> 'b t +val product : 'a t -> 'b t -> ('a * 'b) t + +(* +module Syntax : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t +end + *) + +val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t + +type 'a ret = [ `Ok of 'a | term_escape ] + +val ret : 'a ret t -> 'a t +val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t +val term_result' : ?usage:bool -> ('a, string) result t -> 'a t +val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t +val cli_parse_result' : ('a, string) result t -> 'a t +val main_name : string t +val choice_names : string list t +val with_used_args : 'a t -> ('a * string list) t diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_term_deprecated.ml b/src/reason-parser/vendor/cmdliner/cmdliner_term_deprecated.ml new file mode 100644 index 000000000..5f48443da --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_term_deprecated.ml @@ -0,0 +1,77 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(* Term combinators *) + +let man_format = Cmdliner_arg.man_format +let pure = Cmdliner_term.const + +(* Term information *) + +type exit_info = Cmdliner_info.Exit.info +let exit_info = Cmdliner_info.Exit.info + +let exit_status_success = Cmdliner_info.Exit.ok +let exit_status_cli_error = Cmdliner_info.Exit.cli_error +let exit_status_internal_error = Cmdliner_info.Exit.internal_error +let default_error_exits = + [ exit_info exit_status_cli_error ~doc:"on command line parsing errors."; + exit_info exit_status_internal_error + ~doc:"on unexpected internal errors (bugs)."; ] + +let default_exits = + (exit_info exit_status_success ~doc:"on success.") :: default_error_exits + +type env_info = Cmdliner_info.Env.info +let env_info = Cmdliner_info.Env.info ?deprecated:None + +type info = Cmdliner_info.Cmd.t +let info + ?(man_xrefs = []) ?man ?envs ?(exits = []) + ?(sdocs = Cmdliner_manpage.s_options) ?docs ?doc ?version name + = + Cmdliner_info.Cmd.v + ~man_xrefs ?man ?envs ~exits ~sdocs ?docs ?doc ?version name + +let name ti = Cmdliner_info.Cmd.name ti + +(* Evaluation *) + +type 'a result = +[ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] + +let to_legacy_result = function +| Ok (#Cmdliner_eval.eval_ok as r) -> (r : 'a result) +| Error e -> `Error e + +let eval ?help ?err ?catch ?env ?argv (t, i) = + let cmd = Cmdliner_cmd.v i t in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_choice ?help ?err ?catch ?env ?argv (t, i) choices = + let sub (t, i) = Cmdliner_cmd.v i t in + let cmd = Cmdliner_cmd.group i ~default:t (List.map sub choices) in + to_legacy_result (Cmdliner_eval.eval_value ?help ?err ?catch ?env ?argv cmd) + +let eval_peek_opts ?version_opt ?env ?argv t = + let o, r = Cmdliner_eval.eval_peek_opts ?version_opt ?env ?argv t in + o, to_legacy_result r + +(* Exits *) + +let exit_status_of_result ?(term_err = 1) = function +| `Ok () | `Help | `Version -> exit_status_success +| `Error `Term -> term_err +| `Error `Exn -> exit_status_internal_error +| `Error `Parse -> exit_status_cli_error + +let exit_status_of_status_result ?term_err = function +| `Ok n -> n +| `Help | `Version | `Error _ as r -> exit_status_of_result ?term_err r + +let stdlib_exit = exit +let exit ?term_err r = stdlib_exit (exit_status_of_result ?term_err r) +let exit_status ?term_err r = + stdlib_exit (exit_status_of_status_result ?term_err r) diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_trie.ml b/src/reason-parser/vendor/cmdliner/cmdliner_trie.ml new file mode 100644 index 000000000..3444214ee --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_trie.ml @@ -0,0 +1,80 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +module Cmap = Map.Make (Char) (* character maps. *) + +type 'a value = (* type for holding a bound value. *) +| Pre of 'a (* value is bound by the prefix of a key. *) +| Key of 'a (* value is bound by an entire key. *) +| Amb (* no value bound because of ambiguous prefix. *) +| Nil (* not bound (only for the empty trie). *) + +type 'a t = { v : 'a value; succs : 'a t Cmap.t } +let empty = { v = Nil; succs = Cmap.empty } +let is_empty t = t = empty + +(* N.B. If we replace a non-ambiguous key, it becomes ambiguous but it's + not important for our use. Also the following is not tail recursive but + the stack is bounded by key length. *) +let add t k d = + let rec loop t k len i d pre_d = match i = len with + | true -> + let t' = { v = Key d; succs = t.succs } in + begin match t.v with + | Key old -> `Replaced (old, t') + | _ -> `New t' + end + | false -> + let v = match t.v with + | Amb | Pre _ -> Amb | Key _ as v -> v | Nil -> pre_d + in + let t' = try Cmap.find k.[i] t.succs with Not_found -> empty in + match loop t' k len (i + 1) d pre_d with + | `New n -> `New { v; succs = Cmap.add k.[i] n t.succs } + | `Replaced (o, n) -> + `Replaced (o, { v; succs = Cmap.add k.[i] n t.succs }) + in + loop t k (String.length k) 0 d (Pre d (* allocate less *)) + +let find_node t k = + let rec aux t k len i = + if i = len then t else + aux (Cmap.find k.[i] t.succs) k len (i + 1) + in + aux t k (String.length k) 0 + +let find t k = + try match (find_node t k).v with + | Key v | Pre v -> `Ok v | Amb -> `Ambiguous | Nil -> `Not_found + with Not_found -> `Not_found + +let ambiguities t p = (* ambiguities of [p] in [t]. *) + try + let t = find_node t p in + match t.v with + | Key _ | Pre _ | Nil -> [] + | Amb -> + let add_char s c = s ^ (String.make 1 c) in + let rem_char s = String.sub s 0 ((String.length s) - 1) in + let to_list m = Cmap.fold (fun k t acc -> (k,t) :: acc) m [] in + let rec aux acc p = function + | ((c, t) :: succs) :: rest -> + let p' = add_char p c in + let acc' = match t.v with + | Pre _ | Amb -> acc + | Key _ -> (p' :: acc) + | Nil -> assert false + in + aux acc' p' ((to_list t.succs) :: succs :: rest) + | [] :: [] -> acc + | [] :: rest -> aux acc (rem_char p) rest + | [] -> assert false + in + aux [] p (to_list t.succs :: []) + with Not_found -> [] + +let of_list l = + let add t (s, v) = match add t s v with `New t -> t | `Replaced (_, t) -> t in + List.fold_left add empty l diff --git a/src/reason-parser/vendor/cmdliner/cmdliner_trie.mli b/src/reason-parser/vendor/cmdliner/cmdliner_trie.mli new file mode 100644 index 000000000..decf40941 --- /dev/null +++ b/src/reason-parser/vendor/cmdliner/cmdliner_trie.mli @@ -0,0 +1,18 @@ +(*--------------------------------------------------------------------------- + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC + ---------------------------------------------------------------------------*) + +(** Tries. + + This implementation also maps any non ambiguous prefix of a + key to its value. *) + +type 'a t + +val empty : 'a t +val is_empty : 'a t -> bool +val add : 'a t -> string -> 'a -> [ `New of 'a t | `Replaced of 'a * 'a t ] +val find : 'a t -> string -> [ `Ok of 'a | `Ambiguous | `Not_found ] +val ambiguities : 'a t -> string -> string list +val of_list : (string * 'a) list -> 'a t diff --git a/src/reason-parser/vendor/cmdliner/dune b/src/reason-parser/vendor/cmdliner/dune index 7669c0b89..58daadf09 100644 --- a/src/reason-parser/vendor/cmdliner/dune +++ b/src/reason-parser/vendor/cmdliner/dune @@ -1,5 +1,4 @@ (library - (name ReasonCmdliner) + (name vendored_cmdliner) (public_name reason.cmdliner) - (wrapped false) - (flags :standard -w -3-27-32-35-50)) + (flags :standard -w -27-32-35-50)) diff --git a/src/reason-parser/vendor/cmdliner/vendored_cmdliner.ml b/src/reason-parser/vendor/cmdliner/vendored_cmdliner.ml index f75609c28..338e98789 100644 --- a/src/reason-parser/vendor/cmdliner/vendored_cmdliner.ml +++ b/src/reason-parser/vendor/cmdliner/vendored_cmdliner.ml @@ -1,1451 +1,17 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. - Distributed under a BSD3 license, see license at the end of the file. - cmdliner release 0.9.8 + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*) -let str = Printf.sprintf - -(* Invalid_arg strings *) - -let err_argv = "argv array must have at least one element" -let err_not_opt = "Option argument without name" -let err_not_pos = "Positional argument with a name" -let err_help s = "Term error, help requested for unknown command " ^ s -let err_empty_list = "Empty list" -let err_incomplete_enum = "Incomplete enumeration for the type" -let err_doc_string s = - str "Variable substitution failed on documentation fragment `%s'" s - -(* A few useful definitions. *) - -let rev_compare n n' = compare n' n -let pr = Format.fprintf -let pr_str = Format.pp_print_string -let pr_char = Format.pp_print_char -let str_of_pp pp v = pp Format.str_formatter v; Format.flush_str_formatter () -let quote s = str "`%s'" s -let alts_str ?(quoted = true) alts = - let quote = if quoted then quote else (fun s -> s) in - match alts with - | [] -> invalid_arg err_empty_list - | [a] -> (quote a) - | [a; b] -> str "either %s or %s" (quote a) (quote b) - | alts -> - let rev_alts = List.rev alts in - str "one of %s or %s" - (String.concat ", " (List.rev_map quote (List.tl rev_alts))) - (quote (List.hd rev_alts)) - -let pr_white_str spaces ppf s = (* spaces and new lines with Format's funs *) - let left = ref 0 and right = ref 0 and len = String.length s in - let flush () = - Format.pp_print_string ppf (String.sub s !left (!right - !left)); - incr right; left := !right; - in - while (!right <> len) do - if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else - if spaces && s.[!right] = ' ' then (flush (); Format.pp_print_space ppf ()) - else incr right; - done; - if !left <> len then flush () - -let pr_text = pr_white_str true -let pr_lines = pr_white_str false -let pr_to_temp_file pr v = try - let exec = Filename.basename Sys.argv.(0) in - let file, oc = Filename.open_temp_file exec "out" in - let ppf = Format.formatter_of_out_channel oc in - pr ppf v; Format.pp_print_flush ppf (); close_out oc; - at_exit (fun () -> try Sys.remove file with Sys_error e -> ()); - Some file -with Sys_error _ -> None - -(* Levenshtein distance, for making spelling suggestions in case of error. *) - -let levenshtein_distance s t = - (* As found here http://rosettacode.org/wiki/Levenshtein_distance#OCaml *) - let minimum a b c = min a (min b c) in - let m = String.length s in - let n = String.length t in - (* for all i and j, d.(i).(j) will hold the Levenshtein distance between - the first i characters of s and the first j characters of t *) - let d = Array.make_matrix (m+1) (n+1) 0 in - for i = 0 to m do d.(i).(0) <- i done; - for j = 0 to n do d.(0).(j) <- j done; - for j = 1 to n do - for i = 1 to m do - if s.[i-1] = t.[j-1] then - d.(i).(j) <- d.(i-1).(j-1) (* no operation required *) - else - d.(i).(j) <- minimum - (d.(i-1).(j) + 1) (* a deletion *) - (d.(i).(j-1) + 1) (* an insertion *) - (d.(i-1).(j-1) + 1) (* a substitution *) - done; - done; - d.(m).(n) - -let suggest s candidates = - let add (min, acc) name = - let d = levenshtein_distance s name in - if d = min then min, (name :: acc) else - if d < min then d, [name] else - min, acc - in - let dist, suggs = List.fold_left add (max_int, []) candidates in - if dist < 3 (* suggest only if not too far *) then suggs else [] - -(* Tries. This implementation also maps any non ambiguous prefix of a - key to its value. *) - -module Trie : sig - type 'a t - val empty : 'a t - val is_empty : 'a t -> bool - val add : 'a t -> string -> 'a -> 'a t - val find : 'a t -> string -> [ `Ok of 'a | `Ambiguous | `Not_found ] - val ambiguities : 'a t -> string -> string list - val of_list : (string * 'a) list -> 'a t -end = struct - module Cmap = Map.Make (Char) (* character maps. *) - type 'a value = (* type for holding a bound value. *) - | Pre of 'a (* value is bound by the prefix of a key. *) - | Key of 'a (* value is bound by an entire key. *) - | Amb (* no value bound because of ambiguous prefix. *) - | Nil (* not bound (only for the empty trie). *) - - type 'a t = { v : 'a value; succs : 'a t Cmap.t } - let empty = { v = Nil; succs = Cmap.empty } - let is_empty t = t = empty - - (* N.B. If we replace a non-ambiguous key, it becomes ambiguous but it's - not important for our use. Also the following is not tail recursive but - the stack is bounded by key length. *) - let add t k d = - let rec aux t k len i d pre_d = - if i = len then { v = Key d; succs = t.succs } else - let v = match t.v with - | Amb | Pre _ -> Amb | Key _ as v -> v | Nil -> pre_d - in - let succs = - let t' = try Cmap.find k.[i] t.succs with Not_found -> empty in - Cmap.add k.[i] (aux t' k len (i + 1) d pre_d) t.succs - in - { v; succs } - in - aux t k (String.length k) 0 d (Pre d (* allocate less *)) - - let find_node t k = - let rec aux t k len i = - if i = len then t else - aux (Cmap.find k.[i] t.succs) k len (i + 1) - in - aux t k (String.length k) 0 - - let find t k = - try match (find_node t k).v with - | Key v | Pre v -> `Ok v | Amb -> `Ambiguous | Nil -> `Not_found - with Not_found -> `Not_found - - let ambiguities t p = (* ambiguities of [p] in [t]. *) - try - let t = find_node t p in - match t.v with - | Key _ | Pre _ | Nil -> [] - | Amb -> - let add_char s c = s ^ (String.make 1 c) in - let rem_char s = String.sub s 0 ((String.length s) - 1) in - let to_list m = Cmap.fold (fun k t acc -> (k,t) :: acc) m [] in - let rec aux acc p = function - | ((c, t) :: succs) :: rest -> - let p' = add_char p c in - let acc' = match t.v with - | Pre _ | Amb -> acc - | Key _ -> (p' :: acc) - | Nil -> assert false - in - aux acc' p' ((to_list t.succs) :: succs :: rest) - | [] :: [] -> acc - | [] :: rest -> aux acc (rem_char p) rest - | [] -> assert false - in - aux [] p (to_list t.succs :: []) - with Not_found -> [] - - let of_list l = List.fold_left (fun t (s, v) -> add t s v) empty l -end - -(* The following types keep untyped information about arguments and - terms. This data is used to parse the command line, report errors - and format man page information. *) - -type env_info = (* information about an environment variable. *) - { env_var : string; (* the variable. *) - env_doc : string; (* help. *) - env_docs : string; } (* title of help section where listed. *) - -type absence = (* what happens if the argument is absent from the cl. *) - | Error (* an error is reported. *) - | Val of string Lazy.t (* if <> "", takes the given default value. *) - -type opt_kind = (* kinds of optional arguments. *) - | Flag (* just a flag, without value. *) - | Opt (* value is required. *) - | Opt_vopt of string (* option value is optional, takes given default. *) - -type pos_kind = (* kinds of positional arguments. *) - | All (* all positional arguments. *) - | Nth of bool * int (* specific position. *) - | Left of bool * int (* all args on the left of a position. *) - | Right of bool * int (* all args on the right of a position. *) - -type arg_info = (* information about a command line argument. *) - { id : int; (* unique id for the argument. *) - absent : absence; (* behaviour if absent. *) - env_info : env_info option; (* environment variable. *) - doc : string; (* help. *) - docv : string; (* variable name for the argument in help. *) - docs : string; (* title of help section where listed. *) - p_kind : pos_kind; (* positional arg kind. *) - o_kind : opt_kind; (* optional arg kind. *) - o_names : string list; (* names (for opt args). *) - o_all : bool; } (* repeatable (for opt args). *) - -let arg_id = (* thread-safe UIDs, Oo.id (object end) was used before. *) - let c = ref 0 in - fun () -> - let id = !c in - incr c; if id > !c then assert false (* too many ids *) else id - -let is_opt a = a.o_names <> [] -let is_pos a = a.o_names = [] - -module Amap = Map.Make (* arg info maps. *) - (struct type t = arg_info let compare a a' = compare a.id a'.id end) - -type arg = (* unconverted argument data as found on the command line. *) - | O of (int * string * (string option)) list (* (pos, name, value) of opt. *) - | P of string list - -type cmdline = arg Amap.t (* command line, maps arg_infos to arg value. *) - -type man_block = [ (* block of manpage text. *) - | `S of string | `P of string | `Pre of string | `I of string * string - | `Noblank ] - -type term_info = - { name : string; (* name of the term. *) - version : string option; (* version (for --version). *) - tdoc : string; (* one line description of term. *) - tdocs : string; (* title of man section where listed (commands). *) - sdocs : string; (* standard options, title of section where listed. *) - man : man_block list; } (* man page text. *) - -type eval_info = (* informatin about the evaluation context. *) - { term : term_info * arg_info list; (* term being evaluated. *) - main : term_info * arg_info list; (* main term. *) - choices : (term_info * arg_info list) list; (* all term choices. *) - env : string -> string option } (* environment variable lookup. *) - -let eval_kind ei = (* evaluation with multiple terms ? *) - if ei.choices = [] then `Simple else - if (fst ei.term) == (fst ei.main) then `M_main else `M_choice - -module Manpage = struct - type title = string * int * string * string * string - type block = man_block - type t = title * block list - - let p_indent = 7 (* paragraph indentation. *) - let l_indent = 4 (* label indentation. *) - let escape subst esc buf s = - let subst s = - let len = String.length s in - if not (len > 1 && s.[1] = ',') then (subst s) else - if len = 2 then "" else - esc s.[0] (String.sub s 2 (len - 2)) - in - try - Buffer.clear buf; Buffer.add_substitute buf subst s; - let s = Buffer.contents buf in (* twice for $(i,$(mname)). *) - Buffer.clear buf; Buffer.add_substitute buf subst s; - Buffer.contents buf - with Not_found -> invalid_arg (err_doc_string s) - - let pr_tokens ?(groff = false) ppf s = - let is_space = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false in - let len = String.length s in - let i = ref 0 in - try while (true) do - while (!i < len && is_space s.[!i]) do incr i done; - let start = !i in - if start = len then raise Exit; - while (!i < len && not (is_space s.[!i]) && not (s.[!i] = '-')) do - incr i - done; - pr_str ppf (String.sub s start (!i - start)); - if !i = len then raise Exit; - if s.[!i] = '-' then - (incr i; if groff then pr_str ppf "\\-" else pr_char ppf '-'); - if (!i < len && is_space s.[!i]) then - (if groff then pr_char ppf ' ' else Format.pp_print_space ppf ()) - done with Exit -> () - - (* Plain text output *) - - let plain_esc c s = match c with 'g' -> "" (* groff specific *) | _ -> s - let pr_indent ppf c = for i = 1 to c do pr_char ppf ' ' done - let pr_plain_blocks subst ppf ts = - let buf = Buffer.create 1024 in - let escape t = escape subst plain_esc buf t in - let pr_tokens ppf t = pr_tokens ppf (escape t) in - let rec aux = function - | [] -> () - | t :: ts -> - begin match t with - | `Noblank -> () - | `P s -> pr ppf "%a@[%a@]@," pr_indent p_indent pr_tokens s - | `S s -> pr ppf "@[%a@]" pr_tokens s - | `Pre s -> pr ppf "%a@[%a@]@," pr_indent p_indent pr_lines (escape s) - | `I (label, s) -> - let label = escape label in - let ll = String.length label in - pr ppf "@[%a@[%a@]" pr_indent p_indent pr_tokens label; - if s = "" then () else - if ll < l_indent then - pr ppf "%a@[%a@]@]@," pr_indent (l_indent - ll) pr_tokens s - else - pr ppf "@\n%a@[%a@]@]@," - pr_indent (p_indent + l_indent) pr_tokens s - end; - begin match ts with - | `Noblank :: ts -> aux ts - | ts -> Format.pp_print_cut ppf (); aux ts - end - in - aux ts - - let pr_plain_page subst ppf (_, text) = - pr ppf "@[%a@]" (pr_plain_blocks subst) text - - (* Groff output *) - - let groff_esc c s = match c with - | 'i' -> (str "\\fI%s\\fR" s) - | 'b' -> (str "\\fB%s\\fR" s) - | 'p' -> "" (* plain text specific *) - | _ -> s - - let pr_groff_lines ppf s = - let left = ref 0 and right = ref 0 and len = String.length s in - let flush () = - Format.pp_print_string ppf (String.sub s !left (!right - !left)); - incr right; left := !right; - in - while (!right <> len) do - if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else - if s.[!right] = '-' then (flush (); pr_str ppf "\\-") else - incr right; - done; - if !left <> len then flush () - - let pr_groff_blocks subst ppf text = - let buf = Buffer.create 1024 in - let escape t = escape subst groff_esc buf t in - let pr_tokens ppf t = pr_tokens ~groff:true ppf (escape t) in - let pr_block = function - | `P s -> pr ppf "@\n.P@\n%a" pr_tokens s - | `Pre s -> pr ppf "@\n.P@\n.nf@\n%a@\n.fi" pr_groff_lines (escape s) - | `S s -> pr ppf "@\n.SH %a" pr_tokens s - | `Noblank -> pr ppf "@\n.sp -1" - | `I (l, s) -> pr ppf "@\n.TP 4@\n%a@\n%a" pr_tokens l pr_tokens s - in - List.iter pr_block text - - let pr_groff_page subst ppf ((n, s, a1, a2, a3), t) = - pr ppf ".\\\" Pipe this output to groff -man -Tutf8 | less@\n\ - .\\\"@\n\ - .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\ - .\\\" Disable hyphenation and ragged-right@\n\ - .nh@\n\ - .ad l\ - %a@?" - n s a1 a2 a3 (pr_groff_blocks subst) t - - (* Printing to a pager *) - - let find_cmd cmds = - let test, null = match Sys.os_type with - | "Win32" -> "where", " NUL" - | _ -> "type", "/dev/null" - in - let cmd c = Sys.command (str "%s %s 1>%s 2>%s" test c null null) = 0 in - try Some (List.find cmd cmds) with Not_found -> None - - let pr_to_pager print ppf v = - let pager = - let cmds = ["less"; "more"] in - let cmds = try (Sys.getenv "PAGER") :: cmds with Not_found -> cmds in - let cmds = try (Sys.getenv "MANPAGER") :: cmds with Not_found -> cmds in - find_cmd cmds - in - match pager with - | None -> print `Plain ppf v - | Some pager -> - let cmd = match (find_cmd ["groff"; "nroff"]) with - | None -> - begin match pr_to_temp_file (print `Plain) v with - | None -> None - | Some f -> Some (str "%s < %s" pager f) - end - | Some c -> - begin match pr_to_temp_file (print `Groff) v with - | None -> None - | Some f -> - (* TODO use -Tutf8, but annoyingly maps U+002D to U+2212. *) - let xroff = if c = "groff" then c ^ " -Tascii -P-c" else c in - Some (str "%s -man < %s | %s" xroff f pager) - end - in - match cmd with - | None -> print `Plain ppf v - | Some cmd -> if (Sys.command cmd) <> 0 then print `Plain ppf v - - let rec print ?(subst = fun x -> x) fmt ppf page = match fmt with - | `Pager -> pr_to_pager (print ~subst) ppf page - | `Plain -> pr_plain_page subst ppf page - | `Groff -> pr_groff_page subst ppf page -end - -module Help = struct - let invocation ?(sep = ' ') ei = match eval_kind ei with - | `Simple | `M_main -> (fst ei.main).name - | `M_choice -> str "%s%c%s" (fst ei.main).name sep (fst ei.term).name - - let title ei = - let prog = String.capitalize_ascii (fst ei.main).name in - let name = String.uppercase_ascii (invocation ~sep:'-' ei) in - let left_footer = prog ^ match (fst ei.main).version with - | None -> "" | Some v -> str " %s" v - in - let center_header = str "%s Manual" prog in - name, 1, "", left_footer, center_header - - let name_section ei = - let tdoc d = if d = "" then "" else (str " - %s" d) in - [`S "NAME"; `P (str "%s%s" (invocation ~sep:'-' ei) - (tdoc (fst ei.term).tdoc)); ] - - let synopsis ei = match eval_kind ei with - | `M_main -> str "$(b,%s) $(i,COMMAND) ..." (invocation ei) - | `Simple | `M_choice -> - let rev_cmp (p, _) (p', _) = match p', p with (* best effort. *) - | p, All -> -1 | All, p -> 1 - | Left _, Right _ -> -1 | Right _, Left _ -> 1 - | Left (false, k), Nth (false, k') - | Nth (false, k), Nth (false, k') - | Nth (false, k), Right (false, k') -> if k <= k' then -1 else 1 - | Nth (false, k), Left (false, k') - | Right (false, k), Nth (false, k') -> if k >= k' then 1 else -1 - | Left (true, k), Nth (true, k') - | Nth (true, k), Nth (true, k') - | Nth (true, k), Right (true, k') -> if k >= k' then -1 else 1 - | Nth (true, k), Left (true, k') - | Right (true, k), Nth (true, k') -> if k <= k' then 1 else -1 - | p, p' -> compare p p' - in - let rec format_pos acc = function - | a :: al -> - if is_opt a then format_pos acc al else - let v = if a.docv = "" then "$(i,ARG)" else str "$(i,%s)" a.docv in - let v = if a.absent = Error then str "%s" v else str "[%s]" v in - let v = v ^ match a.p_kind with Nth _ -> "" | _ -> "..." in - format_pos ((a.p_kind, v) :: acc) al - | [] -> acc - in - let args = List.sort rev_cmp (format_pos [] (snd ei.term)) in - let args = String.concat " " (List.rev_map snd args) in - str "$(b,%s) [$(i,OPTION)]... %s" (invocation ei) args - - let get_synopsis_section ei = - let rec extract_synopsis syn = function - | `S _ :: _ as man -> List.rev syn, man - | block :: rest -> extract_synopsis (block :: syn) rest - | [] -> List.rev syn, [] - in - match (fst ei.term).man with - | `S "SYNOPSIS" as s :: rest -> extract_synopsis [s] rest (* user-defined *) - | man -> [ `S "SYNOPSIS"; `P (synopsis ei); ], man (* automatic *) - - let or_env a = match a.env_info with - | None -> "" - | Some v -> str " or $(i,%s) env" v.env_var - - let make_arg_label a = - if is_pos a then str "$(i,%s)" a.docv else - let fmt_name var = match a.o_kind with - | Flag -> fun n -> str "$(b,%s)%s" n (or_env a) - | Opt -> - fun n -> - if String.length n > 2 then str "$(b,%s)=$(i,%s)" n var else - str "$(b,%s) $(i,%s)" n var - | Opt_vopt _ -> - fun n -> - if String.length n > 2 then str "$(b,%s)[=$(i,%s)]" n var else - str "$(b,%s) [$(i,%s)]" n var - in - let var = if a.docv = "" then "VAL" else a.docv in - let names = List.sort compare a.o_names in - let s = String.concat ", " (List.rev_map (fmt_name var) names) in - s - - let arg_info_substs ~buf a doc = - let subst = function - | "docv" -> str "$(i,%s)" a.docv - | "opt" when is_opt a -> - let k = String.lowercase_ascii (List.hd (List.sort compare a.o_names)) in - str "$(b,%s)" k - | "env" when a.env_info <> None -> - begin match a.env_info with - | None -> assert false - | Some v -> str "$(i,%s)" v.env_var - end - | s -> str "$(%s)" s in - try - Buffer.clear buf; - Buffer.add_substitute buf subst doc; - Buffer.contents buf - with Not_found -> invalid_arg (err_doc_string doc) - - let make_arg_items ei = - let buf = Buffer.create 200 in - let cmp a a' = - let c = compare a.docs a'.docs in - if c <> 0 then c else - match is_opt a, is_opt a' with - | true, true -> - let key names = - let k = String.lowercase_ascii (List.hd (List.sort rev_compare names)) in - if k.[1] = '-' then String.sub k 1 (String.length k - 1) else k - in - compare (key a.o_names) (key a'.o_names) - | false, false -> - compare (String.lowercase_ascii a.docv) (String.lowercase_ascii a'.docv) - | true, false -> -1 - | false, true -> 1 - in - let format a = - let absent = match a.absent with - | Error -> "" - | Val v -> match Lazy.force v with - | "" -> "" - | v -> str "absent=%s%s" v (or_env a) - in - let optvopt = match a.o_kind with - | Opt_vopt v -> str "default=%s" v - | _ -> "" - in - let argvdoc = match optvopt, absent with - | "", "" -> "" - | s, "" | "", s -> str " (%s)" s - | s, s' -> str " (%s) (%s)" s s' - in - (a.docs, `I (make_arg_label a ^ argvdoc, (arg_info_substs ~buf a a.doc))) - in - let is_arg_item a = not (is_pos a && (a.docv = "" || a.doc = "")) in - let l = List.sort cmp (List.filter is_arg_item (snd ei.term)) in - List.rev_map format l - - let make_env_items_rev ei = - let buf = Buffer.create 200 in - let cmp a a' = - let e' = match a'.env_info with None -> assert false | Some a' -> a' in - let e = match a.env_info with None -> assert false | Some a -> a in - let c = compare e.env_docs e'.env_docs in - if c <> 0 then c else - compare e.env_var e'.env_var - in - let format a = - let e = match a.env_info with None -> assert false | Some a -> a in - (e.env_docs, - `I (str "$(i,%s)" e.env_var, arg_info_substs ~buf a e.env_doc)) - in - let is_env_item a = a.env_info <> None in - let l = List.sort cmp (List.filter is_env_item (snd ei.term)) in - List.rev_map format l - - let make_cmd_items ei = match eval_kind ei with - | `Simple | `M_choice -> [] - | `M_main -> - let add_cmd acc (ti, _) = - (ti.tdocs, `I ((str "$(b,%s)" ti.name), ti.tdoc)) :: acc - in - List.sort rev_compare (List.fold_left add_cmd [] ei.choices) - - let text ei = (* man that code is particulary unreadable. *) - let rec merge_items acc to_insert mark il = function - | `S s as sec :: ts -> - let acc = List.rev_append to_insert acc in - let acc = if mark then sec :: `Orphan_mark :: acc else sec :: acc in - let to_insert, il = List.partition (fun (n, _) -> n = s) il in - let to_insert = List.rev_map (fun (_, i) -> i) to_insert in - let to_insert = (to_insert :> [ `Orphan_mark | Manpage.block] list) in - merge_items acc to_insert (s = "DESCRIPTION") il ts - | t :: ts -> - let t = (t :> [`Orphan_mark | Manpage.block]) in - merge_items (t :: acc) to_insert mark il ts - | [] -> - let acc = List.rev_append to_insert acc in - (if mark then `Orphan_mark :: acc else acc), il - in - let rec merge_orphans acc orphans = function - | `Orphan_mark :: ts -> - let rec merge acc s = function - | [] -> (`S s) :: acc - | (s', i) :: ss -> - let i = (i :> Manpage.block) in - if s = s' then merge (i :: acc) s ss else - merge (i :: (`S s) :: acc) s' ss - in - let acc = match orphans with - | [] -> acc | (s, _) :: _ -> merge acc s orphans - in - merge_orphans acc [] ts - | (#Manpage.block as e) :: ts -> merge_orphans (e :: acc) orphans ts - | [] -> acc - in - let cmds = make_cmd_items ei in - let args = make_arg_items ei in - let envs_rev = make_env_items_rev ei in - let items_rev = List.rev_append cmds (List.rev_append args envs_rev) in - let cmp (s, _) (s', _) = match s, s with - | "ENVIRONMENT VARIABLES", _ -> 1 (* Put env vars at the end. *) - | s, "ENVIRONMENT VARIABLES" -> -1 - | s, s' -> compare s s' (* other predefined sec. names order correctly *) - in - let items = List.rev (List.stable_sort cmp items_rev) in - let synopsis, man = get_synopsis_section ei in - let rev_text, orphans = merge_items [`Orphan_mark] [] false items man in - synopsis @ merge_orphans [] orphans rev_text - - let ei_subst ei = function - | "tname" -> (fst ei.term).name - | "mname" -> (fst ei.main).name - | s -> str "$(%s)" s - - let man ei = - title ei, (name_section ei) @ (text ei) - - let print fmt ppf ei = Manpage.print ~subst:(ei_subst ei) fmt ppf (man ei) - let pr_synopsis ppf ei = - pr ppf "@[%s@]" - (Manpage.escape (ei_subst ei) - Manpage.plain_esc (Buffer.create 100) (synopsis ei)) - - let pr_version ppf ei = match (fst ei.main).version with - | None -> assert false - | Some v -> pr ppf "@[%a@]@." pr_text v -end - -(* Errors for the command line user *) - -module Err = struct - let invalid kind s exp = str "invalid %s %s, %s" kind (quote s) exp - let invalid_val = invalid "value" - let no kind s = str "no %s %s" (quote s) kind - let not_dir s = str "%s is not a directory" (quote s) - let is_dir s = str "%s is a directory" (quote s) - let element kind s exp = str "invalid element in %s (`%s'): %s" kind s exp - let sep_miss sep s = invalid_val s (str "missing a `%c' separator" sep) - let unknown kind ?(hints = []) v = - let did_you_mean s = str ", did you mean %s ?" s in - let hints = match hints with [] -> "." | hs -> did_you_mean (alts_str hs) in - str "unknown %s %s%s" kind (quote v) hints - - let ambiguous kind s ambs = - str "%s %s ambiguous and could be %s" kind (quote s) (alts_str ambs) - - let pos_excess excess = - str "too many arguments, don't know what to do with %s" - (String.concat ", " (List.map quote excess)) - - let flag_value f v = - str "option %s is a flag, it cannot take the argument %s" - (quote f) (quote v) - - let opt_value_missing f = str "option %s needs an argument" (quote f) - let opt_parse_value f e = str "option %s: %s" (quote f) e - let env_parse_value var e = str "environment variable %s: %s" (quote var) e - let opt_repeated f f' = - if f = f' then str "option %s cannot be repeated" (quote f) else - str "options %s and %s cannot be present at the same time" (quote f) - (quote f') - - let pos_parse_value a e = - if a.docv = "" then e else match a.p_kind with - | Nth _ -> str "%s argument: %s" a.docv e - | _ -> str "%s... arguments: %s" a.docv e - - let arg_missing a = - if is_opt a then - let rec long_name = function - | n :: l -> if (String.length n) > 2 || l = [] then n else long_name l - | [] -> assert false - in - str "required option %s is missing" (long_name a.o_names) - else - if a.docv = "" then str "a required argument is missing" else - str "required argument %s is missing" a.docv - - (* Error printers *) - - let print ppf ei e = pr ppf "%s: @[%a@]@." (fst ei.main).name pr_text e - let pr_backtrace err ei e bt = - let bt = - let len = String.length bt in - if len > 0 then String.sub bt 0 (len - 1) (* remove final '\n' *) else bt - in - pr err - "%s: @[internal error, uncaught exception:@\n%a@]@." - (fst ei.main).name pr_lines (str "%s\n%s" (Printexc.to_string e) bt) - - let pr_try_help ppf ei = - let exec = Help.invocation ei in - let main = (fst ei.main).name in - if exec = main then - pr ppf "@[<2>Try `%s --help' for more information.@]" exec - else - pr ppf "@[<2>Try `%s --help' or `%s --help' for more information.@]" - exec main - - let pr_usage ppf ei e = - pr ppf "@[%s: @[%a@]@,@[Usage: @[%a@]@]@,%a@]@." - (fst ei.main).name pr_text e Help.pr_synopsis ei pr_try_help ei -end - -(* Command lines. A command line stores pre-parsed information about - the command line's arguments in a more structured way. Given the - [arg_info] values mentionned in a term and Sys.argv (whithout exec - name) we parse the command line into a map of [arg_info] values to - [arg] values. This map is used by the term's closures to retrieve - and convert command line arguments (see the Arg module). *) - -module Cmdline :sig - exception Error of string - val choose_term : term_info -> (term_info * 'a) list -> string list -> - term_info * string list - val create : ?peek_opts:bool -> arg_info list -> string list -> cmdline - val opt_arg : cmdline -> arg_info -> (int * string * (string option)) list - val pos_arg : cmdline -> arg_info -> string list -end = struct - exception Error of string - - let opt_arg cl a = match try Amap.find a cl with Not_found -> assert false - with O l -> l | _ -> assert false - - let pos_arg cl a = match try Amap.find a cl with Not_found -> assert false - with P l -> l | _ -> assert false - - let choose_term ti choices = function - | [] -> ti, [] - | maybe :: args' as args -> - if String.length maybe > 1 && maybe.[0] = '-' then ti, args else - let index = - let add acc (choice, _) = Trie.add acc choice.name choice in - List.fold_left add Trie.empty choices - in - match Trie.find index maybe with - | `Ok choice -> choice, args' - | `Not_found -> - let all = Trie.ambiguities index "" in - let hints = suggest maybe all in - raise (Error (Err.unknown "command" ~hints maybe)) - | `Ambiguous -> - let ambs = List.sort compare (Trie.ambiguities index maybe) in - raise (Error (Err.ambiguous "command" maybe ambs)) - - let arg_info_indexes al = - (* from [al] returns a trie mapping the names of optional arguments to - their arg_info, a list with all arg_info for positional arguments and - a cmdline mapping each arg_info to an empty [arg]. *) - let rec aux opti posi cl = function - | a :: l -> - if is_pos a then aux opti (a :: posi) (Amap.add a (P []) cl) l else - let add t name = Trie.add t name a in - aux (List.fold_left add opti a.o_names) posi (Amap.add a (O []) cl) l - | [] -> opti, posi, cl - in - aux Trie.empty [] Amap.empty al - - let parse_opt_arg s = (* (name,value) of opt arg, assert len > 1. *) - let l = String.length s in - if s.[1] <> '-' then - if l = 2 then s, None else - String.sub s 0 2, Some (String.sub s 2 (l - 2)) - else try - let i = String.index s '=' in - String.sub s 0 i, Some (String.sub s (i + 1) (l - i - 1)) - with Not_found -> s, None - - let parse_args ~peek_opts opti cl args = - (* returns an updated [cl] cmdline according to the options found in [args] - with the trie index [opti]. Positional arguments are returned in order - in a list. *) - let rec aux k opti cl pargs = function - | [] -> cl, (List.rev pargs) - | "--" :: args -> cl, (List.rev_append pargs args) - | s :: args -> - let is_opt s = String.length s > 1 && s.[0] = '-' in - let is_short_opt s = String.length s = 2 && s.[0] = '-' in - if not (is_opt s) then aux (k+1) opti cl (s :: pargs) args else - let name, value = parse_opt_arg s in - match Trie.find opti name with - | `Ok a -> - let value, args = match value, a.o_kind with - | Some v, Flag when is_short_opt name -> None, ("-" ^ v) :: args - | Some v, _ -> value, args - | None, Flag -> value, args - | None, _ -> - match args with - | v :: rest -> if is_opt v then None, args else Some v, rest - | [] -> None, args - in - let arg = O ((k, name, value) :: opt_arg cl a) in - aux (k+1) opti (Amap.add a arg cl) pargs args - | `Not_found when peek_opts -> aux (k+1) opti cl pargs args (* skip *) - | `Not_found -> - let hints = - if String.length s <= 2 then [] else - let short_opt, long_opt = - if s.[1] <> '-' - then s, Printf.sprintf "-%s" s - else String.sub s 1 (String.length s - 1), s - in - let short_opt, _ = parse_opt_arg short_opt in - let long_opt, _ = parse_opt_arg long_opt in - let all = Trie.ambiguities opti "-" in - match List.mem short_opt all, suggest long_opt all with - | false, [] -> [] - | false, l -> l - | true, [] -> [short_opt] - | true, l -> if List.mem short_opt l then l else short_opt :: l - in - raise (Error (Err.unknown "option" ~hints name)) - | `Ambiguous -> - let ambs = List.sort compare (Trie.ambiguities opti name) in - raise (Error (Err.ambiguous "option" name ambs)) - in - aux 0 opti cl [] args - - let process_pos_args posi cl pargs = - (* returns an updated [cl] cmdline in which each positional arg mentionned - in the list index posi, is given a value according the list - of positional arguments values [pargs]. *) - if pargs = [] then cl else - let rec take n acc l = - if n = 0 then List.rev acc else - take (n - 1) (List.hd l :: acc) (List.tl l) - in - let rec aux pargs last cl max_spec = function - | a :: al -> - let arg, max_spec = match a.p_kind with - | All -> P pargs, last - | Nth (rev, k) -> - let k = if rev then last - k else k in - let max_spec = max k max_spec in - if k < 0 || k > last then P [], max_spec else - P ([List.nth pargs k]), max_spec - | Left (rev, k) -> - let k = if rev then last - k else k in - let max_spec = max k max_spec in - if k <= 0 || k > last then P [], max_spec else - P (take k [] pargs), max_spec - | Right (rev, k) -> - let k = if rev then last - k else k in - if k < 0 || k >= last then P [], last else - P (List.rev (take (last - k) [] (List.rev pargs))), last - in - aux pargs last (Amap.add a arg cl) max_spec al - | [] -> cl, max_spec - in - let last = List.length pargs - 1 in - let cl, max_spec = aux pargs last cl (-1) posi in - if last <= max_spec then cl else - let excess = List.rev (take (last - max_spec) [] (List.rev pargs)) in - raise (Error (Err.pos_excess excess)) - - let create ?(peek_opts = false) al args = - let opti, posi, cl = arg_info_indexes al in - let cl, pargs = parse_args ~peek_opts opti cl args in - if peek_opts then cl (* skip positional arguments *) else - process_pos_args posi cl pargs -end - -module Arg = struct - type 'a parser = string -> [ `Ok of 'a | `Error of string ] - type 'a printer = Format.formatter -> 'a -> unit - type 'a converter = 'a parser * 'a printer - type env = env_info - type 'a arg_converter = (eval_info -> cmdline -> 'a) - type 'a t = arg_info list * 'a arg_converter - type info = arg_info - - let env_var ?(docs = "ENVIRONMENT VARIABLES") ?(doc = "See option $(opt).") - env_var - = - { env_var = env_var; env_doc = doc; env_docs = docs } - - let ( & ) f x = f x - let parse_error e = raise (Cmdline.Error e) - let some ?(none = "") (parse, print) = - (fun s -> match parse s with `Ok v -> `Ok (Some v) | `Error _ as e -> e), - (fun ppf v -> match v with None -> pr_str ppf none| Some v -> print ppf v) - - let info ?docs ?(docv = "") ?(doc = "") ?env names = - let dash n = if String.length n = 1 then "-" ^ n else "--" ^ n in - let docs = match docs with - | None -> if names = [] then "ARGUMENTS" else "OPTIONS" - | Some s -> s - in - { id = arg_id (); absent = Val (lazy ""); - env_info = env; - doc = doc; docv = docv; docs = docs; - p_kind = All; o_kind = Flag; o_names = List.rev_map dash names; - o_all = false; } - - let env_bool_parse s = match String.lowercase_ascii s with - | "" | "false" | "no" | "n" | "0" -> `Ok false - | "true" | "yes" | "y" | "1" -> `Ok true - | s -> `Error (Err.invalid_val s (alts_str ["true"; "yes"; "false"; "no" ])) - - let parse_to_list parser s = match parser s with - | `Ok v -> `Ok [v] - | `Error _ as e -> e - - let try_env ei a parse ~absent = match a.env_info with - | None -> absent - | Some env -> - match ei.env env.env_var with - | None -> absent - | Some v -> - match parse v with - | `Ok v -> v - | `Error e -> - parse_error (Err.env_parse_value env.env_var e) - - let flag a = - if is_pos a then invalid_arg err_not_opt else - let convert ei cl = match Cmdline.opt_arg cl a with - | [] -> try_env ei a env_bool_parse ~absent:false - | [_, _, None] -> true - | [_, f, Some v] -> parse_error (Err.flag_value f v) - | (_, f, _) :: (_ ,g, _) :: _ -> parse_error (Err.opt_repeated f g) - in - [a], convert - - let flag_all a = - if is_pos a then invalid_arg err_not_opt else - let a = { a with o_all = true } in - let convert ei cl = match Cmdline.opt_arg cl a with - | [] -> try_env ei a (parse_to_list env_bool_parse) ~absent:[] - | l -> - let truth (_, f, v) = match v with - | None -> true | Some v -> parse_error (Err.flag_value f v) - in - List.rev_map truth l - in - [a], convert - - let vflag v l = - let convert _ cl = - let rec aux fv = function - | (v, a) :: rest -> - begin match Cmdline.opt_arg cl a with - | [] -> aux fv rest - | [_, f, None] -> - begin match fv with - | None -> aux (Some (f, v)) rest - | Some (g, _) -> parse_error (Err.opt_repeated g f) - end - | [_, f, Some v] -> parse_error (Err.flag_value f v) - | (_, f, _) :: (_, g, _) :: _ -> parse_error (Err.opt_repeated g f) - end - | [] -> match fv with None -> v | Some (_, v) -> v - in - aux None l - in - let flag (_, a) = if is_pos a then invalid_arg err_not_opt else a in - List.rev_map flag l, convert - - let vflag_all v l = - let convert _ cl = - let rec aux acc = function - | (fv, a) :: rest -> - begin match Cmdline.opt_arg cl a with - | [] -> aux acc rest - | l -> - let fval (k, f, v) = match v with - | None -> (k, fv) | Some v -> parse_error (Err.flag_value f v) - in - aux (List.rev_append (List.rev_map fval l) acc) rest - end - | [] -> - if acc = [] then v else List.rev_map snd (List.sort rev_compare acc) - in - aux [] l - in - let flag (_, a) = - if is_pos a then invalid_arg err_not_opt else { a with o_all = true } - in - List.rev_map flag l, convert - - let parse_opt_value parse f v = match parse v with - | `Ok v -> v | `Error e -> parse_error (Err.opt_parse_value f e) - - let opt ?vopt (parse, print) v a = - if is_pos a then invalid_arg err_not_opt else - let a = { a with absent = Val (lazy (str_of_pp print v)); - o_kind = match vopt with - | None -> Opt | Some dv -> Opt_vopt (str_of_pp print dv) } - in - let convert ei cl = match Cmdline.opt_arg cl a with - | [] -> try_env ei a parse ~absent:v - | [_, f, Some v] -> parse_opt_value parse f v - | [_, f, None] -> - begin match vopt with - | None -> parse_error (Err.opt_value_missing f) - | Some optv -> optv - end - | (_, f, _) :: (_, g, _) :: _ -> parse_error (Err.opt_repeated g f) - in - [a], convert - - let opt_all ?vopt (parse, print) v a = - if is_pos a then invalid_arg err_not_opt else - let a = { a with absent = Val (lazy ""); o_all = true; - o_kind = match vopt with - | None -> Opt | Some dv -> Opt_vopt (str_of_pp print dv) } - in - let convert ei cl = match Cmdline.opt_arg cl a with - | [] -> try_env ei a (parse_to_list parse) ~absent:v - | l -> - let parse (k, f, v) = match v with - | Some v -> (k, parse_opt_value parse f v) - | None -> match vopt with - | None -> parse_error (Err.opt_value_missing f) - | Some dv -> (k, dv) - in - List.rev_map snd (List.sort rev_compare (List.rev_map parse l)) - in - [a], convert - - (* Positional arguments *) - - let parse_pos_value parse a v = match parse v with - | `Ok v -> v | `Error e -> parse_error (Err.pos_parse_value a e) - - let pos ?(rev = false) k (parse, print) v a = - if is_opt a then invalid_arg err_not_pos else - let a = { a with p_kind = Nth (rev, k); - absent = Val (lazy (str_of_pp print v)) } - in - let convert ei cl = match Cmdline.pos_arg cl a with - | [] -> try_env ei a parse ~absent:v - | [v] -> parse_pos_value parse a v - | _ -> assert false - in - [a], convert - - let pos_list kind (parse, _) v a = - if is_opt a then invalid_arg err_not_pos else - let a = { a with p_kind = kind } in - let convert ei cl = match Cmdline.pos_arg cl a with - | [] -> try_env ei a (parse_to_list parse) ~absent:v - | l -> List.rev (List.rev_map (parse_pos_value parse a) l) - in - [a], convert - - let pos_all c v a = pos_list All c v a - let pos_left ?(rev = false) k = pos_list (Left (rev, k)) - let pos_right ?(rev = false) k = pos_list (Right (rev, k)) - - (* Arguments as terms *) - - let absent_error al = List.rev_map (fun a -> { a with absent = Error }) al - let value a = a - let required (al, convert) = - let al = absent_error al in - let convert ei cl = match convert ei cl with - | Some v -> v - | None -> parse_error (Err.arg_missing (List.hd al)) - in - al, convert - - let non_empty (al, convert) = - let al = absent_error al in - let convert ei cl = match convert ei cl with - | [] -> parse_error (Err.arg_missing (List.hd al)) - | l -> l - in - al, convert - - let last (al, convert) = - let convert ei cl = match convert ei cl with - | [] -> parse_error (Err.arg_missing (List.hd al)) - | l -> List.hd (List.rev l) - in - al, convert - - (* Predefined converters. *) - - let bool = - (fun s -> try `Ok (bool_of_string s) with Invalid_argument _ -> - `Error (Err.invalid_val s (alts_str ["true"; "false"]))), - Format.pp_print_bool - - let char = - (fun s -> if String.length s = 1 then `Ok s.[0] else - `Error (Err.invalid_val s "expected a character")), - pr_char - - let parse_with t_of_str exp s = - try `Ok (t_of_str s) with Failure _ -> `Error (Err.invalid_val s exp) - - let int = - parse_with int_of_string "expected an integer", Format.pp_print_int - - let int32 = - parse_with Int32.of_string "expected a 32-bit integer", - (fun ppf -> pr ppf "%ld") - - let int64 = - parse_with Int64.of_string "expected a 64-bit integer", - (fun ppf -> pr ppf "%Ld") - - let nativeint = - parse_with Nativeint.of_string "expected a processor-native integer", - (fun ppf -> pr ppf "%nd") - - let float = - parse_with float_of_string "expected a floating point number", - Format.pp_print_float - - let string = (fun s -> `Ok s), pr_str - let enum sl = - if sl = [] then invalid_arg err_empty_list else - let t = Trie.of_list sl in - let parse s = match Trie.find t s with - | `Ok _ as r -> r - | `Ambiguous -> - let ambs = List.sort compare (Trie.ambiguities t s) in - `Error (Err.ambiguous "enum value" s ambs) - | `Not_found -> - let alts = List.rev (List.rev_map (fun (s, _) -> s) sl) in - `Error (Err.invalid_val s ("expected " ^ (alts_str alts))) - in - let print ppf v = - let sl_inv = List.rev_map (fun (s,v) -> (v,s)) sl in - try pr_str ppf (List.assoc v sl_inv) - with Not_found -> invalid_arg err_incomplete_enum - in - parse, print - - let file = - (fun s -> if Sys.file_exists s then `Ok s else - `Error (Err.no "file or directory" s)), - pr_str - - let dir = - (fun s -> - if Sys.file_exists s then - if Sys.is_directory s then `Ok s else `Error (Err.not_dir s) - else - `Error (Err.no "directory" s)), - pr_str - - let non_dir_file = - (fun s -> - if Sys.file_exists s then - if not (Sys.is_directory s) then `Ok s else `Error (Err.is_dir s) - else - `Error (Err.no "file" s)), - pr_str - - let split_and_parse sep parse s = - let parse sub = match parse sub with - | `Error e -> failwith e | `Ok v -> v in - let rec split accum j = - let i = try String.rindex_from s j sep with Not_found -> -1 in - if (i = -1) then - let p = String.sub s 0 (j + 1) in - if p <> "" then parse p :: accum else accum - else - let p = String.sub s (i + 1) (j - i) in - let accum' = if p <> "" then parse p :: accum else accum in - split accum' (i - 1) - in - split [] (String.length s - 1) - - let list ?(sep = ',') (parse, pr_e) = - let parse s = try `Ok (split_and_parse sep parse s) with - | Failure e -> `Error (Err.element "list" s e) - in - let rec print ppf = function - | v :: l -> pr_e ppf v; if (l <> []) then (pr_char ppf sep; print ppf l) - | [] -> () - in - parse, print - - let array ?(sep = ',') (parse, pr_e) = - let parse s = try `Ok (Array.of_list (split_and_parse sep parse s)) with - | Failure e -> `Error (Err.element "array" s e) - in - let print ppf v = - let max = Array.length v - 1 in - for i = 0 to max do pr_e ppf v.(i); if i <> max then pr_char ppf sep done - in - parse, print - - let split_left sep s = - try - let i = String.index s sep in - let len = String.length s in - Some ((String.sub s 0 i), (String.sub s (i + 1) (len - i - 1))) - with Not_found -> None - - let pair ?(sep = ',') (pa0, pr0) (pa1, pr1) = - let parser s = match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some (v0, v1) -> - match pa0 v0, pa1 v1 with - | `Ok v0, `Ok v1 -> `Ok (v0, v1) - | `Error e, _ | _, `Error e -> `Error (Err.element "pair" s e) - in - let printer ppf (v0, v1) = pr ppf "%a%c%a" pr0 v0 sep pr1 v1 in - parser, printer - - let t2 = pair - let t3 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) = - let parse s = match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some (v0, s) -> - match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some (v1, v2) -> - match pa0 v0, pa1 v1, pa2 v2 with - | `Ok v0, `Ok v1, `Ok v2 -> `Ok (v0, v1, v2) - | `Error e, _, _ | _, `Error e, _ | _, _, `Error e -> - `Error (Err.element "triple" s e) - in - let print ppf (v0, v1, v2) = - pr ppf "%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2 - in - parse, print - - let t4 ?(sep = ',') (pa0, pr0) (pa1, pr1) (pa2, pr2) (pa3, pr3) = - let parse s = match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some(v0, s) -> - match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some (v1, s) -> - match split_left sep s with - | None -> `Error (Err.sep_miss sep s) - | Some (v2, v3) -> - match pa0 v0, pa1 v1, pa2 v2, pa3 v3 with - | `Ok v1, `Ok v2, `Ok v3, `Ok v4 -> `Ok (v1, v2, v3, v4) - | `Error e, _, _, _ | _, `Error e, _, _ | _, _, `Error e, _ - | _, _, _, `Error e -> `Error (Err.element "quadruple" s e) - in - let print ppf (v0, v1, v2, v3) = - pr ppf "%a%c%a%c%a%c%a" pr0 v0 sep pr1 v1 sep pr2 v2 sep pr3 v3 - in - parse, print - - (* Documentation formatting helpers *) - - let doc_quote = quote - let doc_alts = alts_str - let doc_alts_enum ?quoted enum = alts_str ?quoted (List.map fst enum) -end - +module Manpage = Cmdliner_manpage module Term = struct - type info = term_info - type +'a t = arg_info list * (eval_info -> cmdline -> 'a) - type 'a result = [ - | `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] - - exception Term of - [ `Help of [`Pager | `Plain | `Groff] * string option - | `Error of bool * string ] - - let info ?(sdocs = "OPTIONS") ?(man = []) ?(docs = "COMMANDS") ?(doc = "") - ?version name = - { name = name; version = version; tdoc = doc; tdocs = docs; sdocs = sdocs; - man = man } - - let name ti = ti.name - let const v = [], (fun _ _ -> v) - let pure (* deprecated *) = const - let app (al, f) (al', v) = - List.rev_append al al', - fun ei cl -> (f ei cl) (v ei cl) - - let ( $ ) = app - - type 'a ret = - [ `Help of [`Pager | `Plain | `Groff] * string option - | `Error of (bool * string) - | `Ok of 'a ] - - let ret (al, v) = - al, fun ei cl -> match v ei cl with - | `Ok v -> v - | `Error (u,e) -> raise (Term (`Error (u,e))) - | `Help h -> raise (Term (`Help h)) - - let main_name = [], (fun ei _ -> (fst ei.main).name) - let choice_names = - [], fun ei _ -> List.rev_map (fun e -> (fst e).name) ei.choices - - let man_format = - let fmts = ["pager", `Pager; "groff", `Groff; "plain", `Plain] in - let doc = "Show output in format $(docv) (pager, plain or groff)."in - Arg.(value & opt (enum fmts) `Pager & info ["man-format"] ~docv:"FMT" ~doc) - - (* Evaluation *) - - let remove_exec argv = - try List.tl (Array.to_list argv) with Failure _ -> invalid_arg err_argv - - let add_std_opts ei = - let docs = (fst ei.term).sdocs in - let args, v_lookup = - if (fst ei.main).version = None then [], None else - let (a, lookup) = - Arg.flag (Arg.info ["version"] ~docs ~doc:"Show version information.") - in - a, Some lookup - in - let args, h_lookup = - let (a, lookup) = - let fmt = Arg.enum ["pager",`Pager; "groff",`Groff; "plain",`Plain] in - let doc = "Show this help in format $(docv) (pager, plain or groff)."in - let a = Arg.info ["help"] ~docv:"FMT" ~docs ~doc in - Arg.opt ~vopt:(Some `Pager) (Arg.some fmt) None a - in - List.rev_append a args, lookup - in - h_lookup, v_lookup, - { ei with term = (fst ei.term), List.rev_append args (snd ei.term) } - - let eval_term help err ei f args = - let help_arg, vers_arg, ei = add_std_opts ei in - try - let cl = Cmdline.create (snd ei.term) args in - match help_arg ei cl, vers_arg with - | Some fmt, _ -> Help.print fmt help ei; `Help - | None, Some v_arg when v_arg ei cl -> Help.pr_version help ei; `Version - | _ -> `Ok (f ei cl) - with - | Cmdline.Error e -> Err.pr_usage err ei e; `Error `Parse - | Term (`Error (usage, e)) -> - if usage then Err.pr_usage err ei e else Err.print err ei e; - `Error `Term - | Term (`Help (fmt, cmd)) -> - let ei = match cmd with - | Some cmd -> - let cmd = - try List.find (fun (i, _) -> i.name = cmd) ei.choices - with Not_found -> invalid_arg (err_help cmd) - in - {ei with term = cmd } - | None -> { ei with term = ei.main } - in - let _, _, ei = add_std_opts ei in - Help.print fmt help ei; `Help - - let env_default v = try Some (Sys.getenv v) with Not_found -> None - - let eval ?(help = Format.std_formatter) ?(err = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) ((al, f), ti) = - let term = ti, al in - let ei = { term = term; main = term; choices = []; env = env } in - try eval_term help err ei f (remove_exec argv) with - | e when catch -> - Err.pr_backtrace err ei e (Printexc.get_backtrace ()); `Error `Exn - - let eval_choice ?(help = Format.std_formatter) ?(err = Format.err_formatter) - ?(catch = true) ?(env = env_default) ?(argv = Sys.argv) - (((al, f) as t), ti) choices = - let ei_choices = List.rev_map (fun ((al, _), ti) -> ti, al) choices in - let main = (ti, al) in - let ei = { term = main; main = main; choices = ei_choices; env = env } in - try - let chosen, args = Cmdline.choose_term ti ei_choices (remove_exec argv) in - let find_chosen (_, ti) = ti = chosen in - let (al, f), _ = List.find find_chosen ((t, ti) :: choices) in - let ei = { ei with term = (chosen, al) } in - eval_term help err ei f args - with - | Cmdline.Error e -> (* may be raised by choose_term. *) - Err.pr_usage err ei e; `Error `Parse - | e when catch -> - Err.pr_backtrace err ei e (Printexc.get_backtrace ()); `Error `Exn - - let eval_peek_opts ?(version_opt = false) ?(env = env_default) - ?(argv = Sys.argv) (al, f) = - let args = remove_exec argv in - let version = if version_opt then Some "dummy" else None in - let term = info ?version "dummy", al in - let ei = { term = term; main = term; choices = []; env = env } in - let help_arg, vers_arg, ei = add_std_opts ei in - try - let cl = Cmdline.create ~peek_opts:true (snd ei.term) args in - match help_arg ei cl, vers_arg with - | Some fmt, _ -> - (try (Some (f ei cl), `Help) with e -> None, `Help) - | None, Some v_arg when v_arg ei cl -> - (try (Some (f ei cl), `Version) with e -> None, `Version) - | _ -> - let v = f ei cl in - Some v, `Ok v - with - | Cmdline.Error _ -> None, (`Error `Parse) - | Term _ -> None, (`Error `Term) - | e -> None, (`Error `Exn) + include Cmdliner_term + include Cmdliner_term_deprecated end - -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - 3. Neither the name of Daniel C. Bünzli nor the names of - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR - A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT - OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT - LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, - DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY - THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - ---------------------------------------------------------------------------*) +module Cmd = struct + module Exit = Cmdliner_info.Exit + module Env = Cmdliner_info.Env + include Cmdliner_cmd + include Cmdliner_eval +end +module Arg = Cmdliner_arg diff --git a/src/reason-parser/vendor/cmdliner/vendored_cmdliner.mli b/src/reason-parser/vendor/cmdliner/vendored_cmdliner.mli index ee196bcf6..fcaaca7a0 100644 --- a/src/reason-parser/vendor/cmdliner/vendored_cmdliner.mli +++ b/src/reason-parser/vendor/cmdliner/vendored_cmdliner.mli @@ -1,60 +1,56 @@ (*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli. All rights reserved. - Distributed under a BSD3 license, see license at the end of the file. - cmdliner release 0.9.8 + Copyright (c) 2011 The cmdliner programmers. All rights reserved. + SPDX-License-Identifier: ISC ---------------------------------------------------------------------------*) (** Declarative definition of command line interfaces. - [Cmdliner] provides a simple and compositional mechanism - to convert command line arguments to OCaml values and pass them to - your functions. The module automatically handles syntax errors, - help messages and UNIX man page generation. It supports programs - with single or multiple commands - (like [darcs] or [git]) and respect most of the - {{:http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap12.html} - POSIX} and - {{:http://www.gnu.org/software/libc/manual/html_node/Argument-Syntax.html} - GNU} conventions. + Consult the {{!page-tutorial}tutorial}, details about the supported + {{!page-cli}command line syntax} and {{!page-examples}examples} of + use. - Consult the {{!basics}basics}, details about the supported - {{!cmdline}command line syntax} and {{!examples} examples} of - use. Open the module to use it, it defines only three modules in - your scope. - - {e Release 0.9.8 - Daniel Bünzli } *) - -(** {1:top Interface} *) + Open the module to use it, it defines only three modules in your + scope. *) (** Man page specification. - Man page generation is automatically handled by [Cmdliner]. The - {!block} type is used to define a man page's content. + Man page generation is automatically handled by [Cmdliner], + consult the {{!page-tool_man.manual}details}. - The {!print} function can be useful if the client wants to define - other man pages (e.g. to implement a help command). *) + The {!Manpage.block} type is used to define a man page's + content. It's a good idea to follow the + {{!Manpage.standard_sections}standard} manual page structure. + + {b References.} + {ul + {- [man-pages(7)], {{:http://man7.org/linux/man-pages/man7/man-pages.7.html} + {e Conventions for writing Linux man pages}}.}} *) module Manpage : sig (** {1:man Man pages} *) type block = [ `S of string | `P of string | `Pre of string | `I of string * string - | `Noblank ] + | `Noblank | `Blocks of block list ] (** The type for a block of man page text. {ul - {- [`S s] introduces a new section [s].} + {- [`S s] introduces a new section [s], see the + {{!standard_sections}standard section names}.} {- [`P t] is a new paragraph with text [t].} {- [`Pre t] is a new preformatted paragraph with text [t].} {- [`I (l,t)] is an indented paragraph with label - [l] and text [t].} - {- [`Noblank] suppresses the blank line introduced between two blocks.}} + [l] and text [t].} + {- [`Noblank] suppresses the blank line introduced between two blocks.} + {- [`Blocks bs] splices the blocks [bs].}} Except in [`Pre], whitespace and newlines are not significant - and are all collapsed to a single space. In labels [l] and text - strings [t], the syntax ["$(i,italic text)"] and ["$(b,bold - text)"] can be used to respectively produce italic and bold - text. *) + and are all collapsed to a single space. All block strings + support the {{!page-tool_man.doclang}documentation markup language}.*) + + val escape : string -> string + (** [escape s] escapes [s] so that it doesn't get interpreted by the + {{!page-tool_man.doclang}documentation markup language}. *) type title = string * int * string * string * string (** The type for man page titles. Describes the man page @@ -63,20 +59,114 @@ module Manpage : sig type t = title * block list (** The type for a man page. A title and the page text as a list of blocks. *) - val print : ?subst:(string -> string) -> - [`Pager | `Plain | `Groff ] -> Format.formatter -> t -> unit - (** [print ~subst fmt ppf page] prints [page] on [ppf] in the format [fmt]. - If [fmt] is [`Pager] the function tries to write the formatted - result in a pager, if that fails the format [`Plain] is written - on [ppf]. [subst] can be used to perform variable substitution, - see {!Buffer.add_substitute} (defaults to the identity). *) + type xref = + [ `Main | `Cmd of string | `Tool of string | `Page of string * int ] + (** The type for man page cross-references. + {ul + {- [`Main] refers to the man page of the program itself.} + {- [`Cmd cmd] refers to the man page of the program's [cmd] + command (which must exist).} + {- [`Tool bin] refers to the command line tool named [bin].} + {- [`Page (name, sec)] refers to the man page [name(sec)].}} *) + + (** {1:standard_sections Standard section names and content} + + The following are standard man page section names, roughly ordered + in the order they conventionally appear. See also + {{:http://man7.org/linux/man-pages/man7/man-pages.7.html}[man man-pages]} + for more elaborations about what sections should contain. *) + + val s_name : string + (** The [NAME] section. This section is automatically created by + [Cmdliner] for your. *) + + val s_synopsis : string + (** The [SYNOPSIS] section. By default this section is automatically + created by [Cmdliner] for you, unless it is the first section of + your term's man page, in which case it will replace it with yours. *) + + val s_description : string + (** The [DESCRIPTION] section. This should be a description of what + the tool does and provide a little bit of usage and + documentation guidance. *) + + val s_commands : string + (** The [COMMANDS] section. By default subcommands get listed here. *) + + val s_arguments : string + (** The [ARGUMENTS] section. By default positional arguments get + listed here. *) + + val s_options : string + (** The [OPTIONS] section. By default optional arguments get + listed here. *) + + val s_common_options : string + (** The [COMMON OPTIONS] section. By default help and version options get + listed here. For programs with multiple commands, optional arguments + common to all commands can be added here. *) + + val s_exit_status : string + (** The [EXIT STATUS] section. By default term status exit codes + get listed here. *) + + val s_environment : string + (** The [ENVIRONMENT] section. By default environment variables get + listed here. *) + + val s_environment_intro : block + (** [s_environment_intro] is the introduction content used by cmdliner + when it creates the {!s_environment} section. *) + + val s_files : string + (** The [FILES] section. *) + + val s_bugs : string + (** The [BUGS] section. *) + + val s_examples : string + (** The [EXAMPLES] section. *) + + val s_authors : string + (** The [AUTHORS] section. *) + + val s_see_also : string + (** The [SEE ALSO] section. *) + + val s_none : string + (** [s_none] is a special section named ["cmdliner-none"] that can be used + whenever you do not want something to be listed. *) + + (** {1:output Output} + + The {!print} function can be useful if the client wants to define + other man pages (e.g. to implement a help command). *) + + type format = [ `Auto | `Pager | `Plain | `Groff ] + (** The type for man page output specification. + {ul + {- [`Auto], formats like [`Pager] or [`Plain] whenever the [TERM] + environment variable is [dumb] or unset.} + {- [`Pager], tries to write to a discovered pager, if that fails + uses the [`Plain] format.} + {- [`Plain], formats to plain text.} + {- [`Groff], formats to groff commands.}} *) + + val print : + ?errs:Format.formatter -> + ?subst:(string -> string option) -> format -> Format.formatter -> t -> unit + (** [print ~errs ~subst fmt ppf page] prints [page] on [ppf] in the + format [fmt]. [subst] can be used to perform variable + substitution,(defaults to the identity). [errs] is used to print + formatting errors, it defaults to {!Format.err_formatter}. *) end (** Terms. - A term is evaluated by a program to produce a {{!result}result}. - A term made of terms referring to {{!Arg}command line arguments} - implicitly defines a command line syntax. *) + A term is evaluated by a program to produce a {{!Term.result}result}, + which can be turned into an {{!Term.exits}exit status}. A term made of terms + referring to {{!Arg}command line arguments} implicitly defines a + command line syntax. *) module Term : sig (** {1:terms Terms} *) @@ -87,11 +177,6 @@ module Term : sig val const : 'a -> 'a t (** [const v] is a term that evaluates to [v]. *) - (**/**) - val pure : 'a -> 'a t - (** @deprecated use {!const} instead. *) - (**/**) - val ( $ ) : ('a -> 'b) t -> 'a t -> 'b t (** [f $ v] is a term that evaluates to the result of applying the evaluation of [v] to the one of [f]. *) @@ -99,46 +184,156 @@ module Term : sig val app : ('a -> 'b) t -> 'a t -> 'b t (** [app] is {!($)}. *) + val map : ('a -> 'b) -> 'a t -> 'b t + (** [map f t] is [app (const f) t]. *) + + val product : 'a t -> 'b t -> ('a * 'b) t + (** [product t0 t1] is [app (app (map (fun x y -> (x, y)) t0) t1)] *) + + (** [let] operators. *) +(* + module Syntax : sig + val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t + (** [( let+ )] is {!map}. *) + + val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t + (** [( and* )] is {!product}. *) + end +*) + + (** {1 Interacting with Cmdliner's evaluation} *) + + val term_result : ?usage:bool -> ('a, [`Msg of string]) result t -> 'a t + (** [term_result ~usage t] evaluates to + {ul + {- [`Ok v] if [t] evaluates to [Ok v]} + {- [`Error `Term] with the error message [e] and usage shown according + to [usage] (defaults to [false]), if [t] evaluates to + [Error (`Msg e)].}} + + See also {!term_result'}. *) + + val term_result' : ?usage:bool -> ('a, string) result t -> 'a t + (** [term_result'] is like {!term_result} but with a [string] + error case. *) + + val cli_parse_result : ('a, [`Msg of string]) result t -> 'a t + (** [cli_parse_result t] is a term that evaluates to: + {ul + {- [`Ok v] if [t] evaluates to [Ok v].} + {- [`Error `Parse] with the error message [e] + if [t] evaluates to [Error (`Msg e)].}} + + See also {!cli_parse_result'}. *) + + val cli_parse_result' : ('a, string) result t -> 'a t + (** [cli_parse_result'] is like {!cli_parse_result} but with a [string] + error case. *) + + val main_name : string t + (** [main_name] is a term that evaluates to the main command name; + that is the name of the tool. *) + + val choice_names : string list t + (** [choice_names] is a term that evaluates to the names of the commands + that are children of the main command. *) + + val with_used_args : 'a t -> ('a * string list) t + (** [with_used_args t] is a term that evaluates to [t] tupled + with the arguments from the command line that where used to + evaluate [t]. *) + type 'a ret = - [ `Help of [`Pager | `Plain | `Groff] * string option - | `Error of (bool * string) - | `Ok of 'a ] - (** The type for command return values. See {!ret}. *) + [ `Help of Manpage.format * string option + | `Error of (bool * string) + | `Ok of 'a ] + (** The type for command return values. See {!val-ret}. *) val ret : 'a ret t -> 'a t (** [ret v] is a term whose evaluation depends on the case to which [v] evaluates. With : {ul - {- [`Ok r], it evaluates to [r].} - {- [`Error (usage,e)], the evaluation fails and [Cmdliner] prints + {- [`Ok v], it evaluates to [v].} + {- [`Error (usage, e)], the evaluation fails and [Cmdliner] prints the error [e] and the term's usage if [usage] is [true].} - {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints the - term's man page in the given [format] (or the man page for a - specific [name] term in case of multiple term evaluation).}} *) + {- [`Help (format, name)], the evaluation fails and [Cmdliner] prints + a manpage in format [format]. If [name] is [None] this is the + the main command's manpage. If [name] is [Some c] this is + the man page of the sub command [c] of the main command.}} - val main_name : string t - (** [main_name] is a term that evaluates to the "main" term's name. *) + {b Note.} While not deprecated you are encouraged not use this API. *) - val choice_names : string list t - (** [choice_names] is a term that evaluates to the names of the terms - to choose from. *) + (** {1:deprecated Deprecated Term evaluation interface} - val man_format : [`Pager | `Plain | `Groff] t - (** [man_format] is a term that defines a [--man-format] option and - evaluates to a value that can be used with {!Manpage.print}. *) + This interface is deprecated in favor of {!Cmdliner.Cmd}. Follow + the compiler deprecation warning hints to transition. *) - (** {1:tinfo Term information} + (** {2:tinfo Term information} Term information defines the name and man page of a term. For simple evaluation this is the name of the program and its man page. For multiple term evaluation, this is the name of a command and its man page. *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + + type exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] + (** The type for exit status information. *) + + val exit_info : ?docs:string -> ?doc:string -> ?max:int -> int -> exit_info + [@@ocaml.deprecated "Use Cmd.Exit.info instead."] + (** [exit_info ~docs ~doc min ~max] describe the range of exit + statuses from [min] to [max] (defaults to [min]). [doc] is the + man page information for the statuses, defaults to ["undocumented"]. + [docs] is the title of the man page section in which the statuses + will be listed, it defaults to {!Manpage.s_exit_status}. + + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(status)], the value of [min].} + {- [$(status_max)], the value of [max].} + {- The variables mentioned in {!val-info}}} *) + + val default_exits : exit_info list + [@@ocaml.deprecated + "Use Cmd.Exit.defaults or Cmd.info's defaults ~exits value instead."] + (** [default_exits] is information for exit status {!exit_status_success} + added to {!default_error_exits}. *) + + val default_error_exits : exit_info list + [@@ocaml.deprecated "List.filter the Cmd.Exit.defaults value instead."] + (** [default_error_exits] is information for exit statuses + {!exit_status_cli_error} and {!exit_status_internal_error}. *) + + type env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** The type for environment variable information. *) + + val env_info : ?docs:string -> ?doc:string -> string -> env_info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** [env_info ~docs ~doc var] describes an environment variable + [var]. [doc] is the man page information of the environment + variable, defaults to ["undocumented"]. [docs] is the title of + the man page section in which the environment variable will be + listed, it defaults to {!Cmdliner.Manpage.s_environment}. + + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(env)], the value of [var].} + {- The variables mentioned in {!val-info}}} *) + type info + [@@ocaml.deprecated "Use Cmd.info instead."] (** The type for term information. *) - val info : ?sdocs:string -> ?man:Manpage.block list -> + val info : + ?man_xrefs:Manpage.xref list -> ?man:Manpage.block list -> + ?envs:env_info list -> ?exits:exit_info list -> ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> string -> info + [@@ocaml.deprecated "Use Cmd.info instead."] (** [info sdocs man docs doc version name] is a term information such that: {ul @@ -150,42 +345,54 @@ module Term : sig description is also used in the list of commands of the main term's man page.} {- [docs], only for commands, the title of the section of the main - term's man page where it should be listed (defaults to ["COMMANDS"]).} - {- [man] is the text of the man page for the term. In the text, - the variables ["$(tname)"] and ["$(mname)"] can respectively be - used to refer to the value of [name] and the main term's name. - } + term's man page where it should be listed (defaults to + {!Manpage.s_commands}).} {- [sdocs] defines the title of the section in which the - standard [--help] and [--version] arguments are listed.}} *) + standard [--help] and [--version] arguments are listed + (defaults to {!Manpage.s_options}).} + {- [exits] is a list of exit statuses that the term evaluation + may produce.} + {- [envs] is a list of environment variables that influence + the term's evaluation.} + {- [man] is the text of the man page for the term.} + {- [man_xrefs] are cross-references to other manual pages. These + are used to generate a {!Manpage.s_see_also} section.}} + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: + {ul + {- [$(tname)] the term's name.} + {- [$(mname)] the main term's name.}} *) val name : info -> string + [@@ocaml.deprecated "Use Cmd.name instead."] (** [name ti] is the name of the term information. *) - (** {1:evaluation Evaluation} *) + (** {2:evaluation Evaluation} *) - type 'a result = [ - | `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] + type 'a result = + [ `Ok of 'a | `Error of [`Parse | `Term | `Exn ] | `Version | `Help ] (** The type for evaluation results. {ul {- [`Ok v], the term evaluated successfully and [v] is the result.} {- [`Version], the version string of the main term was printed on the help formatter.} {- [`Help], man page about the term was printed on the help formatter.} - {- [`Error `Parse], a command line parse error occured and was + {- [`Error `Parse], a command line parse error occurred and was reported on the error formatter.} - {- [`Error `Term], a term evaluation error occured and was reported - on the error formatter (see {!Term.ret}).} + {- [`Error `Term], a term evaluation error occurred and was reported + on the error formatter (see {!Term.val-ret}').} {- [`Error `Exn], an exception [e] was caught and reported on the error formatter (see the [~catch] parameter of {!eval}).}} *) - val eval : ?help:Format.formatter -> - ?err:Format.formatter -> ?catch:bool -> - ?env:(string -> string option) -> - ?argv:string array -> ('a t * info) -> 'a result + val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> ('a t * info) -> + 'a result + [@@ocaml.deprecated "Use Cmd.v and one of Cmd.eval* instead."] (** [eval help err catch argv (t,i)] is the evaluation result of [t] with command line arguments [argv] (defaults to {!Sys.argv}). - If [catch] is [true] (default) uncaught exeptions + If [catch] is [true] (default) uncaught exceptions are intercepted and their stack trace is written to the [err] formatter. @@ -196,12 +403,12 @@ module Term : sig [env] is used for environment variable lookup, the default uses {!Sys.getenv}. *) - val eval_choice : ?help:Format.formatter -> - ?err:Format.formatter -> ?catch:bool -> - ?env:(string -> string option) -> - ?argv:string array -> 'a t * info -> ('a t * info) list -> - 'a result - (** [eval_choice help err catch argv default (t,i) choices] is like {!eval} + val eval_choice : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + 'a t * info -> ('a t * info) list -> 'a result + [@@ocaml.deprecated "Use Cmd.group and one of Cmd.eval* instead."] + (** [eval_choice help err catch argv (t,i) choices] is like {!eval} except that if the first argument on the command line is not an option name it will look in [choices] for a term whose information has this name and evaluate it. @@ -210,10 +417,10 @@ module Term : sig is unspecified the "main" term [t] is evaluated. [i] defines the name and man page of the program. *) - val eval_peek_opts : ?version_opt:bool -> - ?env:(string -> string option) -> - ?argv:string array -> 'a t -> - 'a option * 'a result + val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a t -> 'a option * 'a result + [@@ocaml.deprecated "Use Cmd.eval_peek_opts instead."] (** [eval_peek_opts version_opt argv t] evaluates [t], a term made of optional arguments only, with the command line [argv] (defaults to {!Sys.argv}). In this evaluation, unknown optional @@ -236,6 +443,363 @@ module Term : sig contrasts to {!eval} and {!eval_choice} no side effects like error reporting or help output occurs. + {b Note.} Positional arguments can't be peeked without the full + specification of the command line: we can't tell apart a + positional argument from the value of an unknown optional + argument. *) + + (** {2:exits Turning evaluation results into exit codes} + + {b Note.} If you are using the following functions to handle + the evaluation result of a term you should add {!default_exits} to + the term's information {{!val-info}[~exits]} argument. + + {b WARNING.} You should avoid status codes strictly greater than 125 + as those may be used by + {{:https://www.gnu.org/software/bash/manual/html_node/Exit-Status.html} + some} shells. *) + + val exit_status_success : int + [@@ocaml.deprecated "Use Cmd.Exit.ok instead."] + (** [exit_status_success] is 0, the exit status for success. *) + + val exit_status_cli_error : int + [@@ocaml.deprecated "Use Cmd.Exit.cli_error instead."] + (** [exit_status_cli_error] is 124, an exit status for command line + parsing errors. *) + + val exit_status_internal_error : int + [@@ocaml.deprecated "Use Cmd.Exit.internal_error instead."] + (** [exit_status_internal_error] is 125, an exit status for unexpected + internal errors. *) + + val exit_status_of_result : ?term_err:int -> unit result -> int + [@@ocaml.deprecated "Use Cmd.eval instead."] + (** [exit_status_of_result ~term_err r] is an [exit(3)] status + code determined from [r] as follows: + {ul + {- {!exit_status_success} if [r] is one of [`Ok ()], [`Version], [`Help]} + {- [term_err] if [r] is [`Error `Term], [term_err] defaults to [1].} + {- {!exit_status_cli_error} if [r] is [`Error `Parse]} + {- {!exit_status_internal_error} if [r] is [`Error `Exn]}} *) + + val exit_status_of_status_result : ?term_err:int -> int result -> int + [@@ocaml.deprecated "Use Cmd.eval' instead."] + (** [exit_status_of_status_result] is like {!exit_status_of_result} + except for [`Ok n] where [n] is used as the status exit code. *) + + val exit : ?term_err:int -> unit result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval instead."] + (** [exit ~term_err r] is + [Stdlib.exit @@ exit_status_of_result ~term_err r] *) + + val exit_status : ?term_err:int -> int result -> unit + [@@ocaml.deprecated "Use Stdlib.exit and Cmd.eval' instead."] + (** [exit_status ~term_err r] is + [Stdlib.exit @@ exit_status_of_status_result ~term_err r] *) + + (**/**) + val pure : 'a -> 'a t + [@@ocaml.deprecated "Use Term.const instead."] + (** @deprecated use {!const} instead. *) + + val man_format : Manpage.format t + [@@ocaml.deprecated "Use Arg.man_format instead."] + (** @deprecated Use {!Arg.man_format} instead. *) + (**/**) +end + +(** Commands. + + Command line syntaxes are implicitely defined by {!Term}s. A command + value binds a syntax and its documentation to a command name. + + A command can group a list of sub commands (and recursively). In this + case your tool defines a tree of commands, each with its own command + line syntax. The root of that tree is called the {e main command}; + it represents your tool and its name. *) +module Cmd : sig + + (** {1:info Command information} + + Command information defines the name and documentation of a command. *) + + (** Exit codes and their information. *) + module Exit : sig + + (** {1:codes Exit codes} *) + + type code = int + (** The type for exit codes. + + {b Warning.} You should avoid status codes strictly greater than 125 + as those may be used by + {{:https://www.gnu.org/software/bash/manual/html_node/Exit-Status.html} + some} shells. *) + + val ok : code + (** [ok] is [0], the exit status for success. *) + + val some_error : code + (** [some_error] is [123], an exit status for indisciminate errors + reported on stderr. *) + + val cli_error : code + (** [cli_error] is [124], an exit status for command line parsing + errors. *) + + val internal_error : code + (** [internal_error] is [125], an exit status for unexpected internal + errors. *) + + (** {1:info Exit code information} *) + + type info + (** The type for exit code information. *) + + val info : ?docs:string -> ?doc:string -> ?max:code -> code -> info + (** [exit_info ~docs ~doc min ~max] describe the range of exit + statuses from [min] to [max] (defaults to [min]). [doc] is the + man page information for the statuses, defaults to ["undocumented"]. + [docs] is the title of the man page section in which the statuses + will be listed, it defaults to {!Manpage.s_exit_status}. + + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(status)], the value of [min].} + {- [$(status_max)], the value of [max].} + {- The variables mentioned in the {!Cmd.val-info}}} *) + + val info_code : info -> code + (** [info_code i] is the minimal code of [i]. *) + + val defaults : info list + (** [defaults] are exit code information for {!ok}, {!some_error} + {!cli_error} and {!internal_error}. *) + end + + (** Environment variable and their information. *) + module Env : sig + + (** {1:envvars Environment variables} *) + + type var = string + (** The type for environment names. *) + + (** {1:info Environment variable information} *) + + [@@@alert "-deprecated"] + type info = Term.env_info (* because of Arg. *) + (** The type for environment variable information. *) + [@@@alert "+deprecated"] + + val info : ?deprecated:string -> ?docs:string -> ?doc:string -> var -> info + (** [info ~docs ~doc var] describes an environment variable + [var] such that: + {ul + {- [doc] is the man page information of the environment + variable, defaults to ["undocumented"].} + {- [docs] is the title of the man page section in which the environment + variable will be listed, it defaults to + {!Cmdliner.Manpage.s_environment}.} + {- [deprecated], if specified the environment is deprecated and the + string is a message output on standard error when the environment + variable gets used to lookup the default value of an argument.}} + In [doc] the {{!page-tool_man.doclang}documentation markup language} + can be used with following variables: + {ul + {- [$(env)], the value of [var].} + {- The variables mentioned in {!val-info}.}} *) + end + + type info + (** The type for information about commands. *) + + val info : + ?deprecated:string -> ?man_xrefs:Manpage.xref list -> + ?man:Manpage.block list -> ?envs:Env.info list -> ?exits:Exit.info list -> + ?sdocs:string -> ?docs:string -> ?doc:string -> ?version:string -> + string -> info + (** [info ?sdocs ?man ?docs ?doc ?version name] is a term information + such that: + {ul + {- [name] is the name of the command.} + {- [version] is the version string of the command line tool, this + is only relevant for the main command and ignored otherwise.} + {- [deprecated], if specified the command is deprecated and the + string is a message output on standard error when the command + is used.} + {- [doc] is a one line description of the command used + for the [NAME] section of the command's man page and in command + group listings.} + {- [docs], for commands that are part of a group, the title of the + section of the parent's command man page where it should be listed + (defaults to {!Manpage.s_commands}).} + {- [sdocs] defines the title of the section in which the + standard [--help] and [--version] arguments are listed + (defaults to {!Manpage.s_common_options}).} + {- [exits] is a list of exit statuses that the command evaluation + may produce, defaults to {!Exit.defaults}.} + {- [envs] is a list of environment variables that influence + the command's evaluation.} + {- [man] is the text of the man page for the command.} + {- [man_xrefs] are cross-references to other manual pages. These + are used to generate a {!Manpage.s_see_also} section.}} + + [doc], [man], [envs] support the {{!page-tool_man.doclang}documentation + markup language} in which the following variables are recognized: + {ul + {- [$(tname)] the (term's) command's name.} + {- [$(mname)] the main command name.} + {- [$(iname)] the command invocation from main command to the + command name.}} + *) + + (** {1:cmds Commands} *) + + type 'a t + (** The type for commands whose evaluation result in a value of + type ['a]. *) + + val v : info -> 'a Term.t -> 'a t + (** [v i t] is a command with information [i] and command line syntax + parsed by [t]. *) + + val group : ?default:'a Term.t -> info -> 'a t list -> 'a t + (** [group i ?default cmds] is a command with information [i] that + groups sub commands [cmds]. [default] is the command line syntax + to parse if no sub command is specified on the command line. If + [default] is [None] (default), the tool errors when no sub + command is specified. *) + + val name : 'a t -> string + (** [name c] is the name of [c]. *) + + (** {1:eval Evaluation} + + These functions are meant to be composed with {!Stdlib.exit}. + The following exit codes may be returned by all these functions: + {ul + {- {!Exit.cli_error} if a parse error occurs.} + {- {!Exit.internal_error} if the [~catch] argument is [true] (default) + and an uncaught exception is raised.} + {- The value of [~term_err] (defaults to {!Exit.cli_error}) if + a term error occurs.}} + + These exit codes are described in {!Exit.defaults} which is the + default value of the [?exits] argument of function {!val-info}. *) + + val eval : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> unit t -> Exit.code + (** [eval cmd] is {!Exit.ok} if [cmd] evaluates to [()]. + See {!eval_value} for other arguments. *) + + val eval' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> Exit.code t -> Exit.code + (** [eval' cmd] is [c] if [cmd] evaluates to the exit code [c]. + See {!eval_value} for other arguments. *) + + val eval_result : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (unit, string) result t -> Exit.code + (** [eval_result cmd] is: + {ul + {- {!Exit.ok} if [cmd] evaluates to [Ok ()].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + val eval_result' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> + ?term_err:Exit.code -> (Exit.code, string) result t -> Exit.code + (** [eval_result' cmd] is: + {ul + {- [c] if [cmd] evaluates to [Ok c].} + {- {!Exit.some_error} if [cmd] evaluates to [Error msg]. In this + case [msg] is printed on [err].}} + See {!eval_value} for other arguments. *) + + (** {2:eval_low Low level evaluation} + + This interface gives more information on command evaluation results + and lets you choose how to map evaluation results to exit codes. *) + + type 'a eval_ok = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Version (** The version of the main cmd was requested. *) + | `Help (** Help was requested. *) ] + (** The type for successful evaluation results. *) + + type eval_error = + [ `Parse (** A parse error occurred. *) + | `Term (** A term evaluation error occurred. *) + | `Exn (** An uncaught exception occurred. *) ] + (** The type for erroring evaluation results. *) + + type 'a eval_exit = + [ `Ok of 'a (** The term of the command evaluated to this value. *) + | `Exit of Exit.code (** The evaluation wants to exit with this code. *) ] + + val eval_value : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> 'a t -> + ('a eval_ok, eval_error) result + (** [eval ~help ~err ~catch ~env ~argv cmd] is the evaluation result + of [cmd] with: + {ul + {- [argv] the command line arguments to parse (defaults to {!Sys.argv})} + {- [env] the function used for environment variable lookup (defaults + to {!Sys.getenv}).} + {- [catch] if [true] (default) uncaught exceptions + are intercepted and their stack trace is written to the [err] + formatter} + {- [help] is the formatter used to print help or version messages + (defaults to {!Format.std_formatter})} + {- [err] is the formatter used to print error messages + (defaults to {!Format.err_formatter}).}} *) + + val eval_value' : + ?help:Format.formatter -> ?err:Format.formatter -> ?catch:bool -> + ?env:(string -> string option) -> ?argv:string array -> ?term_err:int -> + 'a t -> 'a eval_exit + (** [eval_value'] is like {!eval_value}, but if the command term + does not evaluate, returns an exit code like the + {{!eval}evaluation} function do (which can be {!Exit.ok} in case + help or version was requested). *) + + val eval_peek_opts : + ?version_opt:bool -> ?env:(string -> string option) -> + ?argv:string array -> 'a Term.t -> + 'a option * ('a eval_ok, eval_error) result + (** [eval_peek_opts version_opt argv t] evaluates [t], a term made + of optional arguments only, with the command line [argv] + (defaults to {!Sys.argv}). In this evaluation, unknown optional + arguments and positional arguments are ignored. + + The evaluation returns a pair. The first component is + the result of parsing the command line [argv] stripped from + any help and version option if [version_opt] is [true] (defaults + to [false]). It results in: + {ul + {- [Some _] if the command line would be parsed correctly given the + {e partial} knowledge in [t].} + {- [None] if a parse error would occur on the options of [t]}} + + The second component is the result of parsing the command line + [argv] without stripping the help and version options. It + indicates what the evaluation would result in on [argv] given + the partial knowledge in [t] (for example it would return + [`Help] if there's a help option in [argv]). However in + contrasts to {!val-eval_value} no side effects like error + reporting or help output occurs. + {b Note.} Positional arguments can't be peeked without the full specification of the command line: we can't tell apart a positional argument from the value of an unknown optional @@ -248,8 +812,8 @@ end to the arguments provided on the command line. Basic constraints, like the argument type or repeatability, are - specified by defining a value of type {!t}. Further contraints can - be specified during the {{!argterms}conversion} to a term. *) + specified by defining a value of type {!Arg.t}. Further constraints can + be specified during the {{!Arg.argterms}conversion} to a term. *) module Arg : sig (** {1:argconv Argument converters} @@ -259,19 +823,66 @@ module Arg : sig are provided for many types of the standard library. *) type 'a parser = string -> [ `Ok of 'a | `Error of string ] - (** The type for argument parsers. *) + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' instead."] + (** The type for argument parsers. + + {b Deprecated.} Use parser signatures of {!val-conv} or {!val-conv'}. *) type 'a printer = Format.formatter -> 'a -> unit (** The type for converted argument printers. *) - type 'a converter = 'a parser * 'a printer - (** The type for argument converters. *) - - val some : ?none:string -> 'a converter -> 'a option converter - (** [some none c] is like the converter [c] except it returns - [Some] value. It is used for command line arguments - that default to [None] when absent. [none] is what to print to - document the absence (defaults to [""]). *) + [@@@alert "-deprecated"] (* Need to be able to mention them ! *) + type 'a conv = 'a parser * 'a printer + (** The type for argument converters. + + {b Warning.} Do not use directly, use {!val-conv} or {!val-conv'}. + This type will become abstract in the next major version of cmdliner. *) + [@@@alert "+deprecated"] (* Need to be able to mention them ! *) + + val conv : + ?docv:string -> (string -> ('a, [`Msg of string]) result) * 'a printer -> + 'a conv + (** [conv ~docv (parse, print)] is an argument converter + parsing values with [parse] and printing them with + [print]. [docv] is a documentation meta-variable used in the + documentation to stand for the argument value, defaults to + ["VALUE"]. *) + + val conv' : + ?docv:string -> (string -> ('a, string) result) * 'a printer -> + 'a conv + (** [conv'] is like {!val-conv} but the [Error] case has an unlabelled + string. *) + + val conv_parser : 'a conv -> (string -> ('a, [`Msg of string]) result) + (** [conv_parser c] is the parser of [c]. *) + + val conv_printer : 'a conv -> 'a printer + (** [conv_printer c] is the printer of [c]. *) + + val conv_docv : 'a conv -> string + (** [conv_docv c] is [c]'s documentation meta-variable. + + {b Warning.} Currently always returns ["VALUE"] in the future + will return the value given to {!val-conv} or {!val-conv'}. *) + + val parser_of_kind_of_string : + kind:string -> (string -> 'a option) -> + (string -> ('a, [`Msg of string]) result) + (** [parser_of_kind_of_string ~kind kind_of_string] is an argument + parser using the [kind_of_string] function for parsing and [kind] + to report errors (e.g. could be ["an integer"] for an [int] parser.). *) + + val some' : ?none:'a -> 'a conv -> 'a option conv + (** [some' ?none c] is like the converter [c] except it returns + [Some] value. It is used for command line arguments that default + to [None] when absent. If provided, [none] is used with [conv]'s + printer to document the value taken on absence; to document + a more complex behaviour use the [absent] argument of {!val-info}. *) + + val some : ?none:string -> 'a conv -> 'a option conv + (** [some ?none c] is like [some'] but [none] is described as a + string that will be rendered in bold. *) (** {1:arginfo Arguments and their information} @@ -281,53 +892,51 @@ module Arg : sig if the argument is absent from the command line and the variable is defined. *) - type env - (** The type for environment variables and their documentation. *) - - val env_var : ?docs:string -> ?doc:string -> string -> env - (** [env_var docs doc var] is an environment variables [var]. [doc] - is the man page information of the environment variable; the - variables mentioned in {!info} can be used in this documentation - string. [doc] defaults to ["See option $(opt)."]. [docs] is the - title of the man page section in which the environment variable - will be listed, it defaults to ["ENVIRONMENT VARIABLES"]. *) - type 'a t (** The type for arguments holding data of type ['a]. *) type info (** The type for information about command line arguments. *) - val info : ?docs:string -> ?docv:string -> ?doc:string -> ?env:env -> - string list -> info + val info : + ?deprecated:string -> ?absent:string -> ?docs:string -> ?docv:string -> + ?doc:string -> ?env:Cmd.Env.info -> string list -> info (** [info docs docv doc env names] defines information for an argument. - - [names] defines the names under which an optional argument - can be referred to. Strings of length [1] (["c"]) define short - option names (["-c"]), longer strings (["count"]) define long - option names (["--count"]). [names] must be empty for positional - arguments. - - [env] defines the name of an environment variable which is - looked up for defining the argument if it is absent from the - command line. See {{!envlookup}environment variables} for - details. {ul - {- [doc] is the man page information of the argument. The - variable ["$(docv)"] can be used to refer to the value of - [docv] (see below). The variable ["$(opt)"] will refer to a - long option of [names] or a short one if there is no long - option. The variable ["$(env)"] will refer to the environment - variable specified by [env] (if any). {{!doc_helpers}These - functions} can help with formatting argument values.} + {- [names] defines the names under which an optional argument + can be referred to. Strings of length [1] (["c"]) define + short option names (["-c"]), longer strings (["count"]) + define long option names (["--count"]). [names] must be empty + for positional arguments.} + {- [env] defines the name of an environment variable which is + looked up for defining the argument if it is absent from the + command line. See {{!page-cli.envlookup}environment variables} for + details.} + {- [doc] is the man page information of the argument. + The {{!page-tool_man.doclang}documentation language} can be used and + the following variables are recognized: + {ul + {- ["$(docv)"] the value of [docv] (see below).} + {- ["$(opt)"], one of the options of [names], preference + is given to a long one.} + {- ["$(env)"], the environment var specified by [env] (if any).}} + {{!doc_helpers}These functions} can help with formatting argument + values.} {- [docv] is for positional and non-flag optional arguments. It is a variable name used in the man page to stand for their value.} {- [docs] is the title of the man page section in which the argument will be listed. For optional arguments this defaults - to ["OPTIONS"]. For positional arguments this defaults - to ["ARGUMENTS"]. However a positional argument is only listed - if it has both a [doc] and [docv] specified.}} *) + to {!Manpage.s_options}. For positional arguments this defaults + to {!Manpage.s_arguments}. However a positional argument is only + listed if it has both a [doc] and [docv] specified.} + {- [deprecated], if specified the argument is deprecated and the + string is a message output on standard error when the argument + is used.} + {- [absent], if specified a documentation string that indicates + what happens when the argument is absent. The document language + can be used like in [doc]. This overrides the automatic default + value rendering that is performed by the combinators.}} *) val ( & ) : ('a -> 'b) -> 'a -> 'b (** [f & v] is [f v], a right associative composition operator for @@ -347,11 +956,11 @@ module Arg : sig val flag_all : info -> bool list t (** [flag_all] is like {!flag} except the flag may appear more than once. The argument holds a list that contains one [true] value per - occurence of the flag. It holds the empty list if the flag + occurrence of the flag. It holds the empty list if the flag is absent from the command line. *) val vflag : 'a -> ('a * info) list -> 'a t - (** [vflag v \[v]{_0}[,i]{_0}[;...\]] is an ['a] argument defined + (** [vflag v \[v]{_0}[,i]{_0}[;…\]] is an ['a] argument defined by an optional flag that may appear {e at most} once on the command line under one of the names specified in the [i]{_k} values. The argument holds [v] if the flag is absent from the @@ -365,13 +974,13 @@ module Arg : sig (** [vflag_all v l] is like {!vflag} except the flag may appear more than once. The argument holds the list [v] if the flag is absent from the command line. Otherwise it holds a list that contains one - corresponding value per occurence of the flag, in the order found on + corresponding value per occurrence of the flag, in the order found on the command line. {b Note.} Environment variable lookup is unsupported for for these arguments. *) - val opt : ?vopt:'a -> 'a converter -> 'a -> info -> 'a t + val opt : ?vopt:'a -> 'a conv -> 'a -> info -> 'a t (** [opt vopt c v i] is an ['a] argument defined by the value of an optional argument that may appear {e at most} once on the command line under one of the names specified by [i]. The argument holds @@ -381,19 +990,26 @@ module Arg : sig If [vopt] is provided the value of the optional argument is itself optional, taking the value [vopt] if unspecified on the command line. *) - val opt_all : ?vopt:'a -> 'a converter -> 'a list -> info -> 'a list t + val opt_all : ?vopt:'a -> 'a conv -> 'a list -> info -> 'a list t (** [opt_all vopt c v i] is like {!opt} except the optional argument may appear more than once. The argument holds a list that contains one value - per occurence of the flag in the order found on the command line. + per occurrence of the flag in the order found on the command line. It holds the list [v] if the flag is absent from the command line. *) (** {1:posargs Positional arguments} The information of a positional argument must have no name or [Invalid_argument] is raised. Positional arguments indexing - is zero-based. *) + is zero-based. + + {b Warning.} The following combinators allow to specify and + extract a given positional argument with more than one term. + This should not be done as it will likely confuse end users and + documentation generation. These over-specifications may be + prevented by raising [Invalid_argument] in the future. But for now + it is the client's duty to make sure this doesn't happen. *) - val pos : ?rev:bool -> int -> 'a converter -> 'a -> info -> 'a t + val pos : ?rev:bool -> int -> 'a conv -> 'a -> info -> 'a t (** [pos rev n c v i] is an ['a] argument defined by the [n]th positional argument of the command line as converted by [c]. If the positional argument is absent from the command line @@ -403,13 +1019,13 @@ module Arg : sig position is [max-n] where [max] is the position of the last positional argument present on the command line. *) - val pos_all : 'a converter -> 'a list -> info -> 'a list t + val pos_all : 'a conv -> 'a list -> info -> 'a list t (** [pos_all c v i] is an ['a list] argument that holds all the positional arguments of the command line as converted by [c] or [v] if there are none. *) - val pos_left : ?rev:bool -> int -> 'a converter -> 'a list -> info -> - 'a list t + val pos_left : + ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t (** [pos_left rev n c v i] is an ['a list] argument that holds all the positional arguments as converted by [c] found on the left of the [n]th positional argument or [v] if there are none. @@ -418,8 +1034,8 @@ module Arg : sig position is [max-n] where [max] is the position of the last positional argument present on the command line. *) - val pos_right : ?rev:bool -> int -> 'a converter -> 'a list -> info -> - 'a list t + val pos_right : + ?rev:bool -> int -> 'a conv -> 'a list -> info -> 'a list t (** [pos_right] is like {!pos_left} except it holds all the positional arguments found on the right of the specified positional argument. *) @@ -443,81 +1059,87 @@ module Arg : sig val last : 'a list t -> 'a Term.t (** [last a] is a term that fails if [a]'s list is empty and evaluates to the value of the last element of the list otherwise. Use this - for lists of flags or options where the last occurence takes precedence + for lists of flags or options where the last occurrence takes precedence over the others. *) + (** {1:predef Predefined arguments} *) + + val man_format : Manpage.format Term.t + (** [man_format] is a term that defines a [--man-format] option and + evaluates to a value that can be used with {!Manpage.print}. *) + (** {1:converters Predefined converters} *) - val bool : bool converter + val bool : bool conv (** [bool] converts values with {!bool_of_string}. *) - val char : char converter + val char : char conv (** [char] converts values by ensuring the argument has a single char. *) - val int : int converter + val int : int conv (** [int] converts values with {!int_of_string}. *) - val nativeint : nativeint converter + val nativeint : nativeint conv (** [nativeint] converts values with {!Nativeint.of_string}. *) - val int32 : int32 converter + val int32 : int32 conv (** [int32] converts values with {!Int32.of_string}. *) - val int64 : int64 converter + val int64 : int64 conv (** [int64] converts values with {!Int64.of_string}. *) - val float : float converter + val float : float conv (** [float] converts values with {!float_of_string}. *) - val string : string converter + val string : string conv (** [string] converts values with the identity function. *) - val enum : (string * 'a) list -> 'a converter + val enum : (string * 'a) list -> 'a conv (** [enum l p] converts values such that unambiguous prefixes of string names in [l] map to the corresponding value of type ['a]. - {b Warning.} The type ['a] must be comparable with {!Pervasives.compare}. + {b Warning.} The type ['a] must be comparable with {!Stdlib.compare}. @raise Invalid_argument if [l] is empty. *) - val file : string converter + val file : string conv (** [file] converts a value with the identity function and checks with {!Sys.file_exists} that a file with that name exists. *) - val dir : string converter + val dir : string conv (** [dir] converts a value with the identity function and checks with {!Sys.file_exists} and {!Sys.is_directory} that a directory with that name exists. *) - val non_dir_file : string converter + val non_dir_file : string conv (** [non_dir_file] converts a value with the identity function and checks with {!Sys.file_exists} and {!Sys.is_directory} that a non directory file with that name exists. *) - val list : ?sep:char -> 'a converter -> 'a list converter + val list : ?sep:char -> 'a conv -> 'a list conv (** [list sep c] splits the argument at each [sep] (defaults to [',']) character and converts each substrings with [c]. *) - val array : ?sep:char -> 'a converter -> 'a array converter + val array : ?sep:char -> 'a conv -> 'a array conv (** [array sep c] splits the argument at each [sep] (defaults to [',']) character and converts each substring with [c]. *) - val pair : ?sep:char -> 'a converter -> 'b converter -> ('a * 'b) converter + val pair : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv (** [pair sep c0 c1] splits the argument at the {e first} [sep] character (defaults to [',']) and respectively converts the substrings with [c0] and [c1]. *) - val t2 : ?sep:char -> 'a converter -> 'b converter -> ('a * 'b) converter + val t2 : ?sep:char -> 'a conv -> 'b conv -> ('a * 'b) conv (** {!t2} is {!pair}. *) - val t3 : ?sep:char -> 'a converter ->'b converter -> 'c converter -> - ('a * 'b * 'c) converter + val t3 : ?sep:char -> 'a conv ->'b conv -> 'c conv -> ('a * 'b * 'c) conv (** [t3 sep c0 c1 c2] splits the argument at the {e first} two [sep] characters (defaults to [',']) and respectively converts the substrings with [c0], [c1] and [c2]. *) - val t4 : ?sep:char -> 'a converter ->'b converter -> 'c converter -> - 'd converter -> ('a * 'b * 'c * 'd) converter + val t4 : + ?sep:char -> 'a conv -> 'b conv -> 'c conv -> 'd conv -> + ('a * 'b * 'c * 'd) conv (** [t4 sep c0 c1 c2 c3] splits the argument at the {e first} three [sep] characters (defaults to [',']) respectively converts the substrings with [c0], [c1], [c2] and [c3]. *) @@ -528,717 +1150,43 @@ module Arg : sig (** [doc_quote s] quotes the string [s]. *) val doc_alts : ?quoted:bool -> string list -> string - (** [doc_alts alts] documents the alternative tokens [alts] according - the number of alternatives. If [quoted] is [true] (default) - the tokens are quoted. The resulting string can be used in - sentences of the form ["$(docv) must be %s"]. + (** [doc_alts alts] documents the alternative tokens [alts] + according the number of alternatives. If [quoted] is: + {ul + {- [None], the tokens are enclosed in manpage markup directives + to render them in bold (manpage convention).} + {- [Some true], the tokens are quoted with {!doc_quote}.} + {- [Some false], the tokens are written as is}} + The resulting string can be used in sentences of + the form ["$(docv) must be %s"]. - @raise Invalid_argument if [alts] is the empty string. *) + @raise Invalid_argument if [alts] is the empty list. *) val doc_alts_enum : ?quoted:bool -> (string * 'a) list -> string (** [doc_alts_enum quoted alts] is [doc_alts quoted (List.map fst alts)]. *) -end -(** - {1:basics Basics} - - With [Cmdliner] your program evaluates a term. A {e term} - is a value of type {!Term.t}. The type parameter indicates - the type of the result of the evaluation. - - One way to create terms is by lifting regular OCaml values with - {!Term.const}. Terms can be applied to terms evaluating to - functional values with {!Term.( $ )}. For example for the function: -{[let revolt () = print_endline "Revolt!"]} - the term : -{[ -open Cmdliner;; - -let revolt_t = Term.(const revolt $ const ())]} - is a term that evaluates to the result (and effect) of the [revolt] - function. - Terms are evaluated with {!Term.eval}: -{[let () = match Term.eval (revolt_t, Term.info "revolt") with -| `Error _ -> exit 1 | _ -> exit 0]} - This defines a command line program named ["revolt"], without command line - arguments arguments, that just prints ["Revolt!"] on [stdout]. -{[> ./revolt -Revolt!]} - The combinators in the {!Arg} module allow to extract command - line argument data as terms. These terms can then be applied to - lifted OCaml functions to be evaluated by the program. - - Terms corresponding to command line argument data that are part of - a term evaluation implicitly define a command line syntax. We - show this on an concrete example. - - Consider the [chorus] function that prints repeatedly a - given message : -{[let chorus count msg = - for i = 1 to count do print_endline msg done]} - we want to make it available from the command line - with the synopsis: -{[chorus [-c COUNT | --count=COUNT] [MSG]]} - where [COUNT] defaults to [10] and [MSG] defaults to ["Revolt!"]. - We first define a term corresponding to the [--count] - option: -{[ -let count = - let doc = "Repeat the message $(docv) times." in - Arg.(value & opt int 10 & info ["c"; "count"] ~docv:"COUNT" ~doc) -]} - This says that [count] is a term that evaluates to the - value of an optional argument of type [int] that - defaults to [10] if unspecified and whose option name is - either [-c] or [--count]. The arguments [doc] and [docv] are used to - generate the option's man page information. - - The term for the positional argument [MSG] is: -{[ -let msg = - let doc = "Overrides the default message to print." - let env = Arg.env "CHORUS_MSG" ~doc in - let doc = "The message to print." in - Arg.(value & pos 0 string "Revolt!" & info [] ~env ~docv:"MSG" ~doc) -]} - which says that [msg] is a term whose value is the positional - argument at index [0] of type [string] and defaults to ["Revolt!"] - or the value of the environment variable [CHORUS_MSG] if the - argument is unspecified on the command line. Here again [doc] and - [docv] are used for the man page information. - - The term for executing [chorus] with these command line arguments - is : -{[ -let chorus_t = Term.(const chorus $ count $ msg) -]} - and we are now ready to define our program: -{[ -let info = - let doc = "print a customizable message repeatedly" in - let man = [ `S "BUGS"; `P "Email bug reports to .";] in - Term.info "chorus" ~version:"1.6.1" ~doc ~man - -let () = match Term.eval (chorus_t, info) with `Error _ -> exit 1 | _ -> exit 0 -]} - The [info] value created with {!Term.info} gives more information - about the term we execute and is used to generate the program's - man page. Since we provided a [~version] string, the program will - automatically respond to the [--version] option by printing this - string. - - A program using {!Term.eval} always responds to the - [--help] option by showing the man page about the program generated - using the information you provided with {!Term.info} and {!Arg.info}. - Here is the output generated by our example : -{v > ./chorus --help -NAME - chorus - print a customizable message repeatedly - -SYNOPSIS - chorus [OPTION]... [MSG] - -ARGUMENTS - MSG (absent=Revolt! or CHORUS_MSG env) - The message to print. - -OPTIONS - -c COUNT, --count=COUNT (absent=10) - Repeat the message COUNT times. - - --help[=FMT] (default=pager) - Show this help in format FMT (pager, plain or groff). - - --version - Show version information. - -BUGS - Email bug reports to . -v} - - If a pager is available, this output is written to a pager. - This help is also available in plain text or in the - {{:http://www.gnu.org/software/groff/groff.html}groff} man page format by - invoking the program with the option [--help=plain] or [--help=groff]. - - For examples of more complex command line definitions look and - run the {{!examples}examples}. - - {2:multiterms Multiple terms} - - [Cmdliner] also provides support for programs like [darcs] or - [git] that have multiple commands each with their own syntax: - {[prog COMMAND [OPTION]... ARG...]} - A command is defined by coupling a term with - {{!Term.tinfo}term information}. The term information defines the - command name and its man page. Given a list of commands the function - {!Term.eval_choice} will execute the term corresponding to the - [COMMAND] argument or or a specific "main" term if there is - no [COMMAND] argument. - - {2:manual Manual} - - Man page sections are printed in the order specified by - {!Term.info}. The man page information of an argument is listed in - alphabetical order at the end of the text of the section specified - by its {{!Arg.info}argument information}. Positional arguments are - also listed iff both the [docv] and [doc] string is specified in - their argument information. - - If an argument information mentions a section not specified in - {!Term.info}, an empty section is created for it. This section is - inserted just after the ["SYNOPSIS"] section or after a section - named ["DESCRIPTION"] if there is one. - - The ["SYNOPSIS"] section of a man page is generated automatically - from a term's information and its arguments. To substitute your - own instead, start the term's information man page with - a ["SYNOPSIS"] section. - - Ideally all manual strings should be UTF-8 encoded. However at the - moment Groff (at least [1.19.2]) doesn't seem to cope with UTF-8 - input and UTF-8 characters beyond the ASCII set will look garbled. - Regarding UTF-8 output, generating the man page with [-Tutf8] maps - the hyphen-minus [U+002D] to the minus sign [U+2212] which makes it - difficult to search it in the pager, so [-Tascii] is used for now. - Conclusion is that it may be better to stick to the ASCII set for now. - Please contact the author if something seems wrong in this reasoning - or if you know a work around this. - - {2:misc Miscellaneous} - - {ul - {- The option name [--help], (and [--version] if you specify a - version string) is reserved by the module. Using it as a term or - option name may result in undefined behaviour.} - {- The evaluation of a term in which the same option name is defined - by more than one argument is undefined.}} - - {1:cmdline Command line syntax} - - For programs evaluating a single term the most general form of invocation - is: - {ul{- [prog [OPTION]... [ARG]...]}} - The program automatically reponds to the [--help] option by - printing the help. If a version string is provided in - the {{!Term.tinfo}term information}, it also automatically responds - to the [--version] option by printing this string. - - Command line arguments are either {{!optargs}{e optional}} or - {{!posargs}{e positional}}. Both can be freely interleaved but - since [Cmdliner] accepts many optional forms this may result in - ambiguities. The special {{!posargs} token [--]} can be used to resolve - them. - - Programs evaluating multiple terms also add this form of invocation: - {ul{- [prog COMMAND [OPTION]... [ARG]...]}} - Commands automatically respond to the [--help] option - by printing their help. The [COMMAND] string must - be the first string following the program name and may be specified - by a prefix as long as it is not ambiguous. - - {2:optargs Optional arguments} - - An optional argument is specified on the command line by a {e - name} possibly followed by a {e value}. - - The name of an option can be short or long. - {ul - {- A {e short} name is a dash followed by a single alphanumeric - character: ["-h"], ["-q"], ["-I"].} - {- A {e long} name is two dashes followed by alphanumeric - characters and dashes: ["--help"], ["--silent"], ["--ignore-case"].}} - - More than one name may refer to the same optional argument. For - example in a given program the names ["-q"], ["--quiet"] and - ["--silent"] may all stand for the same boolean argument - indicating the program to be quiet. Long names - can be specified by any non ambiguous prefix. - - The value of an option can be specified in three different ways. - {ul - {- As the next token on the command line: ["-o a.out"], - ["--output a.out"].} - {- Glued to a short name: ["-oa.out"].} - {- Glued to a long name after an equal character: - ["--output=a.out"].}} - Glued forms are especially useful if - the value itself starts with a dash as is the case for negative numbers, - ["--min=-10"]. - - An optional argument without a value is either a {e flag} - (see {!Arg.flag}, {!Arg.vflag}) or an optional argument with an optional - value (see the [~vopt] argument of {!Arg.opt}). - - Short flags can be grouped together to share a single dash and the group - can end with a short option. For example assuming ["-v"] and ["-x"] - are flags and ["-f"] is a short option: - {ul - {- ["-vx"] will be parsed as ["-v -x"].} - {- ["-vxfopt"] will be parsed as ["-v -x -fopt"].} - {- ["-vxf opt"] will be parsed as ["-v -x -fopt"].} - {- ["-fvx"] will be parsed as ["-f=vx"].}} - - {2:posargs Positional arguments} - - Positional arguments are tokens on the command line that are not - option names and are not the value of an optional argument. They - are numbered from left to right starting with zero. - - Since positional arguments may be mistaken as the optional value - of an optional argument or they may need to look like option - names, anything that follows the special token ["--"] on the command - line is considered to be a positional argument. - - {2:envlookup Environment variables} - - Non-required command line arguments can be backed up by an environment - variable. If the argument is absent from the command line and - that the environment variable is defined, its value is parsed - using the argument converter and defines the value of the - argument. - - For {!Arg.flag} and {!Arg.flag_all} that do not have an argument - converter a boolean is parsed from the lowercased variable value - as follows: - {ul - {- [""], ["false"], ["no"], ["n"] or ["0"] is [false].} - {- ["true"], ["yes"], ["y"] or ["1"] is [true].} - {- Any other string is an error.}} - - Note that environment variables are not supported for {!Arg.vflag} - and {!Arg.vflag_all}. - - {1:examples Examples} - - These examples are in the [test] directory of the distribution. - - {2:exrm A [rm] command} - - We define the command line interface of a - [rm] command with the synopsis: -{[ -rm [OPTION]... FILE... -]} - The [-f], [-i] and [-I] flags define the prompt behaviour of [rm], - represented in our program by the [prompt] type. If more than one - of these flags is present on the command line the last one takes - precedence. - - To implement this behaviour we map the presence of these flags - to values of the [prompt] type by using {!Arg.vflag_all}. This - argument will contain all occurences of the flag on the command - line and we just take the {!Arg.last} one to define our term value - (if there's no occurence the last value of the default list [[Always]] is - taken, i.e. the default is [Always]). -{[ -(* Implementation of the command, we just print the args. *) - -type prompt = Always | Once | Never -let prompt_str = function -| Always -> "always" | Once -> "once" | Never -> "never" - -let rm prompt recurse files = - Printf.printf "prompt = %s\nrecurse = %b\nfiles = %s\n" - (prompt_str prompt) recurse (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner;; - -let files = Arg.(non_empty & pos_all file [] & info [] ~docv:"FILE") -let prompt = - let doc = "Prompt before every removal." in - let always = Always, Arg.info ["i"] ~doc in - let doc = "Ignore nonexistent files and never prompt." in - let never = Never, Arg.info ["f"; "force"] ~doc in - let doc = "Prompt once before removing more than three files, or when - removing recursively. Less intrusive than $(b,-i), while - still giving protection against most mistakes." - in - let once = Once, Arg.info ["I"] ~doc in - Arg.(last & vflag_all [Always] [always; never; once]) - -let recursive = - let doc = "Remove directories and their contents recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let cmd = - let doc = "remove files or directories" in - let man = [ - `S "DESCRIPTION"; - `P "$(tname) removes each specified $(i,FILE). By default it does not - remove directories, to also remove them and their contents, use the - option $(b,--recursive) ($(b,-r) or $(b,-R))."; - `P "To remove a file whose name starts with a `-', for example - `-foo', use one of these commands:"; - `P "rm -- -foo"; `Noblank; - `P "rm ./-foo"; - `P "$(tname) removes symbolic links, not the files referenced by the - links."; - `S "BUGS"; `P "Report bugs to ."; - `S "SEE ALSO"; `P "$(b,rmdir)(1), $(b,unlink)(2)" ] - in - Term.(const rm $ prompt $ recursive $ files), - Term.info "rm" ~version:"1.6.1" ~doc ~man - -let () = match Term.eval cmd with `Error _ -> exit 1 | _ -> exit 0 -]} - {2:excp A [cp] command} - - We define the command line interface of a - [cp] command with the synopsis: -{[cp [OPTION]... SOURCE... DEST ]} - The [DEST] argument must be a directory if there is more than - one [SOURCE]. This constraint is too complex to be expressed by the - combinators of {!Arg}. Hence we just give it the {!Arg.string} type - and verify the constraint at the beginning of the [cp] - implementation. If unsatisfied we return an [`Error] and - by using {!Term.ret} on the lifted result [cp_t] of [cp], - [Cmdliner] handles the error reporting. -{[ -(* Implementation, we check the dest argument and print the args *) - -let cp verbose recurse force srcs dest = - if List.length srcs > 1 && - (not (Sys.file_exists dest) || not (Sys.is_directory dest)) - then - `Error (false, dest ^ " is not a directory") - else - `Ok (Printf.printf - "verbose = %b\nrecurse = %b\nforce = %b\nsrcs = %s\ndest = %s\n" - verbose recurse force (String.concat ", " srcs) dest) - -(* Command line interface *) - -open Cmdliner;; - -let verbose = - let doc = "Print file names as they are copied." in - Arg.(value & flag & info ["v"; "verbose"] ~doc) - -let recurse = - let doc = "Copy directories recursively." in - Arg.(value & flag & info ["r"; "R"; "recursive"] ~doc) - -let force = - let doc = "If a destination file cannot be opened, remove it and try again."in - Arg.(value & flag & info ["f"; "force"] ~doc) - -let srcs = - let doc = "Source file(s) to copy." in - Arg.(non_empty & pos_left ~rev:true 0 file [] & info [] ~docv:"SOURCE" ~doc) - -let dest = - let doc = "Destination of the copy. Must be a directory if there is more - than one $(i,SOURCE)." in - Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv:"DEST" - ~doc) - -let cmd = - let doc = "copy files" in - let man = [ - `S "BUGS"; - `P "Email them to ."; - `S "SEE ALSO"; - `P "$(b,mv)(1), $(b,scp)(1), $(b,umask)(2), $(b,symlink)(7)" ] - in - Term.(ret (const cp $ verbose $ recurse $ force $ srcs $ dest)), - Term.info "cp" ~version:"1.6.1" ~doc ~man - -let () = match Term.eval cmd with `Error _ -> exit 1 | _ -> exit 0 -]} - -{2:extail A [tail] command} - -We define the command line interface of a [tail] command with the -synopsis: -{[tail [OPTION]... [FILE]...]} - -The [--lines] option whose value specifies the number of last lines to -print has a special syntax where a [+] prefix indicates to start -printing from that line number. In the program this is represented by -the [loc] type. We define a custom [loc] {{!Arg.argconv}argument converter} -for this option. - -The [--follow] option has an optional enumerated value. The argument -converter [follow], created with {!Arg.enum} parses the option value -into the enumeration. By using {!Arg.some} and the [~vopt] argument of -{!Arg.opt}, the term corresponding to the option [--follow] evaluates to -[None] if [--follow] is absent from the command line, to [Some Descriptor] -if present but without a value and to [Some v] if present with a value -[v] specified. - -{[ -(* Implementation of the command, we just print the args. *) - -type loc = bool * int -type verb = Verbose | Quiet -type follow = Name | Descriptor - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let loc_str (rev, k) = if rev then str "%d" k else str "+%d" k -let follow_str = function Name -> "name" | Descriptor -> "descriptor" -let verb_str = function Verbose -> "verbose" | Quiet -> "quiet" - -let tail lines follow verb pid files = - Printf.printf "lines = %s\nfollow = %s\nverb = %s\npid = %s\nfiles = %s\n" - (loc_str lines) (opt_str follow_str follow) (verb_str verb) - (opt_str string_of_int pid) (String.concat ", " files) - -(* Command line interface *) - -open Cmdliner;; - -let lines = - let loc = - let parse s = try - if s <> "" && s.[0] <> '+' then `Ok (true, int_of_string s) else - `Ok (false, int_of_string (String.sub s 1 (String.length s - 1))) - with Failure _ -> `Error "unable to parse integer" - in - parse, fun ppf p -> Format.fprintf ppf "%s" (loc_str p) - in - Arg.(value & opt loc (true, 10) & info ["n"; "lines"] ~docv:"N" - ~doc:"Output the last $(docv) lines or use $(i,+)$(docv) to start - output after the $(i,N)-1th line.") -let follow = - let doc = "Output appended data as the file grows. $(docv) specifies how the - file should be tracked, by its `name' or by its `descriptor'." in - let follow = Arg.enum ["name", Name; "descriptor", Descriptor] in - Arg.(value & opt (some follow) ~vopt:(Some Descriptor) None & - info ["f"; "follow"] ~docv:"ID" ~doc) - -let verb = - let doc = "Never output headers giving file names." in - let quiet = Quiet, Arg.info ["q"; "quiet"; "silent"] ~doc in - let doc = "Always output headers giving file names." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~doc in - Arg.(last & vflag_all [Quiet] [quiet; verbose]) - -let pid = - let doc = "With -f, terminate after process $(docv) dies." in - Arg.(value & opt (some int) None & info ["pid"] ~docv:"PID" ~doc) - -let files = Arg.(value & (pos_all non_dir_file []) & info [] ~docv:"FILE") - -let cmd = - let doc = "display the last part of a file" in - let man = [ - `S "DESCRIPTION"; - `P "$(tname) prints the last lines of each $(i,FILE) to standard output. If - no file is specified reads standard input. The number of printed - lines can be specified with the $(b,-n) option."; - `S "BUGS"; - `P "Report them to ."; - `S "SEE ALSO"; - `P "$(b,cat)(1), $(b,head)(1)" ] - in - Term.(const tail $ lines $ follow $ verb $ pid $ files), - Term.info "tail" ~version:"1.6.1" ~doc ~man - -let () = match Term.eval cmd with `Error _ -> exit 1 | _ -> exit 0 -]} - -{2:exdarcs A [darcs] command} - -We define the command line interface of a [darcs] command with the synopsis: -{[darcs [COMMAND] ...]} - -The [--debug], [-q], [-v] and [--prehook] options are available in -each command. To avoid having to pass them individually to each -command we gather them in a record of type [copts]. By lifting the -record constructor [copts] into the term [copts_t] we now have a term -that we can pass to the commands to stand for an argument of type -[copts]. These options are documented in a section called [COMMON -OPTIONS], since we also want to put [--help] and [--version] in this -section, the term information of commands makes a judicious use of the -[sdocs] parameter of {!Term.info}. - -The [help] command shows help about commands or other topics. The help -shown for commands is generated by [Cmdliner] by making an approriate -use of {!Term.ret} on the lifted [help] function. - -If the program is invoked without a command we just want to show the -help of the program as printed by [Cmdliner] with [--help]. This is -done by the [no_cmd] term. - -{[ -(* Implementations, just print the args. *) - -type verb = Normal | Quiet | Verbose -type copts = { debug : bool; verb : verb; prehook : string option } - -let str = Printf.sprintf -let opt_str sv = function None -> "None" | Some v -> str "Some(%s)" (sv v) -let opt_str_str = opt_str (fun s -> s) -let verb_str = function - | Normal -> "normal" | Quiet -> "quiet" | Verbose -> "verbose" - -let pr_copts oc copts = Printf.fprintf oc - "debug = %b\nverbosity = %s\nprehook = %s\n" - copts.debug (verb_str copts.verb) (opt_str_str copts.prehook) - -let initialize copts repodir = Printf.printf - "%arepodir = %s\n" pr_copts copts repodir - -let record copts name email all ask_deps files = Printf.printf - "%aname = %s\nemail = %s\nall = %b\nask-deps = %b\nfiles = %s\n" - pr_copts copts (opt_str_str name) (opt_str_str email) all ask_deps - (String.concat ", " files) - -let help copts man_format cmds topic = match topic with -| None -> `Help (`Pager, None) (* help about the program. *) -| Some topic -> - let topics = "topics" :: "patterns" :: "environment" :: cmds in - let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in - match conv topic with - | `Error e -> `Error (false, e) - | `Ok t when t = "topics" -> List.iter print_endline topics; `Ok () - | `Ok t when List.mem t cmds -> `Help (man_format, Some t) - | `Ok t -> - let page = (topic, 7, "", "", ""), [`S topic; `P "Say something";] in - `Ok (Cmdliner.Manpage.print man_format Format.std_formatter page) - -open Cmdliner;; - -(* Help sections common to all commands *) - -let copts_sect = "COMMON OPTIONS" -let help_secs = [ - `S copts_sect; - `P "These options are common to all commands."; - `S "MORE HELP"; - `P "Use `$(mname) $(i,COMMAND) --help' for help on a single command.";`Noblank; - `P "Use `$(mname) help patterns' for help on patch matching."; `Noblank; - `P "Use `$(mname) help environment' for help on environment variables."; - `S "BUGS"; `P "Check bug reports at http://bugs.example.org.";] - -(* Options common to all commands *) - -let copts debug verb prehook = { debug; verb; prehook } -let copts_t = - let docs = copts_sect in - let debug = - let doc = "Give only debug output." in - Arg.(value & flag & info ["debug"] ~docs ~doc) - in - let verb = - let doc = "Suppress informational output." in - let quiet = Quiet, Arg.info ["q"; "quiet"] ~docs ~doc in - let doc = "Give verbose output." in - let verbose = Verbose, Arg.info ["v"; "verbose"] ~docs ~doc in - Arg.(last & vflag_all [Normal] [quiet; verbose]) - in - let prehook = - let doc = "Specify command to run before this $(mname) command." in - Arg.(value & opt (some string) None & info ["prehook"] ~docs ~doc) - in - Term.(const copts $ debug $ verb $ prehook) - -(* Commands *) - -let initialize_cmd = - let repodir = - let doc = "Run the program in repository directory $(docv)." in - Arg.(value & opt file Filename.current_dir_name & info ["repodir"] - ~docv:"DIR" ~doc) - in - let doc = "make the current directory a repository" in - let man = [ - `S "DESCRIPTION"; - `P "Turns the current directory into a Darcs repository. Any - existing files and subdirectories become ..."] @ help_secs - in - Term.(const initialize $ copts_t $ repodir), - Term.info "initialize" ~sdocs:copts_sect ~doc ~man - -let record_cmd = - let pname = - let doc = "Name of the patch." in - Arg.(value & opt (some string) None & info ["m"; "patch-name"] ~docv:"NAME" - ~doc) - in - let author = - let doc = "Specifies the author's identity." in - Arg.(value & opt (some string) None & info ["A"; "author"] ~docv:"EMAIL" - ~doc) - in - let all = - let doc = "Answer yes to all patches." in - Arg.(value & flag & info ["a"; "all"] ~doc) - in - let ask_deps = - let doc = "Ask for extra dependencies." in - Arg.(value & flag & info ["ask-deps"] ~doc) - in - let files = Arg.(value & (pos_all file) [] & info [] ~docv:"FILE or DIR") in - let doc = "create a patch from unrecorded changes" in - let man = - [`S "DESCRIPTION"; - `P "Creates a patch from changes in the working tree. If you specify - a set of files ..."] @ help_secs - in - Term.(const record $ copts_t $ pname $ author $ all $ ask_deps $ files), - Term.info "record" ~doc ~sdocs:copts_sect ~man - -let help_cmd = - let topic = - let doc = "The topic to get help on. `topics' lists the topics." in - Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) - in - let doc = "display help about darcs and darcs commands" in - let man = - [`S "DESCRIPTION"; - `P "Prints help about darcs commands and other subjects..."] @ help_secs - in - Term.(ret - (const help $ copts_t $ Term.man_format $ Term.choice_names $topic)), - Term.info "help" ~doc ~man - -let default_cmd = - let doc = "a revision control system" in - let man = help_secs in - Term.(ret (const (fun _ -> `Help (`Pager, None)) $ copts_t)), - Term.info "darcs" ~version:"1.6.1" ~sdocs:copts_sect ~doc ~man - -let cmds = [initialize_cmd; record_cmd; help_cmd] - -let () = match Term.eval_choice default_cmd cmds with -| `Error _ -> exit 1 | _ -> exit 0 -]} -*) + (** {1:deprecated Deprecated} *) -(*--------------------------------------------------------------------------- - Copyright (c) 2011 Daniel C. Bünzli - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - 3. Neither the name of Daniel C. Bünzli nor the names of - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR - A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT - OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT - LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, - DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY - THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - ---------------------------------------------------------------------------*) + [@@@alert "-deprecated"] + + type 'a converter = 'a conv + [@@ocaml.deprecated "Use Arg.conv' function instead."] + (** See {!Arg.conv'}. *) + + val pconv : + ?docv:string -> 'a parser * 'a printer -> 'a conv + [@@ocaml.deprecated "Use Arg.conv or Arg.conv' function instead."] + (** [pconv] is like {!val-conv} or {!val-conv'}, but uses a + deprecated {!parser} signature. *) + + + type env = Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.type-info} *) + + val env_var : + ?deprecated:string -> ?docs:string -> ?doc:string -> Cmd.Env.var -> + Cmd.Env.info + [@@ocaml.deprecated "Use Cmd.Env.info instead."] + (** See {!Cmd.Env.val-info}. *) +end diff --git a/src/refmt/refmt.ml b/src/refmt/refmt.ml index e8c257786..e2704353a 100644 --- a/src/refmt/refmt.ml +++ b/src/refmt/refmt.ml @@ -105,12 +105,12 @@ let top_level_info = let man = [`S "DESCRIPTION"; `P "refmt lets you format Reason files, parse them, and convert them between OCaml syntax and Reason syntax."] in let version = "Reason " ^ Package.version ^ " @ " ^ Package.git_short_version in - Term.info "refmt" ~version ~doc ~man + Cmd.info "refmt" ~version ~doc ~man -let refmt_t = +let refmt_t: [ `Error of bool * string | `Ok of unit ] Cmd.t = let open Term in let open Refmt_args in - const refmt $ interface + let term = const refmt $ interface $ recoverable $ explicit_arity $ parse_ast @@ -119,8 +119,10 @@ let refmt_t = $ heuristics_file $ in_place $ input + in + Cmd.v top_level_info term let () = - match Term.eval ((Term.ret refmt_t), top_level_info) with - | `Error _ -> exit 1 + match Cmd.eval_value' refmt_t with + | `Exit _ -> exit 1 | _ -> exit 0 diff --git a/src/refmt/refmt_args.ml b/src/refmt/refmt_args.ml index adafe21bc..2767eea8a 100644 --- a/src/refmt/refmt_args.ml +++ b/src/refmt/refmt_args.ml @@ -1,5 +1,5 @@ -module Cmdliner = Vendored_cmdliner -open Cmdliner + +open Vendored_cmdliner let interface = let doc = "parse AST as an interface" in @@ -43,7 +43,7 @@ let print = let print_width = let docv = "COLS" in let doc = "wrapping width for printing the AST" in - let env = Arg.env_var "REFMT_PRINT_WIDTH" ~doc in + let env = Cmd.Env.info "REFMT_PRINT_WIDTH" ~doc in Arg.(value & opt (int) (80) & info ["w"; "print-width"] ~docv ~doc ~env) let heuristics_file = diff --git a/test/comments-ml.t/run.t b/test/comments-ml.t/run.t index 19671337b..f2978d2fb 100644 --- a/test/comments-ml.t/run.t +++ b/test/comments-ml.t/run.t @@ -1,8 +1,8 @@ Format basic $ refmt --print re ./input.re > ./formatted.re - refmt: FILENAMES... arguments: no `./input.re' file - Usage: refmt [OPTION]... [FILENAMES]... - Try `refmt --help' for more information. + refmt: FILENAMES… arguments: no './input.re' file + Usage: refmt [OPTION]… [FILENAMES]… + Try 'refmt --help' for more information. [1] Type-check basics From ff9aa8d79ebb0e6d4dd998b970e7ad46741e0c3d Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 19:40:23 -0700 Subject: [PATCH 42/64] feat: install refmt manpage (#2760) * feat: install refmt manpage * restore exit behavior * 4.06 compat * wip --- src/refmt/dune | 10 +++++++ src/refmt/refmt.ml | 68 +++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 77 insertions(+), 1 deletion(-) diff --git a/src/refmt/dune b/src/refmt/dune index 97ad91864..63da7a622 100644 --- a/src/refmt/dune +++ b/src/refmt/dune @@ -12,3 +12,13 @@ (progn (bash "echo let version = \\\"$(git rev-parse --verify HEAD)\\\"") (bash "echo let short_version = \\\"$(git rev-parse --short HEAD)\\\""))))) + +(rule + (with-stdout-to + reason.1 + (run %{bin:refmt} --help=groff))) + +(install + (section man) + (package reason) + (files reason.1)) diff --git a/src/refmt/refmt.ml b/src/refmt/refmt.ml index e2704353a..b3a060fc4 100644 --- a/src/refmt/refmt.ml +++ b/src/refmt/refmt.ml @@ -100,9 +100,74 @@ let refmt (* FIXME: Reason_syntax_util.report_error Format.err_formatter exn; *) exit 1 +let split_lines s = + let rec loop ~last_is_cr ~acc i j = + if j = String.length s + then ( + let acc = + if j = i || (j = i + 1 && last_is_cr) + then acc + else String.sub s i (j - i) :: acc + in + List.rev acc) + else ( + match s.[j] with + | '\r' -> loop ~last_is_cr:true ~acc i (j + 1) + | '\n' -> + let line = + let len = if last_is_cr then j - i - 1 else j - i in + String.sub s i len + in + loop ~acc:(line :: acc) (j + 1) (j + 1) ~last_is_cr:false + | _ -> loop ~acc i (j + 1) ~last_is_cr:false) + in + loop ~acc:[] 0 0 ~last_is_cr:false +;; + +let[@tail_mod_cons] rec concat_map f = function + | [] -> [] + | x::xs -> prepend_concat_map (f x) f xs +and[@tail_mod_cons] prepend_concat_map ys f xs = + match ys with + | [] -> concat_map f xs + | y :: ys -> y :: prepend_concat_map ys f xs + +let examples = function + | [] -> `Blocks [] + | _ :: _ as examples -> + let block_of_example index (intro, ex) = + let prose = `I (string_of_int (index + 1) ^ ".", String.trim intro ^ ":") + and code_lines = + ex + |> String.trim + |> split_lines + |> concat_map (fun codeline -> [ `Noblank; `Pre (" " ^ codeline) ]) + (* suppress initial blank *) + |> List.tl + in + `Blocks (prose :: code_lines) + in + let example_blocks = examples |> List.mapi block_of_example in + `Blocks (`S "EXAMPLES" :: example_blocks) +;; + + let top_level_info = let doc = "Reason's Parser & Pretty-printer" in - let man = [`S "DESCRIPTION"; `P "refmt lets you format Reason files, parse them, and convert them between OCaml syntax and Reason syntax."] in + let man = + [`S "DESCRIPTION" + ; `P "refmt lets you format Reason files, parse them, and convert them between OCaml syntax and Reason syntax." + ; (examples + [ "Initialise a new project named `foo'", "dune init project foo" + ; "Format a Reason implementation file", "refmt file.re" + ; "Format a Reason interface file", "refmt file.rei" + ; "Format interface code from the command line", "echo 'let x: int' | refmt --interface=true" + ; "Convert an OCaml file to Reason", "refmt file.ml" + ; "Convert a Reason file to OCaml", "refmt file.re --print ml" + ; "Convert OCaml from the command line to Reason", "echo 'let x = 1' | refmt --parse ml" + ]) + ] + in let version = "Reason " ^ Package.version ^ " @ " ^ Package.git_short_version in Cmd.info "refmt" ~version ~doc ~man @@ -124,5 +189,6 @@ let refmt_t: [ `Error of bool * string | `Ok of unit ] Cmd.t = let () = match Cmd.eval_value' refmt_t with + | `Exit 0 -> exit 0 | `Exit _ -> exit 1 | _ -> exit 0 From 397b9636aca5b1cb2ca685adce09a8522ce523d8 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 19:41:22 -0700 Subject: [PATCH 43/64] add changelog for #2760 --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index ddc0644da..507122e0c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) - Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753)) - support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) +- install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760)) ## 3.11.0 From a4b5eb1f7fa048fcf1aaa05f892b348b2f50e90f Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 19:55:49 -0700 Subject: [PATCH 44/64] update nix flakes (#2761) --- flake.lock | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/flake.lock b/flake.lock index 2247a4a29..00fd4078e 100644 --- a/flake.lock +++ b/flake.lock @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1719112266, - "narHash": "sha256-Q44wAz9e1lcRC+znQ8jTSAL2GlVKJoagCUC0GcOECEQ=", + "lastModified": 1721519712, + "narHash": "sha256-4YoSuU3bB6nSpSjYoCKtheuQl+U0N/Cbu5TRYzf0/vI=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "ad7cca561d85291a7f994c57017256ee4ef99e7b", + "rev": "339dcd74db4907db0d75ddcf00dc35fa63531272", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1719082008, - "narHash": "sha256-jHJSUH619zBQ6WdC21fFAlDxHErKVDJ5fpN0Hgx4sjs=", + "lastModified": 1721481798, + "narHash": "sha256-GOwbtcTDS7KnVseckF+H8OCRNrwYEqCZ34QOZ+i51e4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "9693852a2070b398ee123a329e68f0dab5526681", + "rev": "a2aeb0fcca8ef063c03ef57fa5de49084d4e9687", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "9693852a2070b398ee123a329e68f0dab5526681", + "rev": "a2aeb0fcca8ef063c03ef57fa5de49084d4e9687", "type": "github" } }, From 54791c87417977c11a56d9381db63ef8c90790a8 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 19:56:32 -0700 Subject: [PATCH 45/64] install `man refmt` instead of `man reason` --- src/refmt/dune | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/refmt/dune b/src/refmt/dune index 63da7a622..c611087ac 100644 --- a/src/refmt/dune +++ b/src/refmt/dune @@ -15,10 +15,10 @@ (rule (with-stdout-to - reason.1 + refmt.1 (run %{bin:refmt} --help=groff))) (install (section man) (package reason) - (files reason.1)) + (files refmt.1)) From 67268619a79b8ab8d6d2805dc196155f70808287 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 20:17:19 -0700 Subject: [PATCH 46/64] remove unused files (#2762) --- .dune-for-prepublish | 1 - .gitattributes | 11 ------ .gitignore | 21 ------------ Makefile | 17 ---------- azure-pipelines.yml | 65 ------------------------------------ pkg/substs | 13 -------- scripts/opam-release.sh | 34 ------------------- scripts/release-check.sh | 40 ---------------------- scripts/test-with-version.sh | 17 ---------- 9 files changed, 219 deletions(-) delete mode 100644 .dune-for-prepublish delete mode 100644 .gitattributes delete mode 100644 azure-pipelines.yml delete mode 100755 pkg/substs delete mode 100755 scripts/opam-release.sh delete mode 100755 scripts/release-check.sh delete mode 100755 scripts/test-with-version.sh diff --git a/.dune-for-prepublish b/.dune-for-prepublish deleted file mode 100644 index 8f45925dd..000000000 --- a/.dune-for-prepublish +++ /dev/null @@ -1 +0,0 @@ -(ignored_subdirs (node_modules)) diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index 93400c736..000000000 --- a/.gitattributes +++ /dev/null @@ -1,11 +0,0 @@ -*.messages binary - -docs/highlightJs/** binary -docs/vendor/** binary -docs/flatdoc.js binary - -bspacks/bspack_source/* binary - -formatTest/idempotentTests/input/assert.crlf.re text eol=crlf -formatTest/idempotentTests/expected_output/assert.crlf.re text eol=crlf -formatTest/idempotentTests/actual_output/assert.crlf.re text eol=crlf diff --git a/.gitignore b/.gitignore index eee575a01..fa46a2146 100644 --- a/.gitignore +++ b/.gitignore @@ -1,31 +1,10 @@ -*.native -*.byte -*.cmt -a.out _build -*.install -pkg/META .DS_Store -formatTest/customMLFiles/*.ml -formatTest/customMLFormatOutput.re -formatTest/failed_tests -formatTest/**/actual_output/ -formatTest/**/intf_output/ -miscTests/reactjs_jsx_ppx_tests/actual*.re -miscTests/reactjs_jsx_ppx_tests/*.cm* *.log -src/reason_parser.messages.bak -src/reason_parser_message.ml -*~ -node_modules -/bspacks/build/ -/bspacks/ocaml-migrate-parsetree/ -/bspacks/closure-compiler/ # gitignored, but not npmignored. Published by `npm run prepublish` refmt.js refmt.map -.merlin # Esy _esy diff --git a/Makefile b/Makefile index e7ee121a0..72db0f6f1 100644 --- a/Makefile +++ b/Makefile @@ -48,23 +48,6 @@ clean-for-ci: esy-prepublish: build node ./scripts/esy-prepublish.js -# For OPAM -release_check: - ./scripts/release-check.sh - -# For OPAM -release: release_check - git add package.json src/refmt/package.ml reason.opam - git commit -m "Version $(version)" - git tag -a $(version) -m "Version $(version)." - # Push first the objects, then the tag. - git push "git@github.com:reasonml/reason.git" - git push "git@github.com:reasonml/reason.git" tag $(version) - git clean -fdx - ./scripts/opam-release.sh - -.PHONY: release - all-supported-ocaml-versions: # the --dev flag has been omitted here but should be re-introduced eventually dune build @install @runtest --root . diff --git a/azure-pipelines.yml b/azure-pipelines.yml deleted file mode 100644 index b56a6cba1..000000000 --- a/azure-pipelines.yml +++ /dev/null @@ -1,65 +0,0 @@ -# Adapted from hello-reason CI: https://github.com/esy-ocaml/hello-reason -name: $(Build.SourceVersion) - -trigger: - - master - - global - - release-* - - releases-* - - feature-* - -stages: -- stage: Build_opam - displayName: Build with opam - dependsOn: [] - jobs: - - job: Mac - strategy: - matrix: { - "opam_4090": { OCAML_VERSION: 4.09.0 }, - "opam_4080": { OCAML_VERSION: 4.08.0 }, - "opam_4071": { OCAML_VERSION: 4.07.1 }, - "opam_4061": { OCAML_VERSION: 4.06.1 } - } - timeoutInMinutes: 0 - pool: - vmImage: 'macOS-latest' - - steps: - - template: .ci/opam-build-steps.yml - -- stage: Build_esy - displayName: Build with esy - dependsOn: [] - jobs: - - template: .ci/build-platform.yml - parameters: - platform: Linux - vmImage: ubuntu-20.04 - - - template: .ci/build-platform.yml - parameters: - platform: macOS - vmImage: macOS-latest - - # Need windows-2019 to do esy import/export-dependencies - # which assumes you have bsdtar (tar.exe) in your system - # otherwise it will end up using the esy-bash tar which doesn't - # understand drives like D:/ (thinks it's an scp path). - - template: .ci/build-platform.yml - parameters: - platform: Windows - vmImage: windows-2019 - - # This job is kept here as we want to have the platform names in the same file - - job: Release - displayName: Release - dependsOn: - - Linux - - macOS - - Windows - pool: - vmImage: macOS-latest - demands: node.js - steps: - - template: .ci/cross-release.yml diff --git a/pkg/substs b/pkg/substs deleted file mode 100755 index 5f3f14d2d..000000000 --- a/pkg/substs +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/env bash -# Copyright (c) 2016-present, Facebook, Inc. All rights reserved. - -re='(.*)@(.*)@(.*)' -replaced=${1%.in} -echo "" > $replaced -cat $1 | while IFS='' read line -do - while [[ $line =~ $re ]]; do - line=${BASH_REMATCH[1]}$(eval echo "\$${BASH_REMATCH[2]}")${BASH_REMATCH[3]} - done - echo "$line" >> $replaced -done diff --git a/scripts/opam-release.sh b/scripts/opam-release.sh deleted file mode 100755 index c62a29602..000000000 --- a/scripts/opam-release.sh +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/env bash - -set -e -set -o pipefail - -USERNAME="$(git config deploy.username)" -TOKEN="$(git config deploy.token)" - -# Make a new release on GitHub, get the ID - -RELEASE_ID=$(\ -curl --silent -H 'Accept: application/vnd.github.v3+json' \ - --user "${USERNAME}:${TOKEN}" \ - -X POST --data "{\"tag_name\": \"${version}\"}" \ - https://api.github.com/repos/reasonml/reason/releases \ - | python -c 'import sys, json; print json.load(sys.stdin)["id"]' \ -) - -echo - -echo "The build artifacts are now in _build. To continue, please cd there." -echo - -echo "In order to publish reason, execute the following two commands:" -echo " 1) opam-publish prepare https://github.com/reasonml/reason/archive/${version}.tar.gz" -echo " 2) opam-publish submit reason.${version}" -echo "The former will prepare a directory in your local folder and the latter" -echo "will submit a pull request to the opam repository." - -echo - -echo "In order to publish to npm, execute the following commands:" -echo " npm publish --access public" -echo "This will publish a npm package with the latest version." diff --git a/scripts/release-check.sh b/scripts/release-check.sh deleted file mode 100755 index 066b53163..000000000 --- a/scripts/release-check.sh +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/env bash - -die () { echo "${1}"; exit 1; } - -USERNAME_MSG="You have not set your deploy username. Please set it with 'git \ -config deploy.username YOUR_GITHUB_USERNAME_HERE'." -TOKEN_MSG="You have not set your deploy token. Please create one with at \ -least public repo read permissions at https://github.com/settings/tokens and \ -set it with 'git config deploy.token YOUR_TOKEN_HERE'." -[[ -z "$(git config deploy.username)" ]] && die "$USERNAME_MSG" -[[ -z "$(git config deploy.token)" ]] && die "$TOKEN_MSG" - -USERNAME="$(git config deploy.username)" -TOKEN="$(git config deploy.token)" - -# Check that the current HEAD is on origin/master. -HEAD=`git rev-parse --verify HEAD` -MASTER=`git rev-parse --verify master` -if [ "${MASTER}" != "${HEAD}" ]; then - echo "** WARNING: You are not on master! If this is a mistake, please abort \ -the release. **" -fi - -MASTERURL="https://api.github.com/repos/facebook/reason/git/refs/heads/master" -HEADERR="Current HEAD is not on upstream master. This is a requirement before releasing. -If you are sure it is, try switching branches to master and pulling changes." -HEADOK="Current HEAD is on upstream master." -echo "Checking HEAD against upstream master..." -curl --silent --user "${USERNAME}:${TOKEN}" "${MASTERURL}" | grep "sha" | grep "${HEAD}" > /dev/null && echo "${HEADOK}" || die "${HEADERR}" - -# Confirm that the user actually means to release. -RANDSTR=`head -c2 Date: Sat, 20 Jul 2024 20:48:26 -0700 Subject: [PATCH 47/64] fix cmd line after migration (#2764) --- dune-project | 2 +- rtop.opam | 2 +- src/refmt/refmt.ml | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/dune-project b/dune-project index 3a9b4ab96..ca204625e 100644 --- a/dune-project +++ b/dune-project @@ -52,7 +52,7 @@ (name rtop) (synopsis "Reason toplevel") (description - "rtop is the toplevel (or REPL) for Reason, based on utop (https://github.com/diml/utop).") + "rtop is the toplevel (or REPL) for Reason, based on utop (https://github.com/ocaml-community/utop).") (depends (ocaml (and diff --git a/rtop.opam b/rtop.opam index a1182b438..7f08f396c 100644 --- a/rtop.opam +++ b/rtop.opam @@ -3,7 +3,7 @@ opam-version: "2.0" version: "3.8.2" synopsis: "Reason toplevel" description: - "rtop is the toplevel (or REPL) for Reason, based on utop (https://github.com/diml/utop)." + "rtop is the toplevel (or REPL) for Reason, based on utop (https://github.com/ocaml-community/utop)." maintainer: [ "Jordan Walke " "Antonio Nuno Monteiro " diff --git a/src/refmt/refmt.ml b/src/refmt/refmt.ml index b3a060fc4..f539f41f2 100644 --- a/src/refmt/refmt.ml +++ b/src/refmt/refmt.ml @@ -172,7 +172,7 @@ let version = "Reason " ^ Package.version ^ " @ " ^ Package.git_short_version in Cmd.info "refmt" ~version ~doc ~man -let refmt_t: [ `Error of bool * string | `Ok of unit ] Cmd.t = +let refmt_t = let open Term in let open Refmt_args in let term = const refmt $ interface @@ -185,7 +185,7 @@ let refmt_t: [ `Error of bool * string | `Ok of unit ] Cmd.t = $ in_place $ input in - Cmd.v top_level_info term + Cmd.v top_level_info (Term.ret term) let () = match Cmd.eval_value' refmt_t with From 9f0ea73cc7e958bb1bd3a37c21be373b6c959c79 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 20:57:17 -0700 Subject: [PATCH 48/64] chore: replace generate/select.ml with cppo (#2763) * chore: replace generate/select.ml with cppo * fix dune file * wip * wip * fix version --- ORIGINS.md | 208 ------------------------ src/generate/dune | 4 - src/generate/select.ml | 40 ----- src/reason-parser/dune | 36 +--- src/reason-parser/ocaml_util.cppo.ml | 21 +++ src/reason-parser/ocaml_util.ml-4.06 | 10 -- src/reason-parser/ocaml_util.ml-4.07 | 10 -- src/reason-parser/ocaml_util.ml-4.08 | 10 -- src/reason-parser/ocaml_util.ml-4.09 | 11 -- src/reason-parser/ocaml_util.ml-4.10 | 11 -- src/reason-parser/ocaml_util.ml-4.11 | 11 -- src/reason-parser/ocaml_util.ml-4.12 | 11 -- src/reason-parser/ocaml_util.ml-4.13 | 11 -- src/reason-parser/ocaml_util.ml-4.14 | 11 -- src/reason-parser/ocaml_util.ml-5.0 | 11 -- src/reason-parser/ocaml_util.ml-5.00 | 11 -- src/reason-parser/ocaml_util.ml-5.1 | 11 -- src/reason-parser/ocaml_util.ml-5.2 | 11 -- src/reason-parser/ocaml_util.ml-default | 10 -- 19 files changed, 23 insertions(+), 436 deletions(-) delete mode 100644 src/generate/dune delete mode 100644 src/generate/select.ml create mode 100644 src/reason-parser/ocaml_util.cppo.ml delete mode 100644 src/reason-parser/ocaml_util.ml-4.06 delete mode 100644 src/reason-parser/ocaml_util.ml-4.07 delete mode 100644 src/reason-parser/ocaml_util.ml-4.08 delete mode 100644 src/reason-parser/ocaml_util.ml-4.09 delete mode 100644 src/reason-parser/ocaml_util.ml-4.10 delete mode 100644 src/reason-parser/ocaml_util.ml-4.11 delete mode 100644 src/reason-parser/ocaml_util.ml-4.12 delete mode 100644 src/reason-parser/ocaml_util.ml-4.13 delete mode 100644 src/reason-parser/ocaml_util.ml-4.14 delete mode 100644 src/reason-parser/ocaml_util.ml-5.0 delete mode 100644 src/reason-parser/ocaml_util.ml-5.00 delete mode 100644 src/reason-parser/ocaml_util.ml-5.1 delete mode 100644 src/reason-parser/ocaml_util.ml-5.2 delete mode 100644 src/reason-parser/ocaml_util.ml-default diff --git a/ORIGINS.md b/ORIGINS.md index 14c8c646c..1d9df300c 100644 --- a/ORIGINS.md +++ b/ORIGINS.md @@ -51,211 +51,3 @@ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - ---- - -`./src/generate` is a fork of [ppx_ast](https://github.com/janestreet/ppx_ast/tree/master/generate), which is licensed under Apache License 2.0. - ---- - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS - - APPENDIX: How to apply the Apache License to your work. - - To apply the Apache License to your work, attach the following - boilerplate notice, with the fields enclosed by brackets "[]" - replaced with your own identifying information. (Don't include - the brackets!) The text should be enclosed in the appropriate - comment syntax for the file format. We also recommend that a - file or class name and description of purpose be included on the - same "printed page" as the copyright notice for easier - identification within third-party archives. - - Copyright [yyyy] [name of copyright owner] - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/src/generate/dune b/src/generate/dune deleted file mode 100644 index c0b713d30..000000000 --- a/src/generate/dune +++ /dev/null @@ -1,4 +0,0 @@ -(executable - (name select) - (libraries str) - (preprocess no_preprocessing)) diff --git a/src/generate/select.ml b/src/generate/select.ml deleted file mode 100644 index 8b848620b..000000000 --- a/src/generate/select.ml +++ /dev/null @@ -1,40 +0,0 @@ -(* - * Originally from https://github.com/janestreet/ppx_ast - * Modified to be compatible with pre-4.04 OCaml - *) - -let dump_file file = - let buf = Bytes.create 1024 in - let ic = open_in file in - let rec loop () = - let len = input ic buf 0 (Bytes.length buf) in - if len = 0 - then () - else - begin - output stdout buf 0 len; - loop () - end - in - loop () - -let version_match = function - | "default" -> true - | version -> - let len = min (String.length Sys.ocaml_version) (String.length version) in - String.sub Sys.ocaml_version 0 len = version - -let () = - let rec select_first i = - if i >= Array.length Sys.argv - then failwith "select.exe failed to select a file." - else - let file = Sys.argv.(i) in - match Str.split (Str.regexp "-") file with - | [_; version] -> - if version_match version - then dump_file file - else select_first (succ i) - | _ -> invalid_arg "select.exe" - in - select_first 1 diff --git a/src/reason-parser/dune b/src/reason-parser/dune index 883b6bfa6..ae2ed22af 100644 --- a/src/reason-parser/dune +++ b/src/reason-parser/dune @@ -5,41 +5,9 @@ (rule (targets ocaml_util.ml) - (deps - ../generate/select.exe - ocaml_util.ml-5.2 - ocaml_util.ml-5.1 - ocaml_util.ml-5.0 - ocaml_util.ml-5.00 - ocaml_util.ml-4.14 - ocaml_util.ml-4.13 - ocaml_util.ml-4.12 - ocaml_util.ml-4.11 - ocaml_util.ml-4.10 - ocaml_util.ml-4.09 - ocaml_util.ml-4.08 - ocaml_util.ml-4.07 - ocaml_util.ml-4.06 - ocaml_util.ml-default) + (deps ocaml_util.cppo.ml) (action - (with-stdout-to - %{targets} - (run - ../generate/select.exe - ocaml_util.ml-5.2 - ocaml_util.ml-5.1 - ocaml_util.ml-5.0 - ocaml_util.ml-5.00 - ocaml_util.ml-4.14 - ocaml_util.ml-4.13 - ocaml_util.ml-4.12 - ocaml_util.ml-4.11 - ocaml_util.ml-4.10 - ocaml_util.ml-4.09 - ocaml_util.ml-4.08 - ocaml_util.ml-4.07 - ocaml_util.ml-4.06 - ocaml_util.ml-default)))) + (run %{bin:cppo} -V OCAML:%{ocaml_version} %{deps} -o %{targets}))) (menhir (flags --strict --inspection --unused-tokens --table --cmly) diff --git a/src/reason-parser/ocaml_util.cppo.ml b/src/reason-parser/ocaml_util.cppo.ml new file mode 100644 index 000000000..ab7aa25c7 --- /dev/null +++ b/src/reason-parser/ocaml_util.cppo.ml @@ -0,0 +1,21 @@ +#if OCAML_VERSION >= (4,6,0) +let warn_latin1 lexbuf = + Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" +#else +let warn_latin1 lexbuf = + Location.prerr_warning (Location.curr lexbuf) + (Warnings.Deprecated "ISO-Latin1 characters in identifiers") +#endif + +let print_loc ppf loc = + Location.print_loc ppf loc + + +let print_error loc f ppf x = +#if OCAML_VERSION >= (4,8,0) + let error = Location.error_of_printer ~loc f x in + Location.print_report ppf error +#else + let error = Location.error_of_printer loc f x in + Location.report_error ppf error +#endif diff --git a/src/reason-parser/ocaml_util.ml-4.06 b/src/reason-parser/ocaml_util.ml-4.06 deleted file mode 100644 index 4e8df510d..000000000 --- a/src/reason-parser/ocaml_util.ml-4.06 +++ /dev/null @@ -1,10 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) - "ISO-Latin1 characters in identifiers" - -let print_loc ppf loc = - Location.print_error ppf loc - -let print_error loc f ppf x = - let error = Location.error_of_printer loc f x in - Location.report_error ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.07 b/src/reason-parser/ocaml_util.ml-4.07 deleted file mode 100644 index 4e8df510d..000000000 --- a/src/reason-parser/ocaml_util.ml-4.07 +++ /dev/null @@ -1,10 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) - "ISO-Latin1 characters in identifiers" - -let print_loc ppf loc = - Location.print_error ppf loc - -let print_error loc f ppf x = - let error = Location.error_of_printer loc f x in - Location.report_error ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.08 b/src/reason-parser/ocaml_util.ml-4.08 deleted file mode 100644 index c054ac07c..000000000 --- a/src/reason-parser/ocaml_util.ml-4.08 +++ /dev/null @@ -1,10 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) - "ISO-Latin1 characters in identifiers" - -let print_loc ppf loc = - Location.print_loc ppf loc - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.09 b/src/reason-parser/ocaml_util.ml-4.09 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.09 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.10 b/src/reason-parser/ocaml_util.ml-4.10 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.10 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.11 b/src/reason-parser/ocaml_util.ml-4.11 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.11 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.12 b/src/reason-parser/ocaml_util.ml-4.12 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.12 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.13 b/src/reason-parser/ocaml_util.ml-4.13 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.13 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-4.14 b/src/reason-parser/ocaml_util.ml-4.14 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-4.14 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-5.0 b/src/reason-parser/ocaml_util.ml-5.0 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-5.0 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-5.00 b/src/reason-parser/ocaml_util.ml-5.00 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-5.00 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-5.1 b/src/reason-parser/ocaml_util.ml-5.1 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-5.1 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-5.2 b/src/reason-parser/ocaml_util.ml-5.2 deleted file mode 100644 index d46adf43f..000000000 --- a/src/reason-parser/ocaml_util.ml-5.2 +++ /dev/null @@ -1,11 +0,0 @@ -let warn_latin1 lexbuf = - Location.deprecated (Location.curr lexbuf) "ISO-Latin1 characters in identifiers" -;; - -let print_loc ppf loc = - Location.print_loc ppf loc - - -let print_error loc f ppf x = - let error = Location.error_of_printer ~loc f x in - Location.print_report ppf error diff --git a/src/reason-parser/ocaml_util.ml-default b/src/reason-parser/ocaml_util.ml-default deleted file mode 100644 index 5d19712a0..000000000 --- a/src/reason-parser/ocaml_util.ml-default +++ /dev/null @@ -1,10 +0,0 @@ -let warn_latin1 lexbuf = - Location.prerr_warning (Location.curr lexbuf) - (Warnings.Deprecated "ISO-Latin1 characters in identifiers") - -let print_loc ppf loc = - Location.print_error ppf loc - -let print_error loc f ppf x = - let error = Location.error_of_printer loc f x in - Location.report_error ppf error From 035e63397830c7f4a26e7c26ac05bad4c09615e0 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 22:49:40 -0700 Subject: [PATCH 49/64] feat: add refutation clause (#2765) * feat: add refutation clause * add changelog entry --- CHANGES.md | 1 + src/reason-parser/reason_parser.mly | 19 +++++++++++++++++-- src/reason-parser/reason_pprint_ast.ml | 1 + test/general-syntax-re.t/input.re | 2 ++ test/general-syntax-re.t/run.t | 5 +++++ 5 files changed, 26 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 507122e0c..2dc2c14e8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ - Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753)) - support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) - install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760)) +- add support for parsing / printing of refutation clause in `switch` (@anmonteiro, [#2765](https://github.com/reasonml/reason/pull/2765)) ## 3.11.0 diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 868333f33..e100fc0ea 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -3463,13 +3463,28 @@ letop_bindings: %inline match_cases(EXPR): lnonempty_list(match_case(EXPR)) { $1 }; match_case(EXPR): - as_loc(BAR) pattern preceded(WHEN,expr)? EQUALGREATER EXPR + | as_loc(BAR) pattern EQUALGREATER EXPR { let pat = {$2 with ppat_loc = { $2.ppat_loc with loc_start = $1.loc.loc_start } } in - Ast_helper.Exp.case pat ?guard:$3 $5 } + Ast_helper.Exp.case pat $4 } + | as_loc(BAR) pattern preceded(WHEN,expr) EQUALGREATER EXPR + { let pat = {$2 with ppat_loc = + { $2.ppat_loc with + loc_start = $1.loc.loc_start + } + } in + Ast_helper.Exp.case pat ~guard:$3 $5 } + | as_loc(BAR) pattern EQUALGREATER as_loc(DOT) + { + let pat = { + $2 with ppat_loc = + { $2.ppat_loc with loc_start = $1.loc.loc_start } + } in + Ast_helper.Exp.(case pat (unreachable ~loc:$4.loc ())) + } ; fun_def(DELIM, typ): diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 8b28e3857..6252d7e53 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -6483,6 +6483,7 @@ let printer = object(self:'self) let lhs = self#simple_enough_to_be_lhs_dot_send e in let lhs = if needparens then makeList ~wrap:("(",")") [lhs] else lhs in Some (label (makeList [lhs; atom "#";]) (atom s.txt)) + | Pexp_unreachable -> Some (atom ".") | _ -> None in match item with diff --git a/test/general-syntax-re.t/input.re b/test/general-syntax-re.t/input.re index 7fc15217d..58b122b01 100644 --- a/test/general-syntax-re.t/input.re +++ b/test/general-syntax-re.t/input.re @@ -1282,3 +1282,5 @@ class y = { let x = 1G; let x = 1.123g; +let x = switch () { | _ => .}; + diff --git a/test/general-syntax-re.t/run.t b/test/general-syntax-re.t/run.t index 83fbf6c70..7961c3f89 100644 --- a/test/general-syntax-re.t/run.t +++ b/test/general-syntax-re.t/run.t @@ -1467,3 +1467,8 @@ Format general implementation syntax let x = 1G; let x = 1.123g; + + let x = + switch () { + | _ => . + }; From 5451aa39651683228783aefa009e800cedf2d512 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 20 Jul 2024 23:37:04 -0700 Subject: [PATCH 50/64] support external%foo in signatures (#2766) * support external%foo in signatures * changelog entry --- CHANGES.md | 2 +- src/reason-parser/reason_parser.mly | 21 ++++++++++++++++----- src/reason-parser/reason_pprint_ast.ml | 13 ++++++++++++- test/general-syntax-rei.t/input.rei | 3 +++ test/general-syntax-rei.t/run.t | 3 +++ 5 files changed, 35 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 2dc2c14e8..212d18194 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,7 +5,7 @@ - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) - Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753)) -- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750)) +- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750), [#2766](https://github.com/reasonml/reason/pull/2766)) - install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760)) - add support for parsing / printing of refutation clause in `switch` (@anmonteiro, [#2765](https://github.com/reasonml/reason/pull/2765)) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index e100fc0ea..c9cb95ced 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1888,7 +1888,6 @@ signature: | signature_items SEMI signature { $1 @ $3 } ; - signature_item: | item_attributes LET as_loc(val_ident) COLON core_type @@ -1896,14 +1895,26 @@ signature_item: Psig_value (Ast_helper.Val.mk $3 $5 ~attrs:$1 ~loc) } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type EQUAL primitive_declaration + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - Psig_value (Ast_helper.Val.mk $3 $5 ~prim:$7 ~attrs:$1 ~loc) + let psig_prim = + Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc) + in + match $3 with + | None -> psig_prim + | Some (ext_attrs, ext_id) -> + (Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs)) } | item_attributes - EXTERNAL as_loc(val_ident) COLON core_type SEMI + EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - Psig_value (Ast_helper.Val.mk $3 $5 ~prim:[""] ~attrs:$1 ~loc) + let psig_prim = + Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc) + in + match $3 with + | None -> psig_prim + | Some (ext_attrs, ext_id) -> + (Ppxlib.Parsetree.Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs)) } | type_declarations { let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) } diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 6252d7e53..a1ed911ea 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -7174,6 +7174,17 @@ let printer = object(self:'self) (self#class_self_pattern_and_structure cs) method signature signatureItems = + let signature_item item = + match item.psig_desc with + | Psig_extension ((extension, PSig [item]), _attrs) -> + begin match item.psig_desc with + (* In case of a value or `external`, the extension gets inlined + `let%private a = 1` *) + | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd + | _ -> self#signature_item item + end + | _ -> self#signature_item item + in match signatureItems with | [] -> atom "" | first::_ as signatureItems -> @@ -7182,7 +7193,7 @@ let printer = object(self:'self) let loc_end = last.psig_loc.loc_end in let items = groupAndPrint - ~xf:self#signature_item + ~xf:signature_item ~getLoc:(fun x -> x.psig_loc) ~comments:self#comments signatureItems diff --git a/test/general-syntax-rei.t/input.rei b/test/general-syntax-rei.t/input.rei index 766c53ec9..1e261ad7b 100644 --- a/test/general-syntax-rei.t/input.rei +++ b/test/general-syntax-rei.t/input.rei @@ -39,3 +39,6 @@ let not : string => string; let other : string => not; include (module type of Bos.Cmd) with type t = Bos.Cmd.t; + +external%foo bar: string => string = ""; +[%%foo: external bar: int => int = "hello" ] diff --git a/test/general-syntax-rei.t/run.t b/test/general-syntax-rei.t/run.t index 7a0ef630b..8f9294fc8 100644 --- a/test/general-syntax-rei.t/run.t +++ b/test/general-syntax-rei.t/run.t @@ -48,3 +48,6 @@ Format general interface syntax include (module type of Bos.Cmd) with type t = Bos.Cmd.t; + + external%foo bar: string => string; + external%foo bar: int => int = "hello"; From 0fdad2b86f1b4bb8e7da05853013c29aacdfafad Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 21 Jul 2024 15:54:05 -0700 Subject: [PATCH 51/64] add ocaml version to nix pipeline name (#2768) --- .github/workflows/nix-build.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/nix-build.yml b/.github/workflows/nix-build.yml index df38437f6..70e19ddf5 100644 --- a/.github/workflows/nix-build.yml +++ b/.github/workflows/nix-build.yml @@ -12,7 +12,7 @@ concurrency: jobs: ubuntu-tests: - name: Build and test (Ubuntu) + name: Build and test (Ubuntu) (${{ matrix.ocaml-version }}) strategy: matrix: @@ -36,7 +36,7 @@ jobs: run: nix-build ./nix/ci.nix --argstr ocamlVersion ${{ matrix.ocaml-version }} macos-tests: - name: Build and test (${{ matrix.os }}) + name: Build and test (${{ matrix.os }}) (${{ matrix.ocaml-version }}) strategy: matrix: From de61caba5de693fac236debe5d86e25530262ba5 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 21 Jul 2024 15:54:21 -0700 Subject: [PATCH 52/64] handle `external%foo` in `module type`s (#2767) * handle `external%foo` in `module type`s * changelog entry --- CHANGES.md | 2 +- src/reason-parser/reason_pprint_ast.ml | 26 +++++++++++++------------- test/modules.t/input.re | 13 +++++++++++++ test/modules.t/run.t | 13 +++++++++++++ 4 files changed, 40 insertions(+), 14 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 212d18194..87b16cc73 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,7 +5,7 @@ - Support local open and let bindings (@SanderSpies) [#2716](https://github.com/reasonml/reason/pull/2716) - outcome printer: change the printing of `@bs.*` to `@mel.*` (@anmonteiro, [#2755](https://github.com/reasonml/reason/pull/2755)) - Fix outcome printing of optional arguments on OCaml 5.2 (@anmonteiro, [#2753](https://github.com/reasonml/reason/pull/2753)) -- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750), [#2766](https://github.com/reasonml/reason/pull/2766)) +- support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750), [#2766](https://github.com/reasonml/reason/pull/2766), [#2767](https://github.com/reasonml/reason/pull/2767)) - install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760)) - add support for parsing / printing of refutation clause in `switch` (@anmonteiro, [#2765](https://github.com/reasonml/reason/pull/2765)) diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index a1ed911ea..2abdaba09 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -7174,17 +7174,6 @@ let printer = object(self:'self) (self#class_self_pattern_and_structure cs) method signature signatureItems = - let signature_item item = - match item.psig_desc with - | Psig_extension ((extension, PSig [item]), _attrs) -> - begin match item.psig_desc with - (* In case of a value or `external`, the extension gets inlined - `let%private a = 1` *) - | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd - | _ -> self#signature_item item - end - | _ -> self#signature_item item - in match signatureItems with | [] -> atom "" | first::_ as signatureItems -> @@ -7193,7 +7182,7 @@ let printer = object(self:'self) let loc_end = last.psig_loc.loc_end in let items = groupAndPrint - ~xf:signature_item + ~xf:self#signature_item ~getLoc:(fun x -> x.psig_loc) ~comments:self#comments signatureItems @@ -7207,7 +7196,18 @@ let printer = object(self:'self) ~sep:(SepFinal (";", ";")) items) - method signature_item x : Layout.t = + method signature_item item : Layout.t = + match item.psig_desc with + | Psig_extension ((extension, PSig [item]), _attrs) -> + begin match item.psig_desc with + (* In case of a value or `external`, the extension gets inlined + `let%private a = 1` *) + | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd + | _ -> self#signature_item' item + end + | _ -> self#signature_item' item + + method signature_item' x : Layout.t = let item: Layout.t = match x.psig_desc with | Psig_type (rf, l) -> diff --git a/test/modules.t/input.re b/test/modules.t/input.re index 949967da2..2e953779f 100644 --- a/test/modules.t/input.re +++ b/test/modules.t/input.re @@ -510,3 +510,16 @@ let y = Promise.Ops.( Js.Promise.resolve(x * 2) ) ); + +module WithExternalExtension: { + external%foo bar: string => string = ""; + [%%foo: external bar: int => int = "hello" ]; +} = { + external%foo bar: string => string = ""; + [%%foo external bar: int => int = "hello" ]; +} + +module type TypeWithExternalExtension = { + external%foo bar: string => string = ""; + [%%foo: external bar: int => int = "hello" ]; +} diff --git a/test/modules.t/run.t b/test/modules.t/run.t index cb19ba460..9311b0434 100644 --- a/test/modules.t/run.t +++ b/test/modules.t/run.t @@ -676,4 +676,17 @@ Format modules Js.Promise.resolve(x * 2); ) ); + + module WithExternalExtension: { + external%foo bar: string => string; + external%foo bar: int => int = "hello"; + } = { + external%foo bar: string => string; + external%foo bar: int => int = "hello"; + }; + + module type TypeWithExternalExtension = { + external%foo bar: string => string; + external%foo bar: int => int = "hello"; + }; /* From http://stackoverflow.com/questions/1986374/ higher-order-type-constructors-and-functors-in-ocaml */ From 6b7c24874fa0db4aeed3b9e951bbf38c6c747b4a Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 21 Jul 2024 17:09:00 -0700 Subject: [PATCH 53/64] refactor(parser): `{Pstr,Psig}_extension` (#2769) --- src/reason-parser/reason_parser.mly | 34 +++++++++++++++-------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index c9cb95ced..1c90e7b1c 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -778,6 +778,20 @@ let wrap_type_annotation newtypes core_type body = let struct_item_extension (ext_attrs, ext_id) structure_items = mkstr ~ghost:true (Pstr_extension ((ext_id, PStr structure_items), ext_attrs)) +let wrap_str_ext ~loc body ext = + match ext with + | None -> body + | Some (ext_attrs, ext_id) -> + Ast_helper.Str.mk + ~loc:(make_ghost_loc loc) + (Pstr_extension ((ext_id, PStr [body]), ext_attrs)) + +let wrap_sig_ext ~loc body ext = + match ext with + | None -> body + | Some (ext_attrs, ext_id) -> + Ppxlib.Parsetree.Psig_extension ((ext_id, PSig [mksig ~loc body]), ext_attrs) + let expression_extension ?loc (ext_attrs, ext_id) item_expr = let extension = (ext_id, Ppxlib.Parsetree.PStr [mkstrexp item_expr []]) in let loc = match loc with @@ -1676,10 +1690,7 @@ structure_item: let pstr_prim = mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)) in - match $3 with - | None -> pstr_prim - | Some ext -> - struct_item_extension ext [pstr_prim] + wrap_str_ext ~loc pstr_prim $3 } | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI @@ -1687,10 +1698,7 @@ structure_item: let pstr_prim = mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)) in - match $3 with - | None -> pstr_prim - | Some ext -> - struct_item_extension ext [pstr_prim] + wrap_str_ext ~loc pstr_prim $3 } | type_declarations { let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) } @@ -1900,10 +1908,7 @@ signature_item: let psig_prim = Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc) in - match $3 with - | None -> psig_prim - | Some (ext_attrs, ext_id) -> - (Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs)) + wrap_sig_ext ~loc psig_prim $3 } | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI @@ -1911,10 +1916,7 @@ signature_item: let psig_prim = Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc) in - match $3 with - | None -> psig_prim - | Some (ext_attrs, ext_id) -> - (Ppxlib.Parsetree.Psig_extension ((ext_id, PSig [mksig ~loc psig_prim]), ext_attrs)) + wrap_sig_ext ~loc psig_prim $3 } | type_declarations { let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) } From e6debb60e8856b962c9854819a72779bf05d7a13 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 21 Jul 2024 18:36:23 -0700 Subject: [PATCH 54/64] feat: support `let%ppx` in signatures (#2770) --- src/reason-parser/reason_parser.mly | 39 +++++++++++++----------- src/reason-parser/reason_pprint_ast.ml | 42 ++++++++++++++------------ test/general-syntax-rei.t/input.rei | 6 +++- test/general-syntax-rei.t/run.t | 3 ++ 4 files changed, 52 insertions(+), 38 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 1c90e7b1c..224f30aaf 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1687,18 +1687,18 @@ structure_item: | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - let pstr_prim = - mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)) - in - wrap_str_ext ~loc pstr_prim $3 + wrap_str_ext + ~loc + (mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc))) + $3 } | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - let pstr_prim = - mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)) - in - wrap_str_ext ~loc pstr_prim $3 + wrap_str_ext + ~loc + (mkstr (Pstr_primitive (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc))) + $3 } | type_declarations { let (nonrec_flag, tyl) = $1 in mkstr(Pstr_type (nonrec_flag, tyl)) } @@ -1898,25 +1898,28 @@ signature: signature_item: | item_attributes - LET as_loc(val_ident) COLON core_type + LET item_extension_sugar? as_loc(val_ident) COLON core_type { let loc = mklocation $startpos($2) $endpos in - Psig_value (Ast_helper.Val.mk $3 $5 ~attrs:$1 ~loc) + wrap_sig_ext + ~loc + (Psig_value (Ast_helper.Val.mk $4 $6 ~attrs:$1 ~loc)) + $3 } | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type EQUAL primitive_declaration { let loc = mklocation $symbolstartpos $endpos in - let psig_prim = - Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc) - in - wrap_sig_ext ~loc psig_prim $3 + wrap_sig_ext + ~loc + (Psig_value (Ast_helper.Val.mk $4 $6 ~prim:$8 ~attrs:$1 ~loc)) + $3 } | item_attributes EXTERNAL item_extension_sugar? as_loc(val_ident) COLON core_type SEMI { let loc = mklocation $symbolstartpos $endpos in - let psig_prim = - Ppxlib.Parsetree.Psig_value (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc) - in - wrap_sig_ext ~loc psig_prim $3 + wrap_sig_ext + ~loc + (Psig_value (Ast_helper.Val.mk $4 $6 ~prim:[""] ~attrs:$1 ~loc)) + $3 } | type_declarations { let (nonrec_flag, tyl) = $1 in Psig_type (nonrec_flag, tyl) } diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 2abdaba09..a7875fcf0 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -7203,34 +7203,38 @@ let printer = object(self:'self) (* In case of a value or `external`, the extension gets inlined `let%private a = 1` *) | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd - | _ -> self#signature_item' item + | Psig_value vd -> self#val_binding ~extension vd + | _ -> self#payload "%%" extension (PSig [item]) end | _ -> self#signature_item' item + method val_binding ?extension vd = + let intro = add_extension_sugar "let" extension in + let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true vd.pval_attributes in + let layout = self#attach_std_item_attrs stdAttrs + (formatTypeConstraint + (label ~space:true (atom intro) + (source_map ~loc:vd.pval_name.loc + (protectIdentifier vd.pval_name.txt))) + (self#core_type vd.pval_type)) + in + self#attachDocAttrsToLayout + ~stdAttrs + ~docAttrs + ~loc:vd.pval_loc + ~layout + () + method signature_item' x : Layout.t = let item: Layout.t = match x.psig_desc with | Psig_type (rf, l) -> self#type_def_list (rf, l) | Psig_value vd -> - if vd.pval_prim != [] then - self#primitive_declaration vd - else - let intro = atom "let" in - let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true vd.pval_attributes in - let layout = self#attach_std_item_attrs stdAttrs - (formatTypeConstraint - (label ~space:true intro - (source_map ~loc:vd.pval_name.loc - (protectIdentifier vd.pval_name.txt))) - (self#core_type vd.pval_type)) - in - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:vd.pval_loc - ~layout - () + if vd.pval_prim != [] then + self#primitive_declaration vd + else + self#val_binding vd | Psig_typext te -> self#type_extension te | Psig_exception ed -> diff --git a/test/general-syntax-rei.t/input.rei b/test/general-syntax-rei.t/input.rei index 1e261ad7b..c8eab395f 100644 --- a/test/general-syntax-rei.t/input.rei +++ b/test/general-syntax-rei.t/input.rei @@ -41,4 +41,8 @@ let other : string => not; include (module type of Bos.Cmd) with type t = Bos.Cmd.t; external%foo bar: string => string = ""; -[%%foo: external bar: int => int = "hello" ] +[%%foo: external bar: int => int = "hello" ]; + +[%%foo: let foo: bar]; +let%foo foo: bar; + diff --git a/test/general-syntax-rei.t/run.t b/test/general-syntax-rei.t/run.t index 8f9294fc8..e25ccfbaf 100644 --- a/test/general-syntax-rei.t/run.t +++ b/test/general-syntax-rei.t/run.t @@ -51,3 +51,6 @@ Format general interface syntax external%foo bar: string => string; external%foo bar: int => int = "hello"; + + let%foo foo: bar; + let%foo foo: bar; From 5c353b64d6d35decf3f85ab6bab92b1c58cf0f59 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sun, 21 Jul 2024 18:38:14 -0700 Subject: [PATCH 55/64] add changelog entry for #2770 --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index 87b16cc73..a261ed92f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,7 @@ - support parsing and printing of `external%extension` (@anmonteiro, [#2750](https://github.com/reasonml/reason/pull/2750), [#2766](https://github.com/reasonml/reason/pull/2766), [#2767](https://github.com/reasonml/reason/pull/2767)) - install `refmt` manpage (@anmonteiro, [#2760](https://github.com/reasonml/reason/pull/2760)) - add support for parsing / printing of refutation clause in `switch` (@anmonteiro, [#2765](https://github.com/reasonml/reason/pull/2765)) +- support `let%ppx` in signatures (@anmonteiro, [#2770](https://github.com/reasonml/reason/pull/2770)) ## 3.11.0 From 66d220960cb0fedc3674a1e80aa13b599e9a633e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Mon, 22 Jul 2024 21:17:09 -0700 Subject: [PATCH 56/64] prep 3.12.0 --- CHANGES.md | 2 +- flake.lock | 14 +++++++------- nix/shell.nix | 11 +++-------- 3 files changed, 11 insertions(+), 16 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index a261ed92f..f2dfd5704 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,4 +1,4 @@ -## Unreleased +## 3.12.0 - Add `\u{hex-escape}` syntax (@anmonteiro, [#2738](https://github.com/reasonml/reason/pull/2738)) diff --git a/flake.lock b/flake.lock index 00fd4078e..f44c0c3ca 100644 --- a/flake.lock +++ b/flake.lock @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1721519712, - "narHash": "sha256-4YoSuU3bB6nSpSjYoCKtheuQl+U0N/Cbu5TRYzf0/vI=", + "lastModified": 1721686842, + "narHash": "sha256-IJbA2AeIk6l83E20/3utoNY8bORapbtZ3+urCCNglhQ=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "339dcd74db4907db0d75ddcf00dc35fa63531272", + "rev": "24fc6eca8fc6d4e0a125bfeea32b07f726d9d7e7", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1721481798, - "narHash": "sha256-GOwbtcTDS7KnVseckF+H8OCRNrwYEqCZ34QOZ+i51e4=", + "lastModified": 1721660125, + "narHash": "sha256-q2t9tTFk0KrcnfU879WZ4cZJD1OONOq8tZXZXPo6llI=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "a2aeb0fcca8ef063c03ef57fa5de49084d4e9687", + "rev": "09f65ccafc83ce77148375672be19e6746e45db8", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "a2aeb0fcca8ef063c03ef57fa5de49084d4e9687", + "rev": "09f65ccafc83ce77148375672be19e6746e45db8", "type": "github" } }, diff --git a/nix/shell.nix b/nix/shell.nix index 613f20524..1a45ecba7 100644 --- a/nix/shell.nix +++ b/nix/shell.nix @@ -11,12 +11,7 @@ mkShell { inputsFrom = [ reason ]; - buildInputs = with ocamlPackages; [ utop merlin ] ++ (if release-mode then [ - cacert - curl - dune-release - git - ] else [ ]) - ; - + buildInputs = + with ocamlPackages; [ utop merlin odoc ] + ++ (if release-mode then [ cacert curl dune-release git ] else [ ]); } From a8a9ca2075e69c4d58a3f714b15d61e9ae977b1e Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 17:12:55 -0700 Subject: [PATCH 57/64] min version 4.06 (#2772) --- dune-project | 4 ++-- flake.lock | 14 +++++++------- reason.opam | 2 +- rtop.opam | 2 +- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/dune-project b/dune-project index ca204625e..1b6ec35a2 100644 --- a/dune-project +++ b/dune-project @@ -33,7 +33,7 @@ (depends (ocaml (and - (>= "4.03") + (>= "4.06") (< "5.3"))) (ocamlfind :build) (dune-build-info @@ -56,7 +56,7 @@ (depends (ocaml (and - (>= "4.03") + (>= "4.06") (< "5.3"))) (reason (= :version)) diff --git a/flake.lock b/flake.lock index f44c0c3ca..8e2bbeedf 100644 --- a/flake.lock +++ b/flake.lock @@ -41,11 +41,11 @@ "nixpkgs": "nixpkgs_2" }, "locked": { - "lastModified": 1721686842, - "narHash": "sha256-IJbA2AeIk6l83E20/3utoNY8bORapbtZ3+urCCNglhQ=", + "lastModified": 1722116270, + "narHash": "sha256-6OXktUFeIGF3hjZkjgXEfWmlzKfTPq6zCj4tyfTrzCo=", "owner": "nix-ocaml", "repo": "nix-overlays", - "rev": "24fc6eca8fc6d4e0a125bfeea32b07f726d9d7e7", + "rev": "f882af657269eb64a42a87ead46734808222a1dd", "type": "github" }, "original": { @@ -56,17 +56,17 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1721660125, - "narHash": "sha256-q2t9tTFk0KrcnfU879WZ4cZJD1OONOq8tZXZXPo6llI=", + "lastModified": 1722061360, + "narHash": "sha256-1VVW4OOrpyKohagGDfaHAbRANad+OE+PnR4PDvF8vSU=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "09f65ccafc83ce77148375672be19e6746e45db8", + "rev": "4a39c8d0b533fd8347bf7a01609434b0949f2864", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "09f65ccafc83ce77148375672be19e6746e45db8", + "rev": "4a39c8d0b533fd8347bf7a01609434b0949f2864", "type": "github" } }, diff --git a/reason.opam b/reason.opam index d66de74ce..06bf876a7 100644 --- a/reason.opam +++ b/reason.opam @@ -16,7 +16,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.3"} + "ocaml" {>= "4.06" & < "5.3"} "ocamlfind" {build} "dune-build-info" {>= "2.9.3"} "menhir" {>= "20180523"} diff --git a/rtop.opam b/rtop.opam index 7f08f396c..ef1ea2eb3 100644 --- a/rtop.opam +++ b/rtop.opam @@ -14,7 +14,7 @@ homepage: "https://reasonml.github.io/" bug-reports: "https://github.com/reasonml/reason/issues" depends: [ "dune" {>= "2.9"} - "ocaml" {>= "4.03" & < "5.3"} + "ocaml" {>= "4.06" & < "5.3"} "reason" {= version} "utop" {>= "2.0"} "cppo" From 5ee853dd01212c79202ff35863178741484e5dfe Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 19:47:45 -0700 Subject: [PATCH 58/64] feat: support `module%ppx` syntax (#2771) * feat: support `module%ppx` syntax * let module%foo * rec module in structures * psig_recmodule --- src/reason-parser/reason_parser.mly | 61 ++++-- src/reason-parser/reason_pprint_ast.ml | 269 +++++++++++++------------ test/general-syntax-rei.t/input.rei | 6 + test/general-syntax-rei.t/run.t | 6 + test/modules.t/input.re | 17 ++ test/modules.t/run.t | 17 ++ 6 files changed, 234 insertions(+), 142 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 224f30aaf..e9d04d25f 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -1664,15 +1664,16 @@ structure: ; opt_LET_MODULE_ident: - | opt_LET_MODULE as_loc(mod_ident) { $2 } - | opt_LET_MODULE as_loc(LIDENT) - { syntax_error $2.loc lowercase_module_msg; { $2 with txt = Some $2.txt } } + | opt_LET_MODULE item_extension_sugar as_loc(mod_ident) { Some $2, $3 } + | opt_LET_MODULE as_loc(mod_ident) { None, $2 } + | opt_LET_MODULE item_extension_sugar? as_loc(LIDENT) + { syntax_error $3.loc lowercase_module_msg; $2, { $3 with txt = Some $3.txt } } ; opt_LET_MODULE_REC_ident: - | opt_LET_MODULE REC as_loc(mod_ident) { $3 } - | opt_LET_MODULE REC as_loc(LIDENT) - { syntax_error $3.loc lowercase_module_msg; { $3 with txt = Some $3.txt } } + | opt_LET_MODULE item_extension_sugar? REC as_loc(mod_ident) { $2, $4 } + | opt_LET_MODULE item_extension_sugar? REC as_loc(LIDENT) + { syntax_error $4.loc lowercase_module_msg; $2, { $4 with txt = Some $4.txt } } ; structure_item: @@ -1708,11 +1709,20 @@ structure_item: { mkstr(Pstr_exception (Ast_helper.Te.mk_exception ~loc:$1.pext_loc $1)) } | item_attributes opt_LET_MODULE_ident module_binding_body { let loc = mklocation $symbolstartpos $endpos in - mkstr(Pstr_module (Ast_helper.Mb.mk $2 $3 ~attrs:$1 ~loc)) } + let ext, letmod = $2 in + wrap_str_ext + ~loc + (mkstr(Pstr_module (Ast_helper.Mb.mk letmod $3 ~attrs:$1 ~loc))) + ext + } | item_attributes opt_LET_MODULE_REC_ident module_binding_body and_module_bindings* { let loc = mklocation $symbolstartpos $endpos($2) in - mkstr (Pstr_recmodule ((Ast_helper.Mb.mk $2 $3 ~attrs:$1 ~loc) :: $4)) + let ext, letmodule = $2 in + wrap_str_ext + ~loc + (mkstr (Pstr_recmodule ((Ast_helper.Mb.mk letmodule $3 ~attrs:$1 ~loc) :: $4))) + ext } | item_attributes MODULE TYPE OF? as_loc(ident) { let loc = mklocation $symbolstartpos $endpos in @@ -1931,25 +1941,37 @@ signature_item: { Psig_exception $1 } | item_attributes opt_LET_MODULE_ident module_declaration { let loc = mklocation $symbolstartpos $endpos in - Psig_module (Ast_helper.Md.mk $2 $3 ~attrs:$1 ~loc) + let ext, letmod = $2 in + wrap_sig_ext + ~loc + (Psig_module (Ast_helper.Md.mk letmod $3 ~attrs:$1 ~loc)) + ext } | item_attributes opt_LET_MODULE_ident EQUAL as_loc(mod_longident) { let loc = mklocation $symbolstartpos $endpos in let loc_mod = mklocation $startpos($4) $endpos($4) in - Psig_module ( - Ast_helper.Md.mk - $2 + let ext, letmod = $2 in + wrap_sig_ext + ~loc + (Psig_module + (Ast_helper.Md.mk + letmod (Ast_helper.Mty.alias ~loc:loc_mod $4) ~attrs:$1 - ~loc - ) + ~loc)) + ext } | item_attributes opt_LET_MODULE as_loc(UIDENT) COLONEQUAL as_loc(mod_ext_longident) { Psig_modsubst (Ast_helper.Ms.mk $3 $5 ~attrs:$1 ~loc:(mklocation $symbolstartpos $endpos))} | item_attributes opt_LET_MODULE_REC_ident module_type_body(COLON) and_module_rec_declaration* { let loc = mklocation $symbolstartpos $endpos($3) in - Psig_recmodule (Ast_helper.Md.mk $2 $3 ~attrs:$1 ~loc :: $4) } + let ext, letmodule = $2 in + wrap_sig_ext + ~loc + (Psig_recmodule (Ast_helper.Md.mk letmodule $3 ~attrs:$1 ~loc :: $4)) + ext + } | item_attributes MODULE TYPE as_loc(ident) { let loc = mklocation $symbolstartpos $endpos in Psig_modtype (Ast_helper.Mtd.mk $4 ~attrs:$1 ~loc) @@ -2536,7 +2558,14 @@ mark_position_exp seq_expr_no_seq [@recover.expr default_expr ()] (semi): | expr semi { $1 } | opt_LET_MODULE_ident module_binding_body SEMI seq_expr(SEMI?) - { mkexp (Pexp_letmodule($1, $2, $4)) } + { let loc = mklocation $symbolstartpos $endpos in + let ext, letmod = $1 in + let exp = mkexp (Pexp_letmodule(letmod, $2, $4)) in + match ext with + | None -> exp + | Some (ext_attrs, ext_id) -> + mkexp ~loc (Pexp_extension (ext_id, PStr [mkstrexp exp ext_attrs])) + } | item_attributes LET? OPEN override_flag as_loc(mod_longident) SEMI seq_expr(SEMI?) { let loc = (mklocation $startpos($1) $endpos($4)) in let me = Ast_helper.Mod.ident ~loc $5 in diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index a7875fcf0..31144c30b 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -162,7 +162,7 @@ let expression_immediate_extension_sugar x = | Some (name, expr) -> match expr.pexp_desc with | Pexp_for _ | Pexp_while _ | Pexp_ifthenelse _ | Pexp_function _ - | Pexp_newtype _ | Pexp_try _ | Pexp_match _ -> + | Pexp_newtype _ | Pexp_try _ | Pexp_match _ (* | Pexp_letmodule _ *) -> (Some name, expr) | _ -> (None, x) @@ -5516,6 +5516,28 @@ let printer = object(self:'self) itemsLayout method letList expr = + let letModuleBinding ?extension s me = + let prefixText = add_extension_sugar "module" extension in + let bindingName = atom ~loc:s.loc (moduleIdent s) in + let moduleExpr = me in + let letModuleLayout = + (self#let_module_binding prefixText bindingName moduleExpr) in + let letModuleLoc = { + loc_start = s.loc.loc_start; + loc_end = me.pmod_loc.loc_end; + loc_ghost = false + } in + (* Just like the bindings, have to synthesize a location since the + * Pexp location is parsed (potentially) beginning with the open + * brace {} in the let sequence. *) + let layout = source_map ~loc:letModuleLoc letModuleLayout in + let (_, return) = self#curriedFunctorPatternsAndReturnStruct moduleExpr in + let loc = { + letModuleLoc with + loc_end = return.pmod_loc.loc_end + } in + (loc, layout) + in (* Recursively transform a nested ast of "let-items", into a flat * list containing the location indicating start/end of the "let-item" and * its layout. *) @@ -5576,26 +5598,8 @@ let printer = object(self:'self) processLetList ((loc, layout)::acc) e ) | ([], Pexp_letmodule (s, me, e)) -> - let prefixText = "module" in - let bindingName = atom ~loc:s.loc (moduleIdent s) in - let moduleExpr = me in - let letModuleLayout = - (self#let_module_binding prefixText bindingName moduleExpr) in - let letModuleLoc = { - loc_start = s.loc.loc_start; - loc_end = me.pmod_loc.loc_end; - loc_ghost = false - } in - (* Just like the bindings, have to synthesize a location since the - * Pexp location is parsed (potentially) beginning with the open - * brace {} in the let sequence. *) - let layout = source_map ~loc:letModuleLoc letModuleLayout in - let (_, return) = self#curriedFunctorPatternsAndReturnStruct moduleExpr in - let loc = { - letModuleLoc with - loc_end = return.pmod_loc.loc_end - } in - processLetList ((loc, layout)::acc) e + let loc, layout = letModuleBinding s me in + processLetList ((loc, layout)::acc) e | ([], Pexp_letexception (extensionConstructor, expr)) -> let exc = self#exception_declaration extensionConstructor in let layout = source_map ~loc:extensionConstructor.pext_loc exc in @@ -5623,6 +5627,9 @@ let printer = object(self:'self) let bindingsLoc = self#bindingsLocationRange ~extension:expr l in let layout = source_map ~loc:bindingsLoc bindingsLayout in processLetList ((extractLocationFromValBindList expr l, layout)::acc) e + | Some (extension, {pexp_attributes = []; pexp_desc = Pexp_letmodule (s, me, e)}) -> + let loc, layout = letModuleBinding ~extension s me in + processLetList ((loc, layout)::acc) e | Some (extension, e) -> let layout = self#attach_std_item_attrs ~extension [] (self#unparseExpr e) in (expr.pexp_loc, layout)::acc @@ -6458,7 +6465,7 @@ let printer = object(self:'self) | None -> Some (self#extension e) | Some (_, x') -> match x'.pexp_desc with - | Pexp_let _ -> + | Pexp_let _ | Pexp_letmodule _ -> Some (makeLetSequence (self#letList x)) | _ -> Some (self#extension e) end @@ -7204,6 +7211,8 @@ let printer = object(self:'self) `let%private a = 1` *) | Psig_value ({ pval_prim = [_]; _ } as vd) -> self#primitive_declaration ~extension vd | Psig_value vd -> self#val_binding ~extension vd + | Psig_module pmd -> self#psig_module ~extension pmd + | Psig_recmodule pmd -> self#psig_recmodule ~extension pmd | _ -> self#payload "%%" extension (PSig [item]) end | _ -> self#signature_item' item @@ -7225,6 +7234,75 @@ let printer = object(self:'self) ~layout () + method psig_module ?extension pmd = + let layout = + let prefix = add_extension_sugar "module" extension in + match pmd.pmd_type.pmty_desc with + | Pmty_alias alias -> + label ~space:true + (makeList ~postSpace:true [ + atom prefix; + atom (moduleIdent pmd.pmd_name); + atom "=" + ]) + (self#longident_loc alias) + | _ -> + let letPattern = + makeList + [makeList ~postSpace:true [atom prefix; (atom (moduleIdent pmd.pmd_name))]; + atom ":"] + in + (self#module_type letPattern pmd.pmd_type) + in + let {stdAttrs; docAttrs} = + partitionAttributes ~partDoc:true pmd.pmd_attributes + in + self#attachDocAttrsToLayout + ~stdAttrs + ~docAttrs + ~loc:pmd.pmd_name.loc + ~layout:(self#attach_std_item_attrs stdAttrs @@ layout) + () + + method psig_recmodule ?extension decls = + let items = List.mapi (fun i xx -> + let {stdAttrs; docAttrs} = + partitionAttributes ~partDoc:true xx.pmd_attributes + in + let letPattern = + makeList [ + makeList ~postSpace:true [ + atom (if i == 0 + then + add_extension_sugar "module" extension ^ " rec" + else "and"); + atom (moduleIdent xx.pmd_name) + ]; + atom ":" + ] + in + let layout = + self#attach_std_item_attrs stdAttrs + (self#module_type ~space:true letPattern xx.pmd_type) + in + let layoutWithDocAttrs = + self#attachDocAttrsToLayout + ~stdAttrs + ~docAttrs + ~loc:xx.pmd_name.loc + ~layout + () + in + (extractLocModDecl xx, layoutWithDocAttrs) + ) decls + in + makeNonIndentedBreakingList + (groupAndPrint + ~xf:(fun (_, layout) -> layout) + ~getLoc:(fun (loc, _) -> loc) + ~comments:self#comments + items) + method signature_item' x : Layout.t = let item: Layout.t = match x.psig_desc with @@ -7272,45 +7350,7 @@ let printer = object(self:'self) (class_description ~class_keyword:true x):: (List.map class_description xs) ) - | Psig_module {pmd_name; pmd_type={pmty_desc=Pmty_alias alias}; pmd_attributes} -> - let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true pmd_attributes - in - let layout = - self#attach_std_item_attrs stdAttrs @@ - label ~space:true - (makeList ~postSpace:true [ - atom "module"; - atom (moduleIdent pmd_name); - atom "=" - ]) - (self#longident_loc alias) - in - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:pmd_name.loc - ~layout - () - | Psig_module pmd -> - let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true pmd.pmd_attributes - in - let letPattern = - makeList - [makeList ~postSpace:true [atom "module"; (atom (moduleIdent pmd.pmd_name))]; - atom ":"] - in - let layout = - self#attach_std_item_attrs stdAttrs @@ - (self#module_type letPattern pmd.pmd_type) - in - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:pmd.pmd_name.loc - ~layout - () + | Psig_module pmd -> self#psig_module pmd | Psig_open od -> let {stdAttrs; docAttrs} = partitionAttributes ~partDoc:true od.popen_attributes @@ -7361,42 +7401,7 @@ let printer = object(self:'self) ~layout () | Psig_class_type l -> self#class_type_declaration_list l - | Psig_recmodule decls -> - let items = List.mapi (fun i xx -> - let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true xx.pmd_attributes - in - let letPattern = - makeList [ - makeList ~postSpace:true [ - atom (if i == 0 then "module rec" else "and"); - atom (moduleIdent xx.pmd_name) - ]; - atom ":" - ] - in - let layout = - self#attach_std_item_attrs stdAttrs - (self#module_type ~space:true letPattern xx.pmd_type) - in - let layoutWithDocAttrs = - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:xx.pmd_name.loc - ~layout - () - in - (extractLocModDecl xx, layoutWithDocAttrs) - ) decls - in - makeNonIndentedBreakingList - (groupAndPrint - ~xf:(fun (_, layout) -> layout) - ~getLoc:(fun (loc, _) -> loc) - ~comments:self#comments - items) - + | Psig_recmodule decls -> self#psig_recmodule decls | Psig_attribute a -> self#floating_attribute a | Psig_extension (({loc}, _) as ext, attrs) -> let {stdAttrs; docAttrs} = @@ -7616,6 +7621,39 @@ let printer = object(self:'self) | Pmod_constraint _ | Pmod_structure _ -> self#simple_module_expr x + method recmodule ?extension decls = + let items = List.mapi (fun i xx -> + let {stdAttrs; docAttrs} = + partitionAttributes ~partDoc:true xx.pmb_attributes + in + let layout = + self#attach_std_item_attrs stdAttrs @@ + self#let_module_binding + (if i == 0 + then + add_extension_sugar "module" extension ^ " rec" + else "and") + (atom (moduleIdent xx.pmb_name)) + xx.pmb_expr + in + let layoutWithDocAttrs = + self#attachDocAttrsToLayout + ~stdAttrs + ~docAttrs + ~loc:xx.pmb_name.loc + ~layout + () + in + (extractLocModuleBinding xx, layoutWithDocAttrs) + ) decls + in + makeNonIndentedBreakingList + (groupAndPrint + ~xf:(fun (_, layout) -> layout) + ~getLoc:(fun (loc, _) -> loc) + ~comments:self#comments + items) + method structure ?(indent=Some 0) ?wrap structureItems = (* We don't have any way to know if an extension is placed at the top level by the parsetree while there's a difference syntactically (% for structure_items/expressons and %% for top_level). @@ -7629,6 +7667,13 @@ let printer = object(self:'self) `let%private a = 1` *) | Pstr_value (rf, vb_list) -> self#bindings ~extension (rf, vb_list) | Pstr_primitive vd -> self#primitive_declaration ~extension vd + | Pstr_module binding -> + let bindingName = atom ~loc:binding.pmb_name.loc (moduleIdent binding.pmb_name) in + let module_binding = + let prefix = add_extension_sugar "module" (Some extension) in + self#let_module_binding prefix bindingName binding.pmb_expr in + self#attach_std_item_attrs binding.pmb_attributes module_binding + | Pstr_recmodule decls -> self#recmodule ~extension decls | _ -> self#attach_std_item_attrs attrs (self#payload "%%" extension (PStr [item])) end | _ -> self#structure_item item @@ -7789,35 +7834,7 @@ let printer = object(self:'self) self#moduleExpressionToFormattedApplicationItems ~prefix:"include" moduleExpr - | Pstr_recmodule decls -> (* 3.07 *) - let items = List.mapi (fun i xx -> - let {stdAttrs; docAttrs} = - partitionAttributes ~partDoc:true xx.pmb_attributes - in - let layout = - self#attach_std_item_attrs stdAttrs @@ - self#let_module_binding - (if i == 0 then "module rec" else "and") - (atom (moduleIdent xx.pmb_name)) - xx.pmb_expr - in - let layoutWithDocAttrs = - self#attachDocAttrsToLayout - ~stdAttrs - ~docAttrs - ~loc:xx.pmb_name.loc - ~layout - () - in - (extractLocModuleBinding xx, layoutWithDocAttrs) - ) decls - in - makeNonIndentedBreakingList - (groupAndPrint - ~xf:(fun (_, layout) -> layout) - ~getLoc:(fun (loc, _) -> loc) - ~comments:self#comments - items) + | Pstr_recmodule decls -> self#recmodule decls | Pstr_attribute a -> self#floating_attribute a | Pstr_extension ((_extension, PStr []) as extension, attrs) -> (* Extension with attributes and without PStr gets printed inline *) diff --git a/test/general-syntax-rei.t/input.rei b/test/general-syntax-rei.t/input.rei index c8eab395f..2b535b6f4 100644 --- a/test/general-syntax-rei.t/input.rei +++ b/test/general-syntax-rei.t/input.rei @@ -46,3 +46,9 @@ external%foo bar: string => string = ""; [%%foo: let foo: bar]; let%foo foo: bar; +module%foo X: Y; + +module%foo X = Y; + +module%foo rec X: Y; + diff --git a/test/general-syntax-rei.t/run.t b/test/general-syntax-rei.t/run.t index e25ccfbaf..65b1aae1f 100644 --- a/test/general-syntax-rei.t/run.t +++ b/test/general-syntax-rei.t/run.t @@ -54,3 +54,9 @@ Format general interface syntax let%foo foo: bar; let%foo foo: bar; + + module%foo X: Y; + + module%foo X = Y; + + module%foo rec X: Y; diff --git a/test/modules.t/input.re b/test/modules.t/input.re index 2e953779f..9846a7660 100644 --- a/test/modules.t/input.re +++ b/test/modules.t/input.re @@ -523,3 +523,20 @@ module type TypeWithExternalExtension = { external%foo bar: string => string = ""; [%%foo: external bar: int => int = "hello" ]; } + +module%foo X = Y + +module%foo X = { + let x = 1; +}; + +let x = { + let module%foo X = { + let x = 1; + }; + () +}; + +module%foo rec X: Y = { + let x = 1; +} diff --git a/test/modules.t/run.t b/test/modules.t/run.t index 9311b0434..dc3fe3913 100644 --- a/test/modules.t/run.t +++ b/test/modules.t/run.t @@ -689,4 +689,21 @@ Format modules external%foo bar: string => string; external%foo bar: int => int = "hello"; }; + + module%foo X = Y; + + module%foo X = { + let x = 1; + }; + + let x = { + module%foo X = { + let x = 1; + }; + (); + }; + + module%foo rec X: Y = { + let x = 1; + }; /* From http://stackoverflow.com/questions/1986374/ higher-order-type-constructors-and-functors-in-ocaml */ From 1b38ed43c902805656b01c71495243839724e410 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 21:57:31 -0700 Subject: [PATCH 59/64] feat: open any module expr (#2773) * feat: open any module expr * changelog, fix printing of pstr_open * fix --- CHANGES.md | 5 +++++ src/reason-parser/reason_parser.mly | 5 ++--- src/reason-parser/reason_pprint_ast.ml | 16 ++++++++-------- test/modules.t/input.re | 20 ++++++++++++++++++++ test/modules.t/run.t | 20 ++++++++++++++++++++ 5 files changed, 55 insertions(+), 11 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index f2dfd5704..6c4fd416c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +## Unreleased + +- Extend open to arbitrary module expression (@anmonteiro, + [#2773](https://github.com/reasonml/reason/pull/2773)) + ## 3.12.0 - Add `\u{hex-escape}` syntax (@anmonteiro, diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index e9d04d25f..8603b45fa 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -2566,10 +2566,9 @@ seq_expr_no_seq [@recover.expr default_expr ()] (semi): | Some (ext_attrs, ext_id) -> mkexp ~loc (Pexp_extension (ext_id, PStr [mkstrexp exp ext_attrs])) } -| item_attributes LET? OPEN override_flag as_loc(mod_longident) SEMI seq_expr(SEMI?) +| item_attributes LET? OPEN override_flag module_expr SEMI seq_expr(SEMI?) { let loc = (mklocation $startpos($1) $endpos($4)) in - let me = Ast_helper.Mod.ident ~loc $5 in - let od = Ast_helper.Opn.mk ~override:$4 ~loc me in + let od = Ast_helper.Opn.mk ~override:$4 ~loc $5 in let exp = mkexp (Pexp_open(od, $7)) in { exp with pexp_attributes = $1 } } diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 31144c30b..35bc91f45 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -162,7 +162,7 @@ let expression_immediate_extension_sugar x = | Some (name, expr) -> match expr.pexp_desc with | Pexp_for _ | Pexp_while _ | Pexp_ifthenelse _ | Pexp_function _ - | Pexp_newtype _ | Pexp_try _ | Pexp_match _ (* | Pexp_letmodule _ *) -> + | Pexp_newtype _ | Pexp_try _ | Pexp_match _ -> (Some name, expr) | _ -> (None, x) @@ -6236,8 +6236,9 @@ let printer = object(self:'self) | ([], Pexp_letop _) -> false | ([], Pexp_sequence _) -> false | ([], Pexp_letmodule _) -> false - | ([], Pexp_open (me, e)) -> - me.popen_override == Fresh && self#isSeriesOfOpensFollowedByNonSequencyExpression e + | ([], Pexp_open ({ popen_override; popen_expr = { pmod_desc = Pmod_ident _; _ }; _ }, e)) -> + popen_override == Fresh && self#isSeriesOfOpensFollowedByNonSequencyExpression e + | ([], Pexp_open _) -> false | ([], Pexp_letexception _) -> false | ([], Pexp_extension ({txt}, _)) -> txt = "mel.obj" | _ -> true @@ -6478,7 +6479,7 @@ let printer = object(self:'self) (atom ("."))) (self#formatNonSequencyExpression ~parent:x e)) else - Some (makeLetSequence (self#letList e)) + Some (makeLetSequence (self#letList x)) | Pexp_send (e, s) -> let needparens = match e.pexp_desc with | Pexp_apply (ee, _) -> @@ -7812,10 +7813,9 @@ let printer = object(self:'self) self#attach_std_item_attrs binding.pmb_attributes module_binding | Pstr_open od -> self#attach_std_item_attrs od.popen_attributes @@ - makeList ~postSpace:true [ - atom ("open" ^ (override od.popen_override)); - self#moduleExpressionToFormattedApplicationItems od.popen_expr; - ] + label ~space:true + (atom ("open" ^ (override od.popen_override))) + (self#moduleExpressionToFormattedApplicationItems od.popen_expr) | Pstr_modtype x -> let name = atom x.pmtd_name.txt in let letPattern = makeList ~postSpace:true [atom "module type"; name; atom "="] in diff --git a/test/modules.t/input.re b/test/modules.t/input.re index 9846a7660..3e7e4314b 100644 --- a/test/modules.t/input.re +++ b/test/modules.t/input.re @@ -540,3 +540,23 @@ let x = { module%foo rec X: Y = { let x = 1; } + +let f = () => { + open { + let x = 1; + }; + (); +}; + +let f = () => { + let open { + let x = 1; + }; + (); +}; + +open { + let x = 1; +}; + + diff --git a/test/modules.t/run.t b/test/modules.t/run.t index dc3fe3913..7c2d5cc62 100644 --- a/test/modules.t/run.t +++ b/test/modules.t/run.t @@ -706,4 +706,24 @@ Format modules module%foo rec X: Y = { let x = 1; }; + + let f = () => { + open { + let x = 1; + }; + + (); + }; + + let f = () => { + open { + let x = 1; + }; + + (); + }; + + open { + let x = 1; + }; /* From http://stackoverflow.com/questions/1986374/ higher-order-type-constructors-and-functors-in-ocaml */ From 451219757c48417d58e58f439ed078c15564e017 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 21:57:43 -0700 Subject: [PATCH 60/64] chore: changelog for #2771 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 6c4fd416c..e5025b4b5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,7 @@ ## Unreleased +- Support `module%ppx` syntax (@anmonteiro, + [#2771](https://github.com/reasonml/reason/pull/2771)) - Extend open to arbitrary module expression (@anmonteiro, [#2773](https://github.com/reasonml/reason/pull/2773)) From ce4064d3a194f7b918fcd42c0c4b9bdfa5ed5b5b Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 23:33:59 -0700 Subject: [PATCH 61/64] fix: wrap parens around lazy patterns (#2774) * fix: wrap parens around lazy patterns * changelog entry --- CHANGES.md | 2 ++ src/reason-parser/reason_pprint_ast.ml | 5 +++-- test/basicStructures.t/run.t | 20 ++++++++++---------- test/lazy.t/run.t | 8 +++++--- 4 files changed, 20 insertions(+), 15 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e5025b4b5..cb790c597 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,8 @@ [#2771](https://github.com/reasonml/reason/pull/2771)) - Extend open to arbitrary module expression (@anmonteiro, [#2773](https://github.com/reasonml/reason/pull/2773)) +- Wrap `let lazy patterns = ..` in parentheses (`let lazy(patterns) = ..`) + (@anmonteiro, [#2774](https://github.com/reasonml/reason/pull/2774)) ## 3.12.0 diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 35bc91f45..dfd4ace1b 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3245,7 +3245,7 @@ let printer = object(self:'self) source_map ~loc:x.ppat_loc (self#constructor_pattern (atom ("`" ^ l)) p ~polyVariant:true ~arityIsClear:true) - | Ppat_lazy p -> label ~space:true (atom "lazy") (self#simple_pattern p) + | Ppat_lazy p -> label (atom "lazy") (formatPrecedence (self#simple_pattern p)) | Ppat_construct (({txt} as li), po) when not (txt = Lident "::")-> (* FIXME The third field always false *) let formattedConstruction = match po with (* TODO: Check the explicit_arity field on the pattern/constructor @@ -3434,7 +3434,8 @@ let printer = object(self:'self) | Ppat_variant (l, None) -> makeList[atom "`"; atom l] | Ppat_constraint _ -> formatPrecedence (self#pattern x) - | Ppat_lazy p ->formatPrecedence (label ~space:true (atom "lazy") (self#simple_pattern p)) + | Ppat_lazy p -> + formatPrecedence (label (atom "lazy") (formatPrecedence (self#simple_pattern p))) | Ppat_extension e -> self#extension e | Ppat_exception p -> (* diff --git a/test/basicStructures.t/run.t b/test/basicStructures.t/run.t index cf6d3175e..4a68d2f2b 100644 --- a/test/basicStructures.t/run.t +++ b/test/basicStructures.t/run.t @@ -118,16 +118,16 @@ Format basicStructures let x = Some(-5.0); - let lazy x = 10; - let lazy (x: int) = 10; - let lazy [] = 10; - let lazy true = 10; - let lazy #x = 10; - let lazy `Variant = 10; - let lazy `variant = 10; - let lazy '0' .. '9' = 10; - let lazy (lazy true) = 10; - let lazy [%extend] = 10; + let lazy(x) = 10; + let lazy((x: int)) = 10; + let lazy([]) = 10; + let lazy(true) = 10; + let lazy(#x) = 10; + let lazy(`Variant) = 10; + let lazy(`variant) = 10; + let lazy('0' .. '9') = 10; + let lazy((lazy(true))) = 10; + let lazy([%extend]) = 10; /* Test precedence on access sugar */ let x = arr^[0]; diff --git a/test/lazy.t/run.t b/test/lazy.t/run.t index 6d0d06492..7900ec976 100644 --- a/test/lazy.t/run.t +++ b/test/lazy.t/run.t @@ -12,7 +12,8 @@ Print the formatted file type myRecord = {myRecordField: int}; - let operateOnLazyValue = (lazy {myRecordField}) => { + let operateOnLazyValue = + (lazy({myRecordField})) => { let tmp = myRecordField; tmp + tmp; }; @@ -25,9 +26,10 @@ Print the formatted file type box('a) = | Box('a); - let lazy thisIsActuallyAPatternMatch = lazy(200); + let lazy(thisIsActuallyAPatternMatch) = + lazy(200); let tmp: int = thisIsActuallyAPatternMatch; - let (lazy (Box(i)), x) = ( + let (lazy((Box(i))), x) = ( lazy(Box(200)), 100, ); From e1d0b71d120a2c02779847454ba15555724f1c50 Mon Sep 17 00:00:00 2001 From: Antonio Nuno Monteiro Date: Sat, 27 Jul 2024 23:48:49 -0700 Subject: [PATCH 62/64] fix: add location to pexp_extension (#2775) --- src/reason-parser/reason_parser.mly | 31 +++++++++++++++++++---------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/src/reason-parser/reason_parser.mly b/src/reason-parser/reason_parser.mly index 8603b45fa..104a0a701 100644 --- a/src/reason-parser/reason_parser.mly +++ b/src/reason-parser/reason_parser.mly @@ -426,7 +426,9 @@ let makeFrag loc (body: Ppxlib.Parsetree.expression) = (* Applies attributes to the structure item, not the expression itself. Makes * structure item have same location as expression. *) -let mkstrexp e attrs = +let mkstrexp ?loc e attrs = + let loc = match loc with None -> e.Ppxlib.pexp_loc | Some loc -> loc in + let e = { e with pexp_loc = loc } in { Ppxlib.Parsetree.pstr_desc = Pstr_eval (e, attrs); pstr_loc = e.pexp_loc } let ghexp_constraint loc e (t1, t2) = @@ -793,11 +795,11 @@ let wrap_sig_ext ~loc body ext = Ppxlib.Parsetree.Psig_extension ((ext_id, PSig [mksig ~loc body]), ext_attrs) let expression_extension ?loc (ext_attrs, ext_id) item_expr = - let extension = (ext_id, Ppxlib.Parsetree.PStr [mkstrexp item_expr []]) in let loc = match loc with | Some loc -> loc | None -> make_ghost_loc (dummy_loc ()) in + let extension = (ext_id, Ppxlib.Parsetree.PStr [mkstrexp ~loc item_expr []]) in Ast_helper.Exp.extension ~loc ~attrs:ext_attrs extension (* There's no more need for these functions - this was for the following: @@ -2888,8 +2890,8 @@ jsx_without_leading_less: ; optional_expr_extension: - | (* empty *) { fun exp -> exp } - | item_extension_sugar { fun exp -> expression_extension $1 exp } + | (* empty *) { fun ~loc:_ exp -> exp } + | item_extension_sugar { fun ~loc exp -> expression_extension ~loc $1 exp } ; (* @@ -2907,7 +2909,8 @@ mark_position_exp ( simple_expr { $1 } | FUN optional_expr_extension fun_def(EQUALGREATER,non_arrowed_core_type) - { $2 $3 } + { let loc = mklocation $startpos $endpos in + $2 ~loc $3 } | ES6_FUN es6_parameters EQUALGREATER expr { let (ps, uncurried) = $2 in let exp = List.fold_right mkexp_fun ps $4 in @@ -2930,21 +2933,27 @@ mark_position_exp such as below_BAR in order to let the entire list "build up" *) | FUN optional_expr_extension match_cases(expr) %prec below_BAR - { $2 (mkexp (Pexp_function $3)) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_function $3)) } | SWITCH optional_expr_extension simple_expr_no_constructor LBRACE match_cases(seq_expr(SEMI?)) RBRACE - { $2 (mkexp (Pexp_match ($3, $5))) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_match ($3, $5))) } | TRY optional_expr_extension simple_expr_no_constructor LBRACE match_cases(seq_expr(SEMI?)) RBRACE - { $2 (mkexp (Pexp_try ($3, $5))) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_try ($3, $5))) } | IF optional_expr_extension parenthesized_expr simple_expr ioption(preceded(ELSE,expr)) - { $2 (mkexp (Pexp_ifthenelse($3, $4, $5))) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_ifthenelse($3, $4, $5))) } | WHILE optional_expr_extension parenthesized_expr simple_expr - { $2 (mkexp (Pexp_while($3, $4))) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_while($3, $4))) } | FOR optional_expr_extension LPAREN pattern IN expr direction_flag expr RPAREN simple_expr - { $2 (mkexp (Pexp_for($4, $6, $8, $7, $10))) } + { let loc = mklocation $startpos $endpos in + $2 ~loc (mkexp (Pexp_for($4, $6, $8, $7, $10))) } | LPAREN COLONCOLON RPAREN LPAREN expr COMMA expr RPAREN { let loc_colon = mklocation $startpos($2) $endpos($2) in let loc = mklocation $symbolstartpos $endpos in From d3fd746e2e370b9f616401cca6cb918a741204e4 Mon Sep 17 00:00:00 2001 From: Sander Date: Sun, 28 Jul 2024 23:43:18 +0200 Subject: [PATCH 63/64] Polyvariants printing similar to variants (#2708) * printing: break poly variant type * add history entry * revert a bad change * fix 4.10 test * fix 4.12 test * avoid a List.length --------- Co-authored-by: Antonio Nuno Monteiro --- CHANGES.md | 1 + src/reason-parser/reason_pprint_ast.ml | 6 +++++- test/4.10/type-jsx.t/run.t | 9 ++++++--- test/4.12/type-jsx.t/run.t | 9 ++++++--- test/ocaml_identifiers.t/run.t | 5 ++++- 5 files changed, 22 insertions(+), 8 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index cb790c597..d9600e030 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,7 @@ [#2773](https://github.com/reasonml/reason/pull/2773)) - Wrap `let lazy patterns = ..` in parentheses (`let lazy(patterns) = ..`) (@anmonteiro, [#2774](https://github.com/reasonml/reason/pull/2774)) +- Print poly variants as normal variansts (@Sander Spies) [#2708](https://github.com/reasonml/reason/pull/2708) ## 3.12.0 diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index dfd4ace1b..46bb3e09d 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -3118,7 +3118,11 @@ let printer = object(self:'self) let ll = (List.map (fun t -> atom ("`" ^ t)) tl) in let tag_list = makeList ~postSpace:true ~break:IfNeed ((atom ">")::ll) in let type_list = if tl != [] then node_list@[tag_list] else node_list in - makeList ~wrap:("[" ^ designator,"]") ~pad:(true, false) ~postSpace:true ~break:IfNeed type_list + let break = match type_list with + | _ :: _ :: _ -> Layout.Always_rec + | [] | _ :: [] -> IfNeed + in + makeList ~wrap:("[" ^ designator,"]") ~pad:(true, false) ~postSpace:true ~break type_list | Ptyp_class (li, []) -> makeList [atom "#"; self#longident_loc li] | Ptyp_class (li, l) -> label diff --git a/test/4.10/type-jsx.t/run.t b/test/4.10/type-jsx.t/run.t index 51295c781..83612eaab 100644 --- a/test/4.10/type-jsx.t/run.t +++ b/test/4.10/type-jsx.t/run.t @@ -368,7 +368,10 @@ Print the formatted file /** * Test no conflict with polymorphic variant types. */ - type thisType = [ | `Foo | `Bar]; + type thisType = [ + | `Foo + | `Bar + ]; type t('a) = [< thisType] as 'a; let asd = @@ -590,8 +593,8 @@ Print the formatted file Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re - File "formatted.re", line 460, characters 23-26: - 460 | ; + File "formatted.re", line 463, characters 23-26: + 463 | ; ^^^ Warning 43: the label required is not optional. diff --git a/test/4.12/type-jsx.t/run.t b/test/4.12/type-jsx.t/run.t index 1b9fe642a..56ae73af7 100644 --- a/test/4.12/type-jsx.t/run.t +++ b/test/4.12/type-jsx.t/run.t @@ -368,7 +368,10 @@ Print the formatted file /** * Test no conflict with polymorphic variant types. */ - type thisType = [ | `Foo | `Bar]; + type thisType = [ + | `Foo + | `Bar + ]; type t('a) = [< thisType] as 'a; let asd = @@ -590,8 +593,8 @@ Print the formatted file Type-check basics $ ocamlc -c -pp 'refmt --print binary' -intf-suffix .rei -impl formatted.re - File "formatted.re", line 460, characters 23-26: - 460 | ; + File "formatted.re", line 463, characters 23-26: + 463 | ; ^^^ Warning 43 [nonoptional-label]: the label required is not optional. diff --git a/test/ocaml_identifiers.t/run.t b/test/ocaml_identifiers.t/run.t index 1f52cfca3..069cae894 100644 --- a/test/ocaml_identifiers.t/run.t +++ b/test/ocaml_identifiers.t/run.t @@ -80,7 +80,10 @@ Format OCaml identifiers file /* Polymorphic variants (probably ok as-is?) */ module P = { - type t = [ | `pub_ | `method]; + type t = [ + | `pub_ + | `method + ]; let x = `method; From 461f7518a413ff583ffb0ebd74f09daa38824578 Mon Sep 17 00:00:00 2001 From: Sander Date: Mon, 29 Jul 2024 00:04:24 +0200 Subject: [PATCH 64/64] Improve printing of anonymous function return type. (#2686) * Improve printing of anonymous function return type. * Remove not needed changes. * Add history.md entry * promote test * add another test case --------- Co-authored-by: Antonio Nuno Monteiro --- CHANGES.md | 1 + src/reason-parser/reason_pprint_ast.ml | 5 +++++ test/pexpFun.t/input.re | 11 +++++++++++ test/pexpFun.t/run.t | 11 +++++++++++ 4 files changed, 28 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index d9600e030..b010a964b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ - Wrap `let lazy patterns = ..` in parentheses (`let lazy(patterns) = ..`) (@anmonteiro, [#2774](https://github.com/reasonml/reason/pull/2774)) - Print poly variants as normal variansts (@Sander Spies) [#2708](https://github.com/reasonml/reason/pull/2708) +- Improve printing of anonymous function return type ## 3.12.0 diff --git a/src/reason-parser/reason_pprint_ast.ml b/src/reason-parser/reason_pprint_ast.ml index 46bb3e09d..c29943036 100644 --- a/src/reason-parser/reason_pprint_ast.ml +++ b/src/reason-parser/reason_pprint_ast.ml @@ -8147,6 +8147,11 @@ let printer = object(self:'self) makeList ~break:IfNeed ~inline:(true, true) ~postSpace:true (List.map self#attribute cbAttrs @ cbArgs) else makeList cbArgs in + let (retCb, cbArgs) = (match retCb.pexp_desc with + | Pexp_constraint (a, t) -> (a, makeList [cbArgs; atom ": "; self#core_type t]) + | _ -> (retCb, cbArgs) + ) + in let theCallbackArg = match argLbl with | Optional s -> makeList ([atom namedArgSym; atom s; atom "=?"]@[cbArgs]) | Labelled s -> makeList ([atom namedArgSym; atom s; atom "="]@[cbArgs]) diff --git a/test/pexpFun.t/input.re b/test/pexpFun.t/input.re index bcd9e6cda..15f2c637d 100644 --- a/test/pexpFun.t/input.re +++ b/test/pexpFun.t/input.re @@ -75,3 +75,14 @@ Mod.Update( ); Mod.Update((acc, curr) => string_of_int(curr), "", lst); + +let foo = () => { + x(() => ("foo": string)); +}; + +x(() => ("foo": string)); + +let x = { + let y = () => ("foo": string); + () +}; diff --git a/test/pexpFun.t/run.t b/test/pexpFun.t/run.t index ce4479c61..df2e22130 100644 --- a/test/pexpFun.t/run.t +++ b/test/pexpFun.t/run.t @@ -89,3 +89,14 @@ Format function expressipns (pexpFun) "", lst, ); + + let foo = () => { + x((): string => "foo"); + }; + + x((): string => "foo"); + + let x = { + let y = (): string => "foo"; + (); + };