This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
14
unikernel/duniverse/ppxlib/.git-blame-ignore-revs
Normal file
14
unikernel/duniverse/ppxlib/.git-blame-ignore-revs
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
# The bulk change commit enabling ocamlformat
|
||||
427f96e126d306538eb541ac591f71b2c68e5dd4
|
||||
|
||||
#The commit upgrading to ocamlformat 0.20.0
|
||||
50c1f3736e58be5cf18ad02debf9653799625bfc
|
||||
|
||||
#The commit upgrading to ocamlformat 0.24.1
|
||||
0970c3a7f91291bd92eb277331b5b6af20b608e9
|
||||
|
||||
#The commit upgrading to ocamlformat.0.26.1
|
||||
dab938d3e6f316c20cc141aaff534a0f5f0ab70f
|
||||
|
||||
#The commit upgrading to ocamlformat 0.27.0
|
||||
234aa6510893e6a9e4eb9badc128c075f8fd1c36
|
||||
1
unikernel/duniverse/ppxlib/.github/CODEOWNERS
vendored
Normal file
1
unikernel/duniverse/ppxlib/.github/CODEOWNERS
vendored
Normal file
|
|
@ -0,0 +1 @@
|
|||
* @ceastlund @NathanReb @panglesd @patricoferris @pitag-ha
|
||||
13
unikernel/duniverse/ppxlib/.github/workflows/changelog.yml
vendored
Normal file
13
unikernel/duniverse/ppxlib/.github/workflows/changelog.yml
vendored
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
name: Changelog check
|
||||
|
||||
on:
|
||||
pull_request:
|
||||
branches: [ main ]
|
||||
types: [ opened, synchronize, reopened, labeled, unlabeled ]
|
||||
|
||||
jobs:
|
||||
Changelog-Entry-Check:
|
||||
name: Check Changelog Action
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: tarides/changelog-check-action@v3
|
||||
19
unikernel/duniverse/ppxlib/.github/workflows/dune-build.yml
vendored
Normal file
19
unikernel/duniverse/ppxlib/.github/workflows/dune-build.yml
vendored
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
name: Build on Dune PM
|
||||
|
||||
on: [push, pull_request]
|
||||
|
||||
jobs:
|
||||
build:
|
||||
strategy:
|
||||
matrix:
|
||||
runs-on: [ ubuntu-latest, macos-latest ]
|
||||
runs-on: ${{ matrix.runs-on }}
|
||||
continue-on-error: true
|
||||
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
- name: Use dune
|
||||
uses: ocaml-dune/setup-dune@v0.0.1
|
||||
with:
|
||||
automagic: true
|
||||
10
unikernel/duniverse/ppxlib/.github/workflows/pr-number.yml
vendored
Normal file
10
unikernel/duniverse/ppxlib/.github/workflows/pr-number.yml
vendored
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
name: PR number update
|
||||
|
||||
on: [pull_request_target]
|
||||
|
||||
jobs:
|
||||
PR-Number-Update:
|
||||
name: Update PR number
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: tarides/pr-number-action@v2
|
||||
53
unikernel/duniverse/ppxlib/.github/workflows/trunk-build.yml
vendored
Normal file
53
unikernel/duniverse/ppxlib/.github/workflows/trunk-build.yml
vendored
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
name: Build on `trunk`
|
||||
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- main
|
||||
pull_request:
|
||||
schedule:
|
||||
# Every weekday, at 5:43 UTC
|
||||
- cron: '43 5 * * 1-5'
|
||||
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- name: Checkout code
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Pick up a robust cache prefix
|
||||
id: setup
|
||||
run: |
|
||||
# Ensure that cache is flushed when trunk is updated
|
||||
cache_prefix="$(git ls-remote https://github.com/ocaml/ocaml.git refs/heads/trunk | cut -f 1)"
|
||||
echo "cache_prefix=$cache_prefix" >> "$GITHUB_OUTPUT"
|
||||
cat "$GITHUB_OUTPUT"
|
||||
|
||||
- name: Install OCaml compiler
|
||||
uses: ocaml/setup-ocaml@v3
|
||||
with:
|
||||
ocaml-compiler: 'ocaml-variants.5.4.0+trunk'
|
||||
dune-cache: true
|
||||
cache-prefix: ${{ steps.setup.outputs.cache_prefix }}
|
||||
|
||||
- name: Install ppxlib dependencies
|
||||
run: |
|
||||
opam install ./ppxlib.opam --deps-only
|
||||
|
||||
- name: Show configuration
|
||||
run: |
|
||||
opam exec -- ocamlc -config
|
||||
opam config list
|
||||
opam exec -- dune printenv
|
||||
opam list
|
||||
|
||||
- name: Build the ppxlib
|
||||
run: opam exec -- dune build -p ppxlib @install
|
||||
|
||||
- name: Install test dependencies
|
||||
run: |
|
||||
opam install ./ppxlib.opam --deps-only -t
|
||||
opam exec -- dune build -p ppxlib @runtest
|
||||
continue-on-error: true
|
||||
4
unikernel/duniverse/ppxlib/.gitignore
vendored
Normal file
4
unikernel/duniverse/ppxlib/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
_build
|
||||
*.install
|
||||
*.merlin
|
||||
_opam
|
||||
3
unikernel/duniverse/ppxlib/.ocamlformat
Normal file
3
unikernel/duniverse/ppxlib/.ocamlformat
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
version=0.27.0
|
||||
profile=conventional
|
||||
parse-docstrings=true
|
||||
62
unikernel/duniverse/ppxlib/.ocamlformat-ignore
Normal file
62
unikernel/duniverse/ppxlib/.ocamlformat-ignore
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
# Files that are preprocessed with pp_rewrite contain invalid syntax
|
||||
# and therefore must be excluded from the ocamlformat parsing
|
||||
astlib/location.ml
|
||||
astlib/longident.ml
|
||||
astlib/longident.mli
|
||||
astlib/astlib.ml
|
||||
astlib/ast_402.ml
|
||||
astlib/ast_403.ml
|
||||
astlib/ast_404.ml
|
||||
astlib/ast_405.ml
|
||||
astlib/ast_406.ml
|
||||
astlib/ast_407.ml
|
||||
astlib/ast_408.ml
|
||||
astlib/ast_409.ml
|
||||
astlib/ast_410.ml
|
||||
astlib/ast_411.ml
|
||||
astlib/ast_412.ml
|
||||
astlib/ast_413.ml
|
||||
astlib/ast_414.ml
|
||||
astlib/ast_501.ml
|
||||
astlib/ast_502.ml
|
||||
astlib/ast_503.ml
|
||||
astlib/ast_504.ml
|
||||
|
||||
# Files that use cinaps to generate code blocks from other code blocks work well,
|
||||
# but files that inject freely formatted code via cinaps must be excluded
|
||||
ast/versions.ml
|
||||
ast/versions.mli
|
||||
ast/import.ml
|
||||
astlib/migrate_414_500.ml
|
||||
astlib/migrate_500_414.ml
|
||||
|
||||
# Currently our expect-test lexer is too strict for our expect tests to
|
||||
# work well with ocamlformat
|
||||
test/ast_builder_value_binding/test.ml
|
||||
test/base/test.ml
|
||||
test/base/test_510.ml
|
||||
test/code_path/test.ml
|
||||
test/code_path/test_510.ml
|
||||
test/deriving/test.ml
|
||||
test/deriving/test_510.ml
|
||||
test/driver/attributes/test.ml
|
||||
test/driver/attributes/test_510.ml
|
||||
test/driver/instrument/test.ml
|
||||
test/driver/non-compressible-suffix/test.ml
|
||||
test/driver/transformations/test.ml
|
||||
test/driver/transformations/test_412.ml
|
||||
test/driver/transformations/test_510.ml
|
||||
test/expand-header-and-footer/test.ml
|
||||
test/expansion_helpers/mangle/test.ml
|
||||
test/expansion_inside_payloads/test.ml
|
||||
test/extensions_and_deriving/test.ml
|
||||
test/extensions_and_deriving/test_510.ml
|
||||
test/location/exception/test.ml
|
||||
test/metaquot/test.ml
|
||||
test/metaquot/test_510.ml
|
||||
test/pprintast/raw_identifiers/test.ml
|
||||
test/ppx_import_support/test.ml
|
||||
test/quoter/test.ml
|
||||
test/traverse/test.ml
|
||||
test/type_is_recursive/test.ml
|
||||
test/502_pexpfun/test.ml
|
||||
1
unikernel/duniverse/ppxlib/.ocp-indent
Normal file
1
unikernel/duniverse/ppxlib/.ocp-indent
Normal file
|
|
@ -0,0 +1 @@
|
|||
JaneStreet
|
||||
621
unikernel/duniverse/ppxlib/CHANGES.md
Normal file
621
unikernel/duniverse/ppxlib/CHANGES.md
Normal file
|
|
@ -0,0 +1,621 @@
|
|||
0.37.0
|
||||
------
|
||||
|
||||
### 5.4 Support
|
||||
|
||||
- Add initial OCaml 5.4 support (#570, @patricoferris, @NathanReb)
|
||||
|
||||
### Other Changes
|
||||
|
||||
- Add `Longident.to/of_compiler` to astlib to simplify maintenance
|
||||
of ppx-es that interacts with other parts of the compiler-libs such
|
||||
as the type checker. (#603, @NathanReb)
|
||||
|
||||
- Fix a bug where some infix operators such as `mod` would be printed as
|
||||
raw identifiers by our `Pprintast`. (#601, @NathanReb)
|
||||
|
||||
- Fix 5.2 -> 5.3 migration of constants. Those used to always have a `none`
|
||||
location which can lead to unhelpful error messages.
|
||||
(#569, @NathanReb)
|
||||
|
||||
- Add a new context-free rule type that replaces AST nodes that have the registered
|
||||
attributes attached to them. (#574, @Skepfyr)
|
||||
|
||||
- Allow users to derive code from module bindings and module declarations
|
||||
(#576, @patricoferris)
|
||||
|
||||
- Expose `Ppxlib.Location.Error.t = Astlib.Location.Error.t` (#593, @ceastlund)
|
||||
|
||||
- Add `@@@ppxlib.inline.end`, deprecate `@@@deriving.end`. (#594, @ceastlund)
|
||||
|
||||
- Clean the AST of any ppxlib migration attributes whenever printing using
|
||||
Pretty_print mode and the use_compiler_pp flag. (#598, @patricoferris)
|
||||
|
||||
- Add custom printer support to `pp_ast` functions via the `?printer` config
|
||||
parameter. (#526, @pedrobslisboa)
|
||||
|
||||
0.36.2
|
||||
------
|
||||
|
||||
- Make Ast_builder's default `value_binding` constructor generate the proper
|
||||
`pvb_constraint` from the pattern and expression arguments.
|
||||
(#589, @NathanReb)
|
||||
- Fix pprintast to output correct syntax from `Ppat_constraint (pat, Ptyp_poly ...)`
|
||||
nodes until they are completely dropped. (#588, @NathanReb)
|
||||
|
||||
0.36.1 (2025-07-10)
|
||||
-------------------
|
||||
|
||||
- Fix ppxlib driver's AST to source printer. Our copy of pprintast was not
|
||||
properly updated which resulted in incorrect printing of value bindings'
|
||||
constraints (#585, @NathanReb)
|
||||
|
||||
0.36.0 (2025-03-03)
|
||||
-------------------
|
||||
|
||||
- Change `Location.none` to match the compiler's `Location.none` as of OCaml
|
||||
4.08. This fixes a bug in `loc_of_attribute` (#540, @ncik-roberts, @patricoferris)
|
||||
|
||||
- Bump ppxlib's AST to 5.2.0 (#514, @patricoferris)
|
||||
|
||||
- Add the `[@@@expand_inline]` transformation and support for floating attribute context
|
||||
free transformations. (#560, @jaymody)
|
||||
|
||||
- Add a `-raise-embedded-errors` flag to the driver. Setting this flag raises the first
|
||||
`ocaml.error` embedded in the final AST.
|
||||
|
||||
- Export `Ast_pattern.fail`. (#563, @ceastlund)
|
||||
|
||||
- Make `Ast_traverse.sexp_of` more concise, and add a test. (#561, @ceastlund)
|
||||
|
||||
0.35.0 (2025-02-03)
|
||||
-------------------
|
||||
|
||||
- Allow use of effect syntax in preprocessed files without causing migration
|
||||
failures. (#552, @hhugo, @NathanReb)
|
||||
|
||||
- Remove support for compilers older than 4.08 (#556, @NathanReb)
|
||||
|
||||
- Add a `--use-compiler-pp` flag to the standalone driver. This flag
|
||||
can be set when the driver outputs source code to make it use the compiler's
|
||||
`Pprintast` instead of ppxlib's.
|
||||
(#555, @NathanReb)
|
||||
|
||||
0.34.0 (2025-01-06)
|
||||
-------------------
|
||||
|
||||
### 5.3 support
|
||||
|
||||
- Add initial OCaml 5.3 support (#487, @NathanReb, @hhugo, @nojb)
|
||||
|
||||
- Initialise OCaml 5.3's lexer with the `keywords` setting from `OCAMLPARAM` or
|
||||
the new `-keywords` driver's CLI option to allow the standalone ppx driver to
|
||||
process old packages using `effect` as an identifier
|
||||
(#535, @dra27, @NathanReb)
|
||||
|
||||
### Other changes
|
||||
|
||||
- Add `Pprintast.binding`, `longident` and `payload` (#542, @mattiasdrp)
|
||||
|
||||
- Fix `deriving_inline` round-trip check so that it works with 5.01 <-> 5.02
|
||||
migrations (#519, @NathanReb)
|
||||
|
||||
- Add ppxlib's AST pretty-printing utilities in `Ppxlib.Pp_ast` and
|
||||
a `ppxlib-pp-ast` executable in a new separate `ppxlib-tools` package
|
||||
(#517, #525, #537, @NathanReb)
|
||||
|
||||
- Change `-dparsetree` from a sexp output to a pretty printed AST, closer
|
||||
to what the compiler's `-dparsetree` is.
|
||||
(#530, @NathanReb)
|
||||
|
||||
- Add Parsetree documentation comments to `Ast_builder` functions (#518, @patricoferris)
|
||||
|
||||
- Support class type declarations in derivers with the new, optional arguments
|
||||
`{str,sig}_class_type_decl` in `Deriving.add` (#538, @patricoferris)
|
||||
|
||||
0.33.0 (2024-07-22)
|
||||
-------------------
|
||||
|
||||
- Fix a bug where `Code_path.main_module_name` would not properly remove
|
||||
extensions from the filename and therefore return an invalid module name.
|
||||
(#512, @NathanReb)
|
||||
|
||||
- Add `-unused-type-warnings` flag to the driver to allow users to disable
|
||||
only the generation of warning 34 silencing structure items when using
|
||||
`[@@deriving ...]` on type declarations. (#511, @mbarbin, @NathanReb)
|
||||
|
||||
- Make `-unused-code-warnings` flag to the driver also controls the generation
|
||||
of warning 34 silencing structure items when using `[@@deriving ...]` on type
|
||||
declarations. (#510, @mbarbin, @NathanReb)
|
||||
|
||||
- Driver: Add `-unused-code-warnings=force` command-line flag argument. (#490, @mbarbin)
|
||||
|
||||
- new functions `Ast_builder.{e,p}list_tail` that take an extra tail
|
||||
expression/pattern argument parameter compared to `Ast_builder.{e,p}list`, so
|
||||
they can build ASTs like `a :: b :: c` instead of only `[ a; b ]`.
|
||||
(#498, #502, @v-gb, @NathanReb)
|
||||
|
||||
- Fix `Longident.parse` so it also handles indexing operators such as
|
||||
`.!()`, `.%(;..)<-`, or `Vec.(.%())` (#494, @octachron)
|
||||
|
||||
- Add a `special_function'` variant which directly takes a `Longident.t`
|
||||
argument to avoid the issue that `Longident.t` cover distinct syntaxic classes
|
||||
which cannot be easily parsed by a common parser (#496, @octachron).
|
||||
|
||||
- Keep location ranges consistent when migrating `Pexp_function` nodes from 5.2+
|
||||
to older versions (#504, @jchavarri)
|
||||
|
||||
- Fix `-locations-check` behaviour so it is no longer required to pass `-check`
|
||||
as well to enable location checks. (#506, @NathanReb)
|
||||
|
||||
|
||||
0.32.1 (2024-04-23)
|
||||
-------------------
|
||||
|
||||
- Add support for OCaml 5.2
|
||||
|
||||
- Insert errors from caught located exceptions in place of the code that
|
||||
should have been generated by context-free rules. (#472, @NathanReb)
|
||||
|
||||
0.32.0 (2024-02-05)
|
||||
-------------------
|
||||
|
||||
- Add an optional `embed_errors` argument to `Context_free.map_top_down` that
|
||||
controls how to deal with exceptions thrown by context-free rules.
|
||||
(#468, @NathanReb)
|
||||
|
||||
- Fix `Longident.parse` so it properly handles unparenthesized dotted operators
|
||||
such as `+.` or `*.`. (#111, @rgrinberg, @NathanReb)
|
||||
|
||||
- raising an exception does no longer cancel the whole context free phase(#453, @burnleydev1)
|
||||
|
||||
- Sort embedded errors that are appended to the AST by location so the compiler
|
||||
reports the one closer to the beginning of the file first. (#463, @NathanReb)
|
||||
|
||||
- Update `Attribute.get` to ignore `loc_ghost`. (#460, @ceastlund)
|
||||
|
||||
- Add API to manipulate attributes that are used as flags (#408, @dianaoigo)
|
||||
|
||||
- Update changelog to use ISO 8061 date format: YYYY-MM-DD. (#445, @ceastlund)
|
||||
|
||||
- Replace `Caml` with `Stdlib`. (#427, @ceastlund)
|
||||
|
||||
- When a transformation raises, the last valid AST is used as input to the upcoming
|
||||
transformations. All such errors are collected and appended as
|
||||
extension nodes to the final AST (#447, @burnleydev1)
|
||||
|
||||
- Fix a small mistake in the man pages: Embededding errors is done by default with
|
||||
`-as-pp`, not with `-dump-ast` (#464, @pitag-ha)
|
||||
|
||||
- Set appropriate binary mode when writing to `stdout` especially for Windows
|
||||
compatibility. (#466, @jonahbeckford)
|
||||
|
||||
0.31.0 (2023-09-21)
|
||||
-------------------
|
||||
|
||||
- Fix support for OCaml 5.1: migrated code preserves generative
|
||||
functor warnings, without creating more. Locations are better
|
||||
preserved. (#432, @pitag-ha, @panglesd)
|
||||
|
||||
- Driver: Add `-unused-code-warnings` command-line flag. (#444, @ceastlund)
|
||||
|
||||
- Add `?warning` flag to `Deriving.Generator.make`. (#440, @jacksonzou123 via @ceastlund)
|
||||
|
||||
- Restore the "path_arg" functionality in the V3 API (#431, @ELLIOTTCABLE)
|
||||
|
||||
- Expose migration/copying/etc. functions for all AST types needed by `Pprintast` (#454, @antalsz)
|
||||
|
||||
- Preserve quoted attributes on antiquotes in metaquot (#441, @ncik-roberts)
|
||||
|
||||
- Attribute namespaces: Fix semantics of reserving multi-component namespaces (#443, @ncik-roberts)
|
||||
|
||||
0.30.0 (2023-06-20)
|
||||
-------------------
|
||||
|
||||
- Adopt the OCaml Code of Conduct on the repo (#426, @pitag-ha)
|
||||
|
||||
- Clean up misleading attribute hints when declared for proper context. (#425, @ceastlund)
|
||||
|
||||
- Ast_pattern now has ebool, pbool helper, and a new map.(#402, @burnleydev1)
|
||||
|
||||
- multiple errors are now reported in `metaquot`. (#397, @burnleydev1)
|
||||
|
||||
- Add `Attribute.declare_with_attr_loc` (#396, @dvulakh)
|
||||
|
||||
- Add "ns" and "res" as reserved namespaces(#388, @davesnx)
|
||||
|
||||
- Make quoter `let` binding non-recursive (#401, @sim642)
|
||||
|
||||
- Fix failure of 'lift_map_with_context' in traverse by compile-time
|
||||
evaluation of 'fst' and 'snd' (#390, @smuenzel)
|
||||
|
||||
- Driver: Bias the mapping from magic to version towards the current version,
|
||||
as it is usually the common case and it helps when magic numbers are
|
||||
ambiguous (such as on development versions) (#409, @shym)
|
||||
|
||||
- Remove unnecessary test dependencies towards base and stdio (#421, @kit-ty-kate)
|
||||
|
||||
- Update description to reflect that `ppxlib` contains more than a library
|
||||
(#422, @pitag-ha)
|
||||
|
||||
- Add support for OCaml 5.1, excluding OCaml `5.1.0~alpha1` (#428, @shym, @Octachron , @pitag-ha, @panglesd)
|
||||
- Driver: Fix `-locations-check` option for coercions with ground (#428, @Octachron)
|
||||
|
||||
0.29.1 (2023-02-14)
|
||||
------------------
|
||||
|
||||
- Allow users to vendor `ppxlib` as-is, as well as `ppx_sexp_conv` in the same project (#386, @kit-ty-kate)
|
||||
|
||||
0.29.0 (2023-02-06)
|
||||
------------------
|
||||
|
||||
- Remove `File_path` exports. (#381, @ceastlund)
|
||||
|
||||
- Add `Ppxlib.Expansion_helpers` with name mangling utilities from ppx_deriving (#370, @sim642)
|
||||
|
||||
0.28.0 (2022-10-05)
|
||||
-------------------
|
||||
|
||||
- Make `esequence` right-associative. (#366, @ceastlund)
|
||||
|
||||
- Deprecate unused attributes in `Deriving.Generator` (#368, @sim642)
|
||||
|
||||
- Remove a pattern match on mutable state in a function argument. (#362, @ceastlund)
|
||||
|
||||
- Add code-path manipulation attributes. (#352, @ceastlund)
|
||||
|
||||
- Update context-free rules to collect expansion errors generated by ppxlib and
|
||||
propagate them to top level without failing. (#358 and #361, @ceastlund)
|
||||
|
||||
- Add driver benchmarks (#376, @gridbugs)
|
||||
|
||||
0.27.0 (2022-06-14)
|
||||
-------------------
|
||||
|
||||
- Update expansion context to leave out value name when multiple are
|
||||
defined at once. (#351, @ceastlund)
|
||||
|
||||
- Add support for OCaml 5.0 (#348, @pitag-ha)
|
||||
|
||||
- Add `Code_path.enclosing_value` (#349, @ceastlund)
|
||||
|
||||
- Add `Code_path.enclosing_module` (#346, @ceastlund)
|
||||
|
||||
- Expand code generated by `~enclose_intf` and `~enclose_impl` (#345, @ceastlund)
|
||||
|
||||
- Add type annotations to code generated by metaquot (#344, @ceastlund)
|
||||
|
||||
- Fix typo in description field of dune-project (#343, @ceastlund)
|
||||
|
||||
- Fix Ast_pattern.many (#333, @nojb)
|
||||
|
||||
- Fix quoter and optimize identifier quoting (#327, @sim642)
|
||||
|
||||
- Driver, when run with `--check`: Allow `toplevel_printer` attributes (#340, @pitag-ha)
|
||||
|
||||
- Documentation: Add a section on reporting errors by embedding extension nodes
|
||||
in the AST (#318, @panglesd)
|
||||
|
||||
- Driver: In the case of ppxlib internal errors, embed those errors instead of
|
||||
raising to return a meaningful AST (#329, @panglesd)
|
||||
|
||||
- API: For each function that could raise a located error, add a function that
|
||||
return a `result` instead (#329, @panglesd)
|
||||
|
||||
0.26.0 (2022-03-21)
|
||||
-------------------
|
||||
|
||||
- Bump ppxlib's AST to 4.14/5.00 (#320, @pitag-ha)
|
||||
|
||||
0.25.1 (2022-06-17)
|
||||
-------------------
|
||||
|
||||
- Add support for OCaml 5.0 (#355, @pitag-ha)
|
||||
|
||||
0.25.0 (2022-03-03)
|
||||
-------------------
|
||||
|
||||
- Added `error_extensionf` function to the `Location` module (#316, @panglesd)
|
||||
|
||||
- Ast patterns: add `drop` and `as` patterns (#313 by @Kakadu, review by @pitag-ha)
|
||||
|
||||
- Fixed a bug resulting in disscarded rewriters in the presence of
|
||||
instrumentations, as well as a wrong order of rewriting (#296, @panglesd)
|
||||
|
||||
- Driver: Append the last valid AST to the error in case of located exception
|
||||
when embedding errors (#315, @panglesd)
|
||||
|
||||
0.24.0 (2021-12-08)
|
||||
-------------------
|
||||
|
||||
- Add support for OCaml 4.14 (#304, @kit-ty-kate)
|
||||
|
||||
- Expand nodes before applying derivers or other inline attributes based
|
||||
transformation, allowing better interactions between extensions and
|
||||
derivers (#279, #297, @NathanReb)
|
||||
|
||||
- Add support for registering ppx_import as a pseudo context-free rule (#271, @NathanReb)
|
||||
|
||||
- Add `input_name` to the `Expansion_context.Extension` and `Expansion_context.Deriver` modules (#284, @tatchi)
|
||||
|
||||
- Improve `gen_symbol` to strip previous unique suffix before adding a new one (#285, @ceastlund)
|
||||
|
||||
- Improve `name_type_params_in_td` to use prefixes `a`, `b`, ... instead of `v_x`. (#285, @ceastlund)
|
||||
|
||||
- Fix a bug in `type_is_recursive` and `really_recursive` where they would
|
||||
consider a type declaration recursive if the type appeared inside an attribute
|
||||
payload (#299, @NathanReb)
|
||||
|
||||
|
||||
0.23.0 (2021-08-31)
|
||||
-------------------
|
||||
|
||||
- Drop `Parser` from the API (#263, @pitag-ha)
|
||||
|
||||
- `Location`: add `set_filename` and `Error.get_location` (#247, @pitag-ha)
|
||||
|
||||
- Drop dependency on OMP2 (#187, @pitag-ha)
|
||||
|
||||
- Make OMP1 a conflict (#255, @kit-ty-kate)
|
||||
|
||||
- Drop `Syntaxerr` from the public API. Doesn't affect any user in the
|
||||
[ppx universe](https://github.com/ocaml-ppx/ppx_universe) (#244, @pitag-ha)
|
||||
|
||||
- Add a lower-bound constraint for Sexplib0 (#240, @pitag-ha)
|
||||
|
||||
- Fix bug due to which unwanted public binaries got installed when installing
|
||||
ppxlib (#223, @pitag-ha)
|
||||
|
||||
- Add `Keyword.is_keyword` to check if a string is an OCaml keyword
|
||||
(#227, @pitag-ha)
|
||||
|
||||
- Remove `Lexer.keyword_table`: use `Keyword.is_keyword` instead
|
||||
(#227, @pitag-ha)
|
||||
|
||||
- Remove `Lexer` from the API: it was the same as the compiler-libs
|
||||
`Lexer` (#228, @pitag-ha)
|
||||
|
||||
- Remove the modules `Ast_magic`, `Compiler_version`, `Js`, `Find_version`,
|
||||
`Convert`, `Extra_warnings`, `Location_error`, `Select_ast` and
|
||||
`Import_for_core` from the API: they are meant for internal use and
|
||||
aren't used by any current downstream user in the
|
||||
[ppx universe](https://github.com/ocaml-ppx/ppx_universe) (#230, @pitag-ha)
|
||||
|
||||
- Remove compiler specific helper functions from `Location`. They aren't used
|
||||
by any current downstream user in the
|
||||
[ppx universe](https://github.com/ocaml-ppx/ppx_universe) (#238, @pitag-ha)
|
||||
|
||||
- Allow "%a" when using Location.Error.createf (#239, @mlasson)
|
||||
|
||||
- Fix in `Location`: make `raise_errorf` exception equivalent to exception
|
||||
`Error` (#242, @pitag-ha)
|
||||
|
||||
- Fix in `Pprintast`: correctly pretty print local type substitutions, e.g.
|
||||
type t := ... (#261, @matthewelse)
|
||||
|
||||
- Add `Ast_pattern.esequence`, for matching on any number of sequenced
|
||||
expressions e.g. `do_a (); do_b (); ...`. (#264, @matthewelse)
|
||||
|
||||
- Expose a part of `Ast_io` in order to allow reading AST values from binary
|
||||
files (#270, @arozovyk)
|
||||
|
||||
0.22.2 (2021-06-23)
|
||||
-------------------
|
||||
|
||||
- Make ppxlib compatible with 4.13 compiler (#260, @kit-ty-kate)
|
||||
|
||||
0.22.1 (2021-06-10)
|
||||
-------------------
|
||||
|
||||
- Fix location in parse error reporting (#257, @pitag-ha)
|
||||
|
||||
0.21.1 (2021-06-09)
|
||||
-------------------
|
||||
|
||||
- Fix location in parse error reporting (#256, @pitag-ha)
|
||||
|
||||
0.22.0 (2021-02-04)
|
||||
-------------------
|
||||
|
||||
- Bump ppxlib's AST to 4.12 (#193, @NathanReb)
|
||||
|
||||
0.21.0 (2021-01-22)
|
||||
-------------------
|
||||
|
||||
- Fix ppxlib.traverse declaration and make it a deriver and not a rewriter
|
||||
(#213, @NathanReb)
|
||||
- Driver (important for bucklescript): handling binary AST's, accept any
|
||||
supported version as input; preserve that version (#205, @pitag-ha)
|
||||
|
||||
- `-as-ppx`: take into account the `-loc-filename` argument (#197, @pitag-ha)
|
||||
|
||||
- Add input name to expansion context (#202, @pitag-ha)
|
||||
|
||||
- Add Driver.V2: give access to expansion context in whole file transformation
|
||||
callbacks of `register_transformation` (#202, @pitag-ha)
|
||||
|
||||
- Driver: take `-cookie` argument into account, also when the input is a
|
||||
binary AST (@pitag-ha, #209)
|
||||
|
||||
- `run_as_ppx_rewriter`: take into account the arguments
|
||||
`-loc-filename`, `apply` and `dont-apply` (#205, @pitag-ha)
|
||||
|
||||
- Location.Error: add functions `raise` and `update_loc`
|
||||
(#205, @pitag-ha)
|
||||
|
||||
0.20.0 (2020-11-16)
|
||||
-------------------
|
||||
|
||||
- Expose `Ppxlib.Driver.map_signature` (#194, @kit-ty-kate)
|
||||
|
||||
0.19.0 (2020-10-23)
|
||||
-------------------
|
||||
|
||||
- Make ppxlib compatible with 4.12 compiler (#191, @kit-ty-kate)
|
||||
|
||||
0.18.0 (2020-10-06)
|
||||
-------------------
|
||||
|
||||
- Bump ppxlib's AST to 4.11 (#180, @NathanReb)
|
||||
|
||||
0.17.0 (2020-09-17)
|
||||
-------------------
|
||||
|
||||
- Add accessors for `code_path` and `tool_name` to `Expansion_context.Base`
|
||||
(#173, @jberdine)
|
||||
- Add `cases` methods to traversal classes in `Ast_traverse` (#183, @pitag-ha)
|
||||
|
||||
0.16.0 (2020-08-18)
|
||||
-------------------
|
||||
|
||||
- `Driver.register_transformation`: add optional parameter `~instrument`
|
||||
(#161, @pitag-ha)
|
||||
- Add missing `Location.init` (#165, @pitag-ha)
|
||||
- Upgrade to ocaml-migrate-parsetree.2.0.0 (#164, @ceastlund)
|
||||
|
||||
0.15.0 (2020-08-04)
|
||||
-------------------
|
||||
|
||||
- Remove `base` and `stdio` dependencies (#151, @ceastlund)
|
||||
|
||||
- Update README and opam description (#155, @jeremiedimino)
|
||||
|
||||
- Fix `Driver.partition_transformation` (#156, @NathanReb)
|
||||
|
||||
- Implement name mangling for `ppxlib_traverse` (#159, @ceastlund)
|
||||
|
||||
0.14.0 (2020-07-08)
|
||||
-------------------
|
||||
|
||||
- Bump ppxlib's AST to 4.10 (#130, @NathanReb)
|
||||
|
||||
- Remove omp_config from `Expansion_context` and replace it with `tool_name`
|
||||
(#149, @NathanReb)
|
||||
|
||||
- Change undocumented `Ppxlib.Driver.map_structure` to return a ppxlib's
|
||||
`structure` instead of a `Migrate_parsetree.Driver.some_structure`.
|
||||
(#153, @NathanReb)
|
||||
|
||||
0.13.0 (2020-04-15)
|
||||
-------------------
|
||||
|
||||
- Add 'metaquot.' prefix to disambiguate metaquote extensions (#121,
|
||||
@ceastlund)
|
||||
|
||||
- Bump dune language to 1.11 since the cinaps extension requires at
|
||||
least Dune 1.11 (#126, @diml)
|
||||
|
||||
0.12.0 (2020-01-07)
|
||||
-------------------
|
||||
|
||||
- Support for OCaml 4.10 (#109, @xclerc)
|
||||
|
||||
0.11.0 (2020-01-07)
|
||||
-------------------
|
||||
|
||||
- Invariant check on locations (#107, @trefis)
|
||||
|
||||
0.10.0 (2019-11-21)
|
||||
-------------------
|
||||
|
||||
- Do not produce a suprious empty correction when deriving_inline
|
||||
expands into an extension that undergoes further expansion (#86,
|
||||
@aalekseyev)
|
||||
|
||||
- Add `Ppxlib.Quoter`. This module allows to generate hygienic code fragments in
|
||||
the spirit of ppx_deriving. (#92, @rgrinberg)
|
||||
|
||||
- Allow for registering derivers on module type declarations. (#94, fix #83,
|
||||
@rgrinberg)
|
||||
|
||||
- Fix parsing long idenitifiers. (#98, @NathanReb)
|
||||
|
||||
0.9.0
|
||||
-----
|
||||
|
||||
- Bump AST to 4.08 (#80, @xclerc)
|
||||
|
||||
0.8.1
|
||||
-----
|
||||
|
||||
### Fixed
|
||||
|
||||
- Report errors according to the value of `OCAML_ERROR_STYLE` and
|
||||
`OCAML_COLOR` in the standalone driver (#83, @NathanReb)
|
||||
|
||||
0.6.0
|
||||
-----
|
||||
|
||||
- Set `Location.input_name` to the original filename when reading a
|
||||
binary AST (#.., @diml)
|
||||
|
||||
0.5.0
|
||||
-----
|
||||
|
||||
- Add an `(** @inline *)` to the include generated when silencing
|
||||
warning 32 (#58, @trefis)
|
||||
|
||||
- Add `Ppxlib.mk_named_sig` and `Ppxlib.is_polymorphic_variant` (#57,
|
||||
@trefis)
|
||||
|
||||
0.4.0
|
||||
-----
|
||||
|
||||
- Do not report errors about dropped or uninterpreted attributes
|
||||
starting with `_` (#46, fix #40, @diml)
|
||||
|
||||
- Fix he `special_function` rule for dotted operators and allow
|
||||
`Longident.parse` to parse dotted operators (#44, @Octachron)
|
||||
|
||||
- Port to `dune` and remove use of bash (#45, @rgrinberg)
|
||||
|
||||
- Ignore all attribites starting with `_` (#46, @diml)
|
||||
|
||||
- Reserve the `reason` and `refmt` namespaces (#46, @diml)
|
||||
|
||||
- Reserve the `metaocaml` namespace (#50, @rgrinberg)
|
||||
|
||||
- Fix attribute extraction for Otag/Rtag (#51, @xclerc)
|
||||
|
||||
- Do not relocate files unless `-loc-filename` is passed (#55, @hhugo)
|
||||
|
||||
- Preserve the filename in the output (#56, @hhugo)
|
||||
|
||||
0.3.1
|
||||
-----
|
||||
|
||||
- Add `Attribute.declare_with_name_loc` (#33, @diml)
|
||||
|
||||
- Let the tool name pass thought when used as a -ppx (#41, @diml)
|
||||
|
||||
- Update the AST to 4.06 (#8, @xclerc)
|
||||
|
||||
0.3.0
|
||||
-----
|
||||
|
||||
- Update the AST to 4.06 (#8, @xclerc)
|
||||
|
||||
- Deprecate old references to type_conv in argument and rewriter names
|
||||
and add new ones mentioning deriving instead (#7, #9 @xclerc)
|
||||
|
||||
- Fix compatibility with `-safe-string` (#10, @hhugo)
|
||||
|
||||
- Restore tests (#11, @xclerc)
|
||||
|
||||
- Allow to set the suffix of corrected files (#15, @diml)
|
||||
|
||||
- Restore compatibility with OCaml 4.04.x (#16, @xclerc)
|
||||
|
||||
0.2.0
|
||||
-----
|
||||
|
||||
- Make sure to import command line arguments registered with
|
||||
ocaml-migrate-parsetree (#5, @diml)
|
||||
|
||||
- Fix an issue where cookies set from the command line sometimes
|
||||
disappeared (#6, @diml)
|
||||
|
||||
0.1.0
|
||||
-----
|
||||
|
||||
Initial release.
|
||||
13
unikernel/duniverse/ppxlib/CODE_OF_CONDUCT.md
Normal file
13
unikernel/duniverse/ppxlib/CODE_OF_CONDUCT.md
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
# Code of Conduct
|
||||
|
||||
This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md).
|
||||
|
||||
# Enforcement
|
||||
|
||||
This project follows the OCaml Code of Conduct
|
||||
[enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement).
|
||||
To report any violations, please contact:
|
||||
|
||||
- Sonja Heinze <sonja@tarides.com>
|
||||
- Paul-Elliot Anglès d'Auriac <peada@free.fr>
|
||||
- Carl Eastlund <ceastlund@janestreet.com>
|
||||
116
unikernel/duniverse/ppxlib/CONTRIBUTING.md
Normal file
116
unikernel/duniverse/ppxlib/CONTRIBUTING.md
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
This repository contains core libraries and tools used to develop ppx
|
||||
rewriters. The code was originally developed and is still maintained
|
||||
and used by [Jane Street][js].
|
||||
|
||||
This repository is not the first piece of open source software
|
||||
released by Jane Street, however it is the first to be entirely
|
||||
developed on GitHub. We are hoping that opening the development of
|
||||
this repository will help collaboration with other open source users.
|
||||
|
||||
We welcome contributions and we will be happy to add contributors,
|
||||
given that they are motivated to help maintain and grow the
|
||||
project. However, given how important this code is to the functioning
|
||||
of Jane Street, we do require that at least one Jane Street developer
|
||||
reads every pull request that modifies the source code.
|
||||
|
||||
Additionally, all contributors must sign-off their commits, see
|
||||
below for details.
|
||||
|
||||
### Developing patches
|
||||
|
||||
#### Setting up your dev environment
|
||||
|
||||
Before starting development on `ppxlib` you should install ppxlib's
|
||||
dependencies. If you're doing it for the first time you can create
|
||||
a local switch with all the right dependencies installed by running:
|
||||
```
|
||||
opam switch create ./ --with-test --with-dev-setup
|
||||
```
|
||||
or if you want to use a pre-existing switch:
|
||||
```
|
||||
opam install ./ppxlib.opam --deps-only --with-test --with-dev-setup
|
||||
```
|
||||
|
||||
Note that the `--with-dev-setup` flag is only available from `opam.2.2.0`.
|
||||
If you are running an older opam and do not wish to update it, you will have
|
||||
to manually install `ocamlformat`.
|
||||
|
||||
#### Submitting patches
|
||||
|
||||
Before submitting a PR, please run `dune build @install @runtest @fmt`
|
||||
on your machine.
|
||||
|
||||
[cinaps][cinaps] is used to keep up-to-date some parts of the code that are
|
||||
auto-generated and committed in the repository.
|
||||
|
||||
### Submitting patches and code review
|
||||
|
||||
Once a patch is ready according to the criteria stated in the
|
||||
previous section, it should be submitted via the GitHub website. When
|
||||
submitting a pull request, we prefer if you tick the `Allow edits from
|
||||
maintainers` box as it is much simpler to fix typos or do simple
|
||||
improvements directly rather than go back and forth through the web
|
||||
interface.
|
||||
|
||||
### Signing commits
|
||||
|
||||
We require that you sign your contributions. Your signature certifies
|
||||
that you wrote the patch or otherwise have the right to pass it on as
|
||||
an open-source patch. The rules are pretty simple: if you can certify
|
||||
the below (from [developercertificate.org][dco]):
|
||||
|
||||
```
|
||||
Developer Certificate of Origin
|
||||
Version 1.1
|
||||
|
||||
Copyright (C) 2004, 2006 The Linux Foundation and its contributors.
|
||||
1 Letterman Drive
|
||||
Suite D4700
|
||||
San Francisco, CA, 94129
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies of this
|
||||
license document, but changing it is not allowed.
|
||||
|
||||
|
||||
Developer's Certificate of Origin 1.1
|
||||
|
||||
By making a contribution to this project, I certify that:
|
||||
|
||||
(a) The contribution was created in whole or in part by me and I
|
||||
have the right to submit it under the open source license
|
||||
indicated in the file; or
|
||||
|
||||
(b) The contribution is based upon previous work that, to the best
|
||||
of my knowledge, is covered under an appropriate open source
|
||||
license and I have the right under that license to submit that
|
||||
work with modifications, whether created in whole or in part
|
||||
by me, under the same open source license (unless I am
|
||||
permitted to submit under a different license), as indicated
|
||||
in the file; or
|
||||
|
||||
(c) The contribution was provided directly to me by some other
|
||||
person who certified (a), (b) or (c) and I have not modified
|
||||
it.
|
||||
|
||||
(d) I understand and agree that this project and the contribution
|
||||
are public and that a record of the contribution (including all
|
||||
personal information I submit with it, including my sign-off) is
|
||||
maintained indefinitely and may be redistributed consistent with
|
||||
this project or the open source license(s) involved.
|
||||
```
|
||||
|
||||
Then you just add a line to every git commit message:
|
||||
|
||||
```
|
||||
Signed-off-by: Joe Smith <joe.smith@email.com>
|
||||
```
|
||||
|
||||
Use your real name (sorry, no pseudonyms or anonymous contributions.)
|
||||
|
||||
If you set your `user.name` and `user.email` git configs, you can sign
|
||||
your commit automatically with git commit -s.
|
||||
|
||||
[js]: https://opensource.janestreet.com/
|
||||
[ocpi]: https://github.com/OCamlPro/ocp-indent
|
||||
[cinaps]: https://github.com/janestreet/cinaps
|
||||
[dco]: http://developercertificate.org/
|
||||
551
unikernel/duniverse/ppxlib/HISTORY.md
Normal file
551
unikernel/duniverse/ppxlib/HISTORY.md
Normal file
|
|
@ -0,0 +1,551 @@
|
|||
# History
|
||||
|
||||
This repository was originally a merge of several ppx-related
|
||||
repositories, namely:
|
||||
|
||||
- [ppx_ast](https://github.com/janestreet/ppx_ast);
|
||||
- [ppx_core](https://github.com/janestreet/ppx_core);
|
||||
- [ppx_driver](https://github.com/janestreet/ppx_driver);
|
||||
- [ppx_metaquot](https://github.com/janestreet/ppx_metaquot);
|
||||
- [ppx_traverse](https://github.com/janestreet/ppx_traverse);
|
||||
- [ppx_traverse_builtins](https://github.com/janestreet/ppx_traverse_builtins);
|
||||
- [ppx_type_conv](https://github.com/janestreet/ppx_type_conv).
|
||||
|
||||
Since this merge, development has been happening only in this
|
||||
repository and the aforementioned ones only contain synonym
|
||||
definitions to provide backward compatibility. The structure of this
|
||||
repository is as follows:
|
||||
|
||||
- `ast/` contains the `ppxlib.ast` library, that replaces `ppx_ast`;
|
||||
- `src/` contains the `ppxlib` library, that replaces `ppx_core`,
|
||||
`ppx_driver`, and `type_conv`;
|
||||
- `metaquot/` contains the `ppxlib.metaquot` library, that replaces
|
||||
`ppx_metaquot`;
|
||||
- `metaquot_lifters/` contains the `ppxlib.metaquot_lifters` library, that
|
||||
replaces `ppx_metaquot.lifters`;
|
||||
- `print-diff/` contains the `ppxlib.print_diff` library, that replaces
|
||||
`ppx_driver.print_diff`;
|
||||
- `runner/` contains the `ppxlib.runner` library, that replaces
|
||||
`ppx_driver.runner`;
|
||||
- `runner_as_ppx/` contains the `ppxlib.runner_as_ppx` library, that replaces
|
||||
`ppx_driver.runner_as_ppx`;
|
||||
- `traverse/` contains the `ppxlib.traverse` library, that replaces
|
||||
`ppx_traverse`;
|
||||
- `traverse_builtins/` contains the `ppxlib.traverse_builtins/` library, that
|
||||
replaces `ppx_traverse_builtins`.
|
||||
|
||||
|
||||
Ast
|
||||
===
|
||||
`Ppxlib_ast` selects a specific version of the OCaml Abstract Syntax Tree
|
||||
from the [ocaml-migrate-parsetree](https://github.com/ocaml-ppx/ocaml-migrate-parsetree)
|
||||
project that is not necessarily the same one as the one being used by the
|
||||
compiler.
|
||||
|
||||
It also snapshots the corresponding parser and pretty-printer from the OCaml
|
||||
compiler, to create a full frontend independent of the version of OCaml.
|
||||
|
||||
This AST is used in all Jane Street ppx rewriters, and more generally in all
|
||||
ppx rewriters based on Ppxlib. Using a different AST allows to "detach"
|
||||
the ppx code from the compiler libraries, and allow to use ppx rewriters with
|
||||
new compilers before upgrading the ppx code.
|
||||
|
||||
|
||||
Ppxlib
|
||||
======
|
||||
Ppxlib is a standard library for OCaml AST transformers, that uses the
|
||||
AST from `Ppxlib_ast`. It features:
|
||||
|
||||
- various auto-generated AST traversal using an open recursion scheme
|
||||
- helpers for building AST fragments
|
||||
- helpers for matching AST fragments
|
||||
- a framework for dealing with attributes and extension points
|
||||
- spellchecking and other hints on misspelled/misplaced attributes and
|
||||
extension points
|
||||
- checks for unused attributes (they are otherwise silently dropped by
|
||||
the compiler)
|
||||
|
||||
Other ASTs
|
||||
----------
|
||||
If you want to write code that works with several versions of
|
||||
`Ppxlib` using different AST versions, you can use the versioned
|
||||
alternatives for `Ast_builder` and `Ast_pattern`. For instance:
|
||||
|
||||
```
|
||||
open Ppxlib
|
||||
module Ast_builder = Ast_builder_403
|
||||
module Ast_pattern = Ast_pattern_403
|
||||
```
|
||||
|
||||
Drivers
|
||||
-------
|
||||
A driver is an executable created from a set of OCaml AST transformers linked
|
||||
together with a command line frontend.
|
||||
|
||||
The aim is to provide a tool that can be used to:
|
||||
|
||||
- easily view the pre-processed version of a file, no need to construct a
|
||||
complex command line: `ppx file.ml` will do;
|
||||
- use a single executable to run several transformations: no need to fork many
|
||||
times just for pre-processing;
|
||||
- improved errors for misspelled/misplaced attributes and extension points.
|
||||
|
||||
### Using driver-based rewriters
|
||||
The recommended way to use rewriters based on `Ppxlib.Driver` is through
|
||||
[dune](https://github.com/ocaml/dune). All you need to is add this line to your
|
||||
`(library ...)` or `(executables ...)` stanza:
|
||||
|
||||
```
|
||||
(preprocess (pps (rewriter1 rewriter2 ... ppxlib.runner)))
|
||||
```
|
||||
|
||||
dune will automatically build a static driver including all these rewriters.
|
||||
Note the `ppxlib.runner` at the end of the list, it will still work if you
|
||||
don't put but some specific features of `ppxlib` won't be available.
|
||||
|
||||
If you are not using dune, you can build a custom driver yourself using
|
||||
ocamlfind.
|
||||
|
||||
These methods are described in the following sections.
|
||||
|
||||
### Creating a new Ppx\_driver based rewriter
|
||||
If using dune, you can just use the following jbuild file:
|
||||
|
||||
```
|
||||
(library
|
||||
((name my_ppx)
|
||||
(public_name my_ppx)
|
||||
(kind ppx_rewriter)
|
||||
(libraries (ppxlib))
|
||||
(ppx_runtime_libraries (<runtime dependencies if any>))
|
||||
(preprocess (pps (ppx_metaquot)))))
|
||||
```
|
||||
|
||||
`(kind ppx_driver)` has two effects:
|
||||
|
||||
1. it links the library with `-linkall`. Since plugins register themselves with
|
||||
the Ppx\_driver library by doing a toplevel side effect, you need to be sure
|
||||
they are linked in the static driver to be taken into accound;
|
||||
2. it instructs dune to produce a special META file that is compatible with the
|
||||
various ways of using ppx rewriters, i.e. for people not using dune.
|
||||
|
||||
### Building a custom driver using ocamlfind
|
||||
To build a custom driver using ocamlfind, simply link all the AST transformers
|
||||
together with the `ppxlib.runner` package at the end:
|
||||
|
||||
ocamlfind ocamlopt -predicates ppx_driver -o ppx -linkpkg \
|
||||
-package ppx_sexp_conv -package ppx_bin_prot \
|
||||
-package ppxlib.runner
|
||||
|
||||
Normally, `ppxlib.driver`-based rewriters should be build with the
|
||||
approriate `-linkall` option on individual libraries. If one is missing this
|
||||
option, the code rewriter might not get linked in. If this is the case, a
|
||||
workaround is to pass `-linkall` when linking the custom driver.
|
||||
|
||||
|
||||
### Building rewriter that you are currently developing
|
||||
Note: if using dune, you do not need to read this as dune already does all the
|
||||
right things for you. This section is written having ocamlbuild in mind.
|
||||
|
||||
When developing a new rewriter you are very likely to prepare a few
|
||||
tests for it. The compilation line above doesn't suit this task very well
|
||||
(because ocamlfind package with your rewriter is not yet installed)
|
||||
and it will be more convenient to specify `.cmx[a]` with your rewriter
|
||||
manually.
|
||||
|
||||
For example, let's suppose that the standalone rewriter (`pp_foo.native`)
|
||||
have this code
|
||||
|
||||
let () = Ppxlib.Driver.standalone ()
|
||||
|
||||
in `pp_foo.ml` and your generator is begin loaded in `ppx_foo.ml`.
|
||||
You need a few extra switches to compile standalone rewriter
|
||||
(N.B. order matters)
|
||||
|
||||
ocamlfind ... dependecy1_of_ppx_foo.cmx ... ppx_foo.cmx -package ppxlib -o pp_foo.native
|
||||
|
||||
or, if you have already created `ppx_foo.cmxa` using `-linkall` option
|
||||
|
||||
ocamlfind ... ppx_foo.cmxa -package ppxlib -o pp_foo.native
|
||||
|
||||
And now you can specify that your test suite uses your rewriter and
|
||||
depends on a few extra `.cma`'s by adding a few lines into your `_tags` file
|
||||
|
||||
<regression/test*.*>: ppx(./pp_foo.native --as-ppx)
|
||||
<regression/test*.*>: depends_on_foo
|
||||
|
||||
and specifying dependencies in your `myocamlbuild.ml` file using
|
||||
|
||||
dep ["compile";"depends_on_foo"] ["ppx_foo.cmxa"; "pp_foo.native"]
|
||||
|
||||
### The driver as a command line tool
|
||||
It recognizes the following command-line switches:
|
||||
|
||||
```
|
||||
-loc-filename <string> File name to use in locations
|
||||
-reserve-namespace <string> Mark the given namespace as reserved
|
||||
-no-check Disable checks (unsafe)
|
||||
-apply <names> Apply these transformations in order (comma-separated list)
|
||||
-dont-apply <names> Exclude these transformations
|
||||
-no-merge Do not merge context free transformations (better for debugging rewriters)
|
||||
-as-ppx Run as a -ppx rewriter (must be the first argument)
|
||||
--as-ppx Same as -as-ppx
|
||||
-as-pp Shorthand for: -dump-ast -embed-errors
|
||||
--as-pp Same as -as-pp
|
||||
-o <filename> Output file (use '-' for stdout)
|
||||
- Read input from stdin
|
||||
-dump-ast Dump the marshaled ast to the output file instead of pretty-printing it
|
||||
--dump-ast Same as -dump-ast
|
||||
-dparsetree Print the parsetree (same as ocamlc -dparsetree)
|
||||
-embed-errors Embed errors in the output AST (default: true when -dump-ast, false otherwise)
|
||||
-null Produce no output, except for errors
|
||||
-impl <file> Treat the input as a .ml file
|
||||
--impl <file> Same as -impl
|
||||
-intf <file> Treat the input as a .mli file
|
||||
--intf <file> Same as -intf
|
||||
-debug-attribute-drop Debug attribute dropping
|
||||
-print-transformations Print linked-in code transformations, in the order they are applied
|
||||
-print-passes Print the actual passes over the whole AST in the order they are applied
|
||||
-ite-check No effect (kept for compatibility)
|
||||
-pp <command> Pipe sources through preprocessor <command> (incompatible with -as-ppx)
|
||||
-reconcile (WIP) Pretty print the output using a mix of the input source and the generated code
|
||||
-reconcile-with-comments (WIP) same as -reconcile but uses comments to enclose the generated code
|
||||
-no-color Don't use colors when printing errors
|
||||
-diff-cmd Diff command when using code expectations
|
||||
-pretty Instruct code generators to improve the prettiness of the generated code
|
||||
-styler Code styler
|
||||
-help Display this list of options
|
||||
--help Display this list of options
|
||||
```
|
||||
|
||||
When passed a file as argument, a ppx driver will pretty-print the code
|
||||
transformed by all its built-in AST transformers. This gives a convenient way
|
||||
of seeing the code generated for a given attribute/extension.
|
||||
|
||||
A driver can simply be used as the argument of the `-pp` option of the OCaml
|
||||
compiler, or as the argument of the `-ppx` option by passing `-as-ppx` as first
|
||||
argument:
|
||||
|
||||
```
|
||||
$ ocamlc -c -pp "ppx -as-pp" file.ml
|
||||
$ ocamlc -c -ppx "ppx -as-ppx" file.ml
|
||||
```
|
||||
|
||||
### Rewriters as findlib libraries
|
||||
Note: if using dune, you do not need to read this as dune already does all the
|
||||
right things for you.
|
||||
|
||||
In normal operation, Ppxlib.Driver rewriters are packaged as findlib
|
||||
libraries. When using dune everything is simple as preprocessors and normal
|
||||
dependencies are separated. However historically, people have been specifying
|
||||
both preprocessors and normal library dependencies together. Even worse, many
|
||||
build system still don't use a static driver and call out to multiple ppx
|
||||
commands to preprocess a single file, which slow downs compilation a lot.
|
||||
|
||||
In order for all these different methods to work properly, you need a peculiar
|
||||
META file. The rules are explained below.
|
||||
|
||||
It is recommended to split the findlib package into two:
|
||||
|
||||
1. one for the main library, which almost assume it is just a normal library;
|
||||
2. another sub-package one for:
|
||||
- allowing to mix preprocessors and normal dependencies;
|
||||
- the method of calling one executable per rewriter.
|
||||
|
||||
In the rest we'll assume we are writing a META file for a `ppx_foo` rewriter,
|
||||
that itself uses the `ppxlib` and `re` libraries, and produces code using
|
||||
`ppx_foo.runtime-lib`.
|
||||
|
||||
We want the META file to support all of these:
|
||||
|
||||
1. mix normal dependencies and preprocessors, using one executable per
|
||||
rewriter:
|
||||
|
||||
```
|
||||
ocamlfind ocamlc -package ppx_foo -c toto.ml
|
||||
```
|
||||
2. mix normal dependencies and preprocessors, using a single ppx driver:
|
||||
|
||||
```
|
||||
$ ocamlfind ocamlc -package ppx_foo -predicates custom_ppx \
|
||||
-ppx ./custom-driver.exe -c toto.ml
|
||||
```
|
||||
3. build a custom driver:
|
||||
|
||||
```
|
||||
$ ocamlfind ocamlc -linkpkg -package ppx_foo -predicates ppx_driver \
|
||||
-o custom-driver.exe
|
||||
```
|
||||
4. build systems properly specifying preprocessors as such, separated from
|
||||
normal dependencies, as dune does
|
||||
|
||||
Since preprocessors and normal dependencies are always specified separately in
|
||||
jbuild files, dune just always set the `ppx_driver` predicates.
|
||||
|
||||
In the end the META file should look like this:
|
||||
|
||||
```
|
||||
# Standard package, expect it assumes that the "ppx_driver" predicate is set
|
||||
version = "42.0"
|
||||
description = "interprets [%foo ...] extensions"
|
||||
requires(ppx_driver) = "ppxlib re"
|
||||
archives(ppx_driver,byte) = "ppx_foo.cma"
|
||||
archives(ppx_driver,native) = "ppx_foo.cmxa"
|
||||
plugin(ppx_driver,byte) = "ppx_foo.cma"
|
||||
plugin(ppx_driver,native) = "ppx_foo.cmxs"
|
||||
|
||||
# This is what dune uses to find out the runtime dependencies of
|
||||
# a preprocessor
|
||||
ppx_runtime_deps = "ppx_foo.runtime-lib"
|
||||
|
||||
# This line makes things transparent for people mixing preprocessors
|
||||
# and normal dependencies
|
||||
requires(-ppx_driver) = "ppx_foo.deprecated-ppx-method"
|
||||
|
||||
package "deprecated-ppx-method" (
|
||||
description = "glue package for the deprecated method of using ppx"
|
||||
requires = "ppx_foo.runtime-lib"
|
||||
ppx(-ppx_driver,-custom_ppx) = "./as-ppx.exe"
|
||||
)
|
||||
|
||||
package "runtime-lib" ( ... )
|
||||
```
|
||||
|
||||
You can check that this META works for all the 4 methods described
|
||||
above.
|
||||
|
||||
Derivers
|
||||
--------
|
||||
The `Ppxlib.Deriving` module factors out functionality needed by
|
||||
different preprocessors that generate code from type specifications. Example
|
||||
libraries currently depending on `Deriving`:
|
||||
|
||||
- `ppx_bin_prot`;
|
||||
- `ppx_compare`;
|
||||
- `ppx_fields_conv`;
|
||||
- `ppx_sexp_conv`;
|
||||
- `ppx_variants_conv`.
|
||||
|
||||
### Derivers compatibility with [`ppx_import`](https://github.com/ocaml-ppx/ppx_import)
|
||||
|
||||
`ppx_import` is a ppx rewriter that let's you import external type definitions. It will turn
|
||||
```ocaml
|
||||
type t = [%import A.t]
|
||||
```
|
||||
into:
|
||||
```ocaml
|
||||
type t = A.t = <actual A.t definition>
|
||||
```
|
||||
It spares you the need to copy the type definition and to update it when `A.t` definition changes.
|
||||
|
||||
`ppx_import` is thus often used in combination with ppx derivers.
|
||||
|
||||
Because `ppx_import` requires extra information from the compiler that aren't available when it is
|
||||
initially called with `ocamldep`, it will not completely expand the type definition and instead
|
||||
rewrite it as:
|
||||
```ocaml
|
||||
type t = A.t
|
||||
```
|
||||
|
||||
That means that if you want your deriver to work with `ppx_import` and to be able to expand the
|
||||
copied type definition, it must not fail during this intermediate stage.
|
||||
If your deriver doesn't natively handle abstract type definitions, you can always return an empty
|
||||
`structure_item` or `signature_item` list.
|
||||
|
||||
Compatibility with [ppx_deriving](https://github.com/ocaml-ppx/ppx_deriving)
|
||||
----------------------------------------------------------------------------
|
||||
`Ppxlib.Deriving`-based code generators are meant to be used with
|
||||
`Ppxlib.Driver`. However `Deriving` allows to export a compatible
|
||||
`ppx_deriving` plugin. By default, when not linked as part of a driver,
|
||||
packages using `Deriving` will just use `ppx_deriving`.
|
||||
|
||||
So for instance this will work as expected using `ppx_deriving`:
|
||||
|
||||
ocamlfind ocamlc -c -package ppx_sexp_conv foo.ml
|
||||
|
||||
For end users, the main advantage of using `Deriving`-based generators is that
|
||||
it will catch typos and attributes misplacement. For instance:
|
||||
|
||||
```
|
||||
# type t = int [@@derivin sexp]
|
||||
Error: Attribute `derivin' was not used
|
||||
Hint: Did you mean deriving?
|
||||
# type t = int [@@deriving sxp]
|
||||
Error: ppxlib_deriving: 'sxp' is not a supported type deriving generator
|
||||
Hint: Did you mean sexp?
|
||||
# type t = int [@deriving sexp]
|
||||
Error: Attribute `deriving' was not used
|
||||
Hint: `deriving' is available for type declarations, type extensions
|
||||
and extension constructors but is used here in the context of a core type.
|
||||
Did you put it at the wrong level?"
|
||||
```
|
||||
|
||||
Deriving Syntax
|
||||
---------------
|
||||
This section is only relevant if you are not using `ppx_deriving`.
|
||||
|
||||
`Deriving` interprets the `[@@deriving ...]` attributes on type declarations,
|
||||
exception declarations and extension constructor declarations:
|
||||
|
||||
```
|
||||
type t = A | B [@@deriving sexp, bin_io]
|
||||
```
|
||||
|
||||
`sexp` and `bin_io` are called generators. They are functions that generate
|
||||
code given the declaration. These functions are implemented by external
|
||||
libraries such as `ppx_sexp_conv` or `ppx_bin_prot`. `Deriving` itself
|
||||
provides no generator, it does only the dispatch.
|
||||
|
||||
Generators can take arguments. This is done using the following syntax:
|
||||
|
||||
```
|
||||
type t = A | B [@@deriving foo ~arg:42]
|
||||
```
|
||||
|
||||
For arguments that are just switches, it is common to use the
|
||||
following syntax:
|
||||
|
||||
```
|
||||
type t = A | B [@@deriving foo ~bar]
|
||||
```
|
||||
|
||||
|
||||
Metaquot (and Metaquot_lifters)
|
||||
===============================
|
||||
`Ppxlib_metaquot` is a ppx rewriter allowing you to write values representing
|
||||
the OCaml AST in the OCaml syntax.
|
||||
|
||||
For instance:
|
||||
|
||||
```
|
||||
[%expr x + 1]
|
||||
```
|
||||
|
||||
is a value of type `Ppxlib_ast.Ast.expression`, representing the OCaml
|
||||
expression `x + 1`.
|
||||
|
||||
`Ppxlib_metaquot` is similar to [ppx_tools.metaquot](https://github.com/ocaml-ppx/ppx_tools),
|
||||
expect that:
|
||||
|
||||
- it uses the version of the OCaml AST defined by Ppxlib_ast rather than the
|
||||
one from the current compiler
|
||||
- it can be used simultaneously with other rewriters using
|
||||
`Ppxlib.Driver`.
|
||||
|
||||
`Ppxlib_metaquot_lifters` provides lifting functions for OCaml predefined
|
||||
types (`int`, `string`, `list`, ...).
|
||||
|
||||
|
||||
Traverse (and Traverse_builtins)
|
||||
================================
|
||||
`Ppxlib_traverse` is a `Deriving` plugin generating open recursion classes
|
||||
from type definition. Users can overwrite a specific method of the generated
|
||||
classes in order to specialize the recursion on specific nodes.
|
||||
`Ppxlib_traverse` is in particular used to generate the open recursion classes
|
||||
to traverse the OCaml AST.
|
||||
|
||||
For instance, this is the kind of code generated (the generated code is
|
||||
between the `[@@deriving_inline ...]` and `[@@@end]`):
|
||||
|
||||
```
|
||||
type expression =
|
||||
| Var of string
|
||||
| Const of int
|
||||
| Add of expression * expression
|
||||
| If of cond * expression * expression
|
||||
|
||||
and cond =
|
||||
| Cond_var of string
|
||||
| Cond_const of bool
|
||||
| Cond_and of cond * cond
|
||||
|
||||
[@@deriving_inline traverse_map]
|
||||
class map = object(self)
|
||||
method virtual int : int -> int
|
||||
method virtual string : string -> string
|
||||
method virtual int : int -> int
|
||||
|
||||
method expression = function
|
||||
| Var x -> Var (self#string x)
|
||||
| Const x -> Const (self#int x)
|
||||
| Add (x, y) -> Add (self#expression x, self#expression y)
|
||||
| If (x, y, z) -> If (self#cond x, self#expression y, self#expression z)
|
||||
|
||||
method cond = function
|
||||
| Cond_var x -> Cond_var (self#string x)
|
||||
| Cond_const x -> Cond_const (self#bool x)
|
||||
| Cond_and (x, y) -> Cond_and (self#cond x, self#cond y)
|
||||
[@@end]
|
||||
```
|
||||
|
||||
Now if you wanted to do a deep-copy of an expression, replacing boolean
|
||||
variable `foo` by `true`:
|
||||
|
||||
```
|
||||
let replace_var = object
|
||||
inherit Ppx_traverse_builtins.map
|
||||
inherit map as super
|
||||
|
||||
method cond = function
|
||||
| Cond_var "foo" -> Cond_const true
|
||||
| c -> super#cond c
|
||||
end
|
||||
|
||||
let replace_var expr = replace_var replace_var#expression expr
|
||||
```
|
||||
|
||||
`Ppx_traverse_builtins.map` contains the definition for all the builtin types,
|
||||
such as `int`, `string`, `list`, ...
|
||||
|
||||
Classes
|
||||
-------
|
||||
|
||||
`Ppx_traverse` can generate the following classes: `map`, `iter`, `fold`,
|
||||
`fold_map`, `map_with_context`, `lift`. `[@@deriving traverse]` is an alias
|
||||
to generate all the supported classes.
|
||||
|
||||
`lift` is a special class that is mostly useful to lift an OCaml constant to
|
||||
the AST that represent this constant. To do so, you can use
|
||||
`Ppx_metaquot_lifters`:
|
||||
|
||||
```
|
||||
type t = { x : int; y : int } [@@deriving traverse_lift]
|
||||
|
||||
let expression_of_t ~loc t : Ast.expression =
|
||||
let lift = object
|
||||
inherit Ppx_metaquot_lifters.expression_lifters loc
|
||||
inherit lift
|
||||
end in
|
||||
lift#t t
|
||||
```
|
||||
|
||||
Context-free rules
|
||||
------------------
|
||||
|
||||
Ppxlib expresses most transformations as context-free rules. Each of these rules
|
||||
describe how specific AST nodes (extensions points, nodes with particular
|
||||
attributes attached, numeric literals with specific suffixes, etc...) must be
|
||||
transformed.
|
||||
|
||||
All those transformation rules are applied in a single AST traversal. They are
|
||||
also recursively applied to code generated by such rules until they don't apply
|
||||
anymore.
|
||||
|
||||
It happens that different rules might apply to the same nodes and an order must
|
||||
be picked. In an effort to document how ppxlib deals with such nodes, I wrote
|
||||
characterization tests, that you can find
|
||||
[here](test/extensions_and_deriving/test.ml). Some of those test behaviour that
|
||||
we believe we should preserve, some act more as documentation of what the
|
||||
current behaviour is.
|
||||
|
||||
The most debatable behaviour is how it handles attributes based rules. ppxlib
|
||||
allows one to generate new code based on a node with specific attributes
|
||||
attached. The most common such rule is the `[@@deriving ...]` one which
|
||||
generates new structure or signature items based on the value of an item
|
||||
with that attribute attached. This rule is applied before the item has been
|
||||
transformed meaning the input of the expander function might contain "wrong"
|
||||
information.
|
||||
*Note that this behaviour was changed in
|
||||
[#279](https://github.com/ocaml-ppx/ppxlib/pull/279) and that nodes are now
|
||||
expanded before derivers and other attributes-based inline code generation rules
|
||||
are applied*
|
||||
21
unikernel/duniverse/ppxlib/LICENSE.md
Normal file
21
unikernel/duniverse/ppxlib/LICENSE.md
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
The MIT License
|
||||
|
||||
Copyright (c) 2018 Jane Street Group, LLC <opensource@janestreet.com>
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
of this software and associated documentation files (the "Software"), to deal
|
||||
in the Software without restriction, including without limitation the rights
|
||||
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
copies of the Software, and to permit persons to whom the Software is
|
||||
furnished to do so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY 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.
|
||||
38
unikernel/duniverse/ppxlib/Makefile
Normal file
38
unikernel/duniverse/ppxlib/Makefile
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),)
|
||||
|
||||
# Default rule
|
||||
default:
|
||||
dune build --auto-promote @install
|
||||
|
||||
install:
|
||||
dune install $(INSTALL_ARGS)
|
||||
|
||||
uninstall:
|
||||
dune uninstall $(INSTALL_ARGS)
|
||||
|
||||
reinstall: uninstall reinstall
|
||||
|
||||
test:
|
||||
dune runtest
|
||||
|
||||
doc:
|
||||
dune build @doc
|
||||
|
||||
clean:
|
||||
dune clean
|
||||
|
||||
all-supported-ocaml-versions:
|
||||
dune build @install --workspace dune-workspace.dev --root .
|
||||
|
||||
opam-release:
|
||||
dune-release distrib --skip-build --skip-lint --skip-tests
|
||||
dune-release publish distrib --verbose
|
||||
dune-release opam pkg
|
||||
dune-release opam submit
|
||||
|
||||
bench:
|
||||
dune build bench --profile release
|
||||
dune exec bench/bench.exe
|
||||
|
||||
.PHONY: default install uninstall reinstall clean test doc bench
|
||||
.PHONY: all-supported-ocaml-versions opam-release
|
||||
46
unikernel/duniverse/ppxlib/README.md
Normal file
46
unikernel/duniverse/ppxlib/README.md
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
# Ppxlib - Meta-programming for OCaml
|
||||
|
||||
[![ocaml-ci status][ocaml-ci-img]][ocaml-ci] [![trunk-build-status][trunk-build-img]][trunk-build] [![AppVeyor status][appveyor-img]][appveyor]
|
||||
|
||||
[ocaml-ci]: https://ci.ocamllabs.io/github/ocaml-ppx/ppxlib
|
||||
[ocaml-ci-img]: https://img.shields.io/endpoint?url=https%3A%2F%2Fci.ocamllabs.io%2Fbadge%2Focaml-ppx%2Fppxlib%2Fmain&logo=ocaml
|
||||
[appveyor]: https://ci.appveyor.com/project/diml/ppxlib/branch/main
|
||||
[appveyor-img]: https://ci.appveyor.com/api/projects/status/bogbsm33uvh083jx?svg=true
|
||||
[trunk-build]: https://github.com/ocaml-ppx/ppxlib/actions/workflows/trunk-build.yml
|
||||
[trunk-build-img]: https://github.com/ocaml-ppx/ppxlib/actions/workflows/trunk-build.yml/badge.svg?branch=main
|
||||
|
||||
[Ppxlib documentation][doc]
|
||||
|
||||
# Overview
|
||||
|
||||
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 constructing 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.
|
||||
|
||||
For more information about ppxlib and how to use it, please consult the
|
||||
[documentation][doc].
|
||||
|
||||
# What is the relation between ppxlib and other ppx libraries?
|
||||
|
||||
The ppx world has a long and storied history, and if you look around, you
|
||||
may find other projects that offer functionalities similar to
|
||||
ppxlib. The following [blog post][future-of-ppx] gives a good overview
|
||||
of the various libraries that have been developed over time. At this
|
||||
point, ppxlib is considered the de facto library for writing ppx
|
||||
rewriters.
|
||||
|
||||
# History of the project
|
||||
|
||||
This repository was created by merging several older smaller projects
|
||||
that were developed at Jane Street. See [the history](HISTORY.md) for
|
||||
more details.
|
||||
|
||||
[doc]: https://ocaml-ppx.github.io/ppxlib/ppxlib/index.html
|
||||
[future-of-ppx]: https://discuss.ocaml.org/t/the-future-of-ppx/3766
|
||||
44
unikernel/duniverse/ppxlib/RELEASING.md
Normal file
44
unikernel/duniverse/ppxlib/RELEASING.md
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
# How to release ppxlib
|
||||
|
||||
`ppxlib` is a rather central piece of the OCaml ecosystem and as such,
|
||||
new versions must be released with care.
|
||||
|
||||
It is advised to start with a "draft" release by using github's auto-generated
|
||||
archives with the git hash of the main branch's HEAD. This can be done by
|
||||
opening a draft PR to opam-repository using a copy of `ppxlib.opam` and adding
|
||||
the following:
|
||||
```
|
||||
url {
|
||||
src: "https://github.com/ocaml-ppx/ppxlib/archive/<rev>.tar.gz"
|
||||
checksum: [
|
||||
"sha256=<sha256sum>"
|
||||
"sha512=<sha512sum>"
|
||||
]
|
||||
}
|
||||
```
|
||||
and replacing `<rev>` by the main branch's HEAD git hash (or the revision you'd
|
||||
like to release) and adding the hash of the corresponding archive.
|
||||
|
||||
Once we are satisfied with the results of `opam-ci` on our draft PR, we can
|
||||
proceed with a regular dune-release workflow, ideally reusing the existing PR.
|
||||
|
||||
## Dealing with trunk support
|
||||
|
||||
Starting with OCaml 5.3, we are experimenting incrementally adding support
|
||||
for the next OCaml release directly onto ppxlib's main branch.
|
||||
|
||||
Our opam file therefore declares a compiler upper bound two versions higher than
|
||||
the latest release to allow installing ppxlib with a trunk compiler when pinning
|
||||
it to the main branch.
|
||||
|
||||
We do not want to release the support before the next compiler is stable enough,
|
||||
usually that's when it reaches the first beta release. In the meantime, when
|
||||
releasing we must edit the upper bound, setting it back so that we support OCaml
|
||||
versions up to the latest release. Once the release went through, we must set it
|
||||
back to its previous value.
|
||||
|
||||
To both act as a reminder and help interested users to keep track of trunk
|
||||
support, we also added a changelog section about it in the `unreleased` section.
|
||||
Similarly to the compiler upperbound, this section is not be included into the
|
||||
release changelog until the new compiler is stable enough. The section should
|
||||
be removed from the changelog before the release and re-added afterwards.
|
||||
61
unikernel/duniverse/ppxlib/appveyor.yml
Normal file
61
unikernel/duniverse/ppxlib/appveyor.yml
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
platform:
|
||||
- x86
|
||||
environment:
|
||||
global:
|
||||
FORK_USER: ocaml
|
||||
FORK_BRANCH: master
|
||||
CYG_ROOT: C:\cygwin64
|
||||
PINS: ppxlib:.
|
||||
matrix:
|
||||
- OPAM_SWITCH: 4.04.2+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.04.2+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.05.0+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.05.0+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.06.0+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.06.0+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.07.1+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.07.1+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.08.0+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.08.0+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.09.0+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.09.0+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.10.1+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.10.1+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.11.1+mingw64c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
- OPAM_SWITCH: 4.11.1+mingw32c
|
||||
PACKAGE: ppxlib
|
||||
TESTS: false
|
||||
install:
|
||||
- ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1"))
|
||||
build_script:
|
||||
- call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh
|
||||
10865
unikernel/duniverse/ppxlib/ast/ast.ml
Normal file
10865
unikernel/duniverse/ppxlib/ast/ast.ml
Normal file
File diff suppressed because it is too large
Load diff
580
unikernel/duniverse/ppxlib/ast/ast_helper_lite.ml
Normal file
580
unikernel/duniverse/ppxlib/ast/ast_helper_lite.ml
Normal file
|
|
@ -0,0 +1,580 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* 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. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* TODO: remove this open *)
|
||||
open Stdlib0
|
||||
module Location = Astlib.Location
|
||||
module Longident = Astlib.Longident
|
||||
open Astlib.Ast_502
|
||||
|
||||
[@@@warning "-9"]
|
||||
|
||||
open Asttypes
|
||||
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
|
||||
|
||||
let default_loc = ref Location.none
|
||||
|
||||
type ref_and_value = R : 'a ref * 'a -> ref_and_value
|
||||
|
||||
let protect_ref =
|
||||
let set_ref (R (r, v)) = r := v in
|
||||
fun ref f ->
|
||||
let (R (r, _)) = ref in
|
||||
let backup = R (r, !r) in
|
||||
set_ref ref;
|
||||
match f () with
|
||||
| x ->
|
||||
set_ref backup;
|
||||
x
|
||||
| exception e ->
|
||||
set_ref backup;
|
||||
raise e
|
||||
|
||||
let with_default_loc l f = protect_ref (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
|
||||
Location.raise_errorf ~loc "variable in scope syntax error: %s" 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.txt;
|
||||
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)
|
||||
| Ptyp_open (l, ct) -> Ptyp_open (l, loop ct)
|
||||
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, Option.map (fun b -> ([], b)) 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 function_ ?loc ?attrs ?loc_location cases =
|
||||
let loc_locations =
|
||||
match loc_location with Some l -> l | None -> !default_loc
|
||||
in
|
||||
mk ?loc ?attrs
|
||||
(Pexp_function ([], None, Pfunction_cases (cases, loc_locations, [])))
|
||||
|
||||
let fun_ ?loc ?attrs a b c d =
|
||||
let pparam_desc = Pparam_val (a, b, c) in
|
||||
let body = Pfunction_body d in
|
||||
let pparam_loc = match loc with Some loc -> loc | None -> Location.none in
|
||||
mk ?loc ?attrs (Pexp_function ([ { pparam_loc; pparam_desc } ], None, body))
|
||||
|
||||
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)
|
||||
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)
|
||||
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 = []) d =
|
||||
{ pctf_desc = d; pctf_loc = loc; pctf_attributes = 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 attr d a = { d with pctf_attributes = d.pctf_attributes @ [ a ] }
|
||||
end
|
||||
|
||||
module Cf = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) d =
|
||||
{ pcf_desc = d; pcf_loc = loc; pcf_attributes = 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 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 = []) ?(prim = []) name typ =
|
||||
{
|
||||
pval_name = name;
|
||||
pval_type = typ;
|
||||
pval_attributes = attrs;
|
||||
pval_loc = loc;
|
||||
pval_prim = prim;
|
||||
}
|
||||
end
|
||||
|
||||
module Md = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) name typ =
|
||||
{ pmd_name = name; pmd_type = typ; pmd_attributes = attrs; pmd_loc = loc }
|
||||
end
|
||||
|
||||
module Ms = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) name syn =
|
||||
{
|
||||
pms_name = name;
|
||||
pms_manifest = syn;
|
||||
pms_attributes = attrs;
|
||||
pms_loc = loc;
|
||||
}
|
||||
end
|
||||
|
||||
module Mtd = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?typ name =
|
||||
{
|
||||
pmtd_name = name;
|
||||
pmtd_type = typ;
|
||||
pmtd_attributes = attrs;
|
||||
pmtd_loc = loc;
|
||||
}
|
||||
end
|
||||
|
||||
module Mb = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) name expr =
|
||||
{ pmb_name = name; pmb_expr = expr; pmb_attributes = attrs; pmb_loc = loc }
|
||||
end
|
||||
|
||||
module Opn = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?(override = Fresh) expr =
|
||||
{
|
||||
popen_expr = expr;
|
||||
popen_override = override;
|
||||
popen_loc = loc;
|
||||
popen_attributes = attrs;
|
||||
}
|
||||
end
|
||||
|
||||
module Incl = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) mexpr =
|
||||
{ pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = attrs }
|
||||
end
|
||||
|
||||
module Vb = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?value_constraint pat expr =
|
||||
{
|
||||
pvb_pat = pat;
|
||||
pvb_expr = expr;
|
||||
pvb_attributes = attrs;
|
||||
pvb_loc = loc;
|
||||
pvb_constraint = value_constraint;
|
||||
}
|
||||
end
|
||||
|
||||
module Ci = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?(virt = Concrete) ?(params = [])
|
||||
name expr =
|
||||
{
|
||||
pci_virt = virt;
|
||||
pci_params = params;
|
||||
pci_name = name;
|
||||
pci_expr = expr;
|
||||
pci_attributes = attrs;
|
||||
pci_loc = loc;
|
||||
}
|
||||
end
|
||||
|
||||
let constructor ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
|
||||
?(args = Pcstr_tuple []) ?res name =
|
||||
{
|
||||
pcd_name = name;
|
||||
pcd_vars = vars;
|
||||
pcd_args = args;
|
||||
pcd_res = res;
|
||||
pcd_loc = loc;
|
||||
pcd_attributes = attrs;
|
||||
}
|
||||
|
||||
module Type = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?(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 = attrs;
|
||||
ptype_loc = loc;
|
||||
}
|
||||
|
||||
let constructor ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
|
||||
?(args = Pcstr_tuple []) ?res name =
|
||||
{
|
||||
pcd_name = name;
|
||||
pcd_vars = vars;
|
||||
pcd_args = args;
|
||||
pcd_res = res;
|
||||
pcd_loc = loc;
|
||||
pcd_attributes = attrs;
|
||||
}
|
||||
|
||||
let field ?(loc = !default_loc) ?(attrs = []) ?(mut = Immutable) name typ =
|
||||
{
|
||||
pld_name = name;
|
||||
pld_mutable = mut;
|
||||
pld_type = typ;
|
||||
pld_loc = loc;
|
||||
pld_attributes = attrs;
|
||||
}
|
||||
end
|
||||
|
||||
(** Type extensions *)
|
||||
module Te = struct
|
||||
let mk ?(loc = !default_loc) ?(attrs = []) ?(params = []) ?(priv = Public)
|
||||
path constructors =
|
||||
{
|
||||
ptyext_path = path;
|
||||
ptyext_params = params;
|
||||
ptyext_constructors = constructors;
|
||||
ptyext_private = priv;
|
||||
ptyext_loc = loc;
|
||||
ptyext_attributes = attrs;
|
||||
}
|
||||
|
||||
let mk_exception ?(loc = !default_loc) ?(attrs = []) constructor =
|
||||
{
|
||||
ptyexn_constructor = constructor;
|
||||
ptyexn_loc = loc;
|
||||
ptyexn_attributes = attrs;
|
||||
}
|
||||
|
||||
let constructor ?(loc = !default_loc) ?(attrs = []) name kind =
|
||||
{
|
||||
pext_name = name;
|
||||
pext_kind = kind;
|
||||
pext_loc = loc;
|
||||
pext_attributes = attrs;
|
||||
}
|
||||
|
||||
let decl ?(loc = !default_loc) ?(attrs = []) ?(vars = [])
|
||||
?(args = Pcstr_tuple []) ?res name =
|
||||
{
|
||||
pext_name = name;
|
||||
pext_kind = Pext_decl (vars, args, res);
|
||||
pext_loc = loc;
|
||||
pext_attributes = attrs;
|
||||
}
|
||||
|
||||
let rebind ?(loc = !default_loc) ?(attrs = []) name lid =
|
||||
{
|
||||
pext_name = name;
|
||||
pext_kind = Pext_rebind lid;
|
||||
pext_loc = loc;
|
||||
pext_attributes = 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
|
||||
657
unikernel/duniverse/ppxlib/ast/ast_helper_lite.mli
Normal file
657
unikernel/duniverse/ppxlib/ast/ast_helper_lite.mli
Normal file
|
|
@ -0,0 +1,657 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* 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. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(** Copy of Ast_helper from OCaml 4.14 with docstring related stuff removed *)
|
||||
|
||||
open Astlib.Ast_502
|
||||
open Asttypes
|
||||
open Parsetree
|
||||
|
||||
type 'a with_loc = 'a Astlib.Location.loc
|
||||
type loc = Astlib.Location.t
|
||||
type lid = Astlib.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:loc -> 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 -> str -> 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 -> ?loc_location:loc -> 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 ->
|
||||
?prim:string list ->
|
||||
str ->
|
||||
core_type ->
|
||||
value_description
|
||||
end
|
||||
|
||||
(** Type declarations *)
|
||||
module Type : sig
|
||||
val mk :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?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 ->
|
||||
?vars:str list ->
|
||||
?args:constructor_arguments ->
|
||||
?res:core_type ->
|
||||
str ->
|
||||
constructor_declaration
|
||||
|
||||
val field :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?mut:mutable_flag ->
|
||||
str ->
|
||||
core_type ->
|
||||
label_declaration
|
||||
end
|
||||
|
||||
(** Type extensions *)
|
||||
module Te : sig
|
||||
val mk :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?params:(core_type * (variance * injectivity)) list ->
|
||||
?priv:private_flag ->
|
||||
lid ->
|
||||
extension_constructor list ->
|
||||
type_extension
|
||||
|
||||
val mk_exception :
|
||||
?loc:loc -> ?attrs:attrs -> extension_constructor -> type_exception
|
||||
|
||||
val constructor :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
str ->
|
||||
extension_constructor_kind ->
|
||||
extension_constructor
|
||||
|
||||
val decl :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?vars:str list ->
|
||||
?args:constructor_arguments ->
|
||||
?res:core_type ->
|
||||
str ->
|
||||
extension_constructor
|
||||
|
||||
val rebind : ?loc:loc -> ?attrs:attrs -> 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
|
||||
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
|
||||
end
|
||||
|
||||
(** Module declarations *)
|
||||
module Md : sig
|
||||
val mk :
|
||||
?loc:loc -> ?attrs:attrs -> str_opt -> module_type -> module_declaration
|
||||
end
|
||||
|
||||
(** Module substitutions *)
|
||||
module Ms : sig
|
||||
val mk : ?loc:loc -> ?attrs:attrs -> str -> lid -> module_substitution
|
||||
end
|
||||
|
||||
(** Module type declarations *)
|
||||
module Mtd : sig
|
||||
val mk :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?typ:module_type ->
|
||||
str ->
|
||||
module_type_declaration
|
||||
end
|
||||
|
||||
(** Module bindings *)
|
||||
module Mb : sig
|
||||
val mk : ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr -> module_binding
|
||||
end
|
||||
|
||||
(** Opens *)
|
||||
module Opn : sig
|
||||
val mk :
|
||||
?loc:loc -> ?attrs:attrs -> ?override:override_flag -> 'a -> 'a open_infos
|
||||
end
|
||||
|
||||
(** Includes *)
|
||||
module Incl : sig
|
||||
val mk : ?loc:loc -> ?attrs:attrs -> 'a -> 'a include_infos
|
||||
end
|
||||
|
||||
(** Value bindings *)
|
||||
module Vb : sig
|
||||
val mk :
|
||||
?loc:loc ->
|
||||
?attrs:attrs ->
|
||||
?value_constraint:value_constraint ->
|
||||
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 -> 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
|
||||
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 -> 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 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 ->
|
||||
?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
|
||||
34
unikernel/duniverse/ppxlib/ast/cinaps/ast_cinaps_helpers.ml
Normal file
34
unikernel/duniverse/ppxlib/ast/cinaps/ast_cinaps_helpers.ml
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
(* -*- tuareg -*- *)
|
||||
|
||||
include StdLabels
|
||||
include Printf
|
||||
|
||||
let capitalize_ascii = Stdppx.String.capitalize_ascii
|
||||
|
||||
(* Reexports from [Astlib_cinaps_helpers] *)
|
||||
let nl = Astlib_cinaps_helpers.nl
|
||||
let qualified_types = Astlib_cinaps_helpers.qualified_types
|
||||
let foreach_module = Astlib_cinaps_helpers.foreach_module
|
||||
let foreach_type = Astlib_cinaps_helpers.foreach_type
|
||||
let all_types = List.concat (List.map ~f:snd qualified_types)
|
||||
|
||||
let foreach_version f =
|
||||
nl ();
|
||||
List.iter Supported_version.all ~f:(fun v ->
|
||||
f (Supported_version.to_int v) (Supported_version.to_string v))
|
||||
|
||||
let foreach_version_pair f =
|
||||
nl ();
|
||||
let rec aux = function
|
||||
| x :: (y :: _ as tail) ->
|
||||
f (Supported_version.to_int x) (Supported_version.to_int y);
|
||||
aux tail
|
||||
| [ _ ] | [] -> ()
|
||||
in
|
||||
aux Supported_version.all
|
||||
|
||||
let with_then_and () =
|
||||
let first = ref true in
|
||||
fun oc ->
|
||||
output_string oc (if !first then "with" else " and");
|
||||
first := false
|
||||
3
unikernel/duniverse/ppxlib/ast/cinaps/dune
Normal file
3
unikernel/duniverse/ppxlib/ast/cinaps/dune
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(library
|
||||
(name ast_cinaps_helpers)
|
||||
(libraries stdppx supported_version astlib_cinaps_helpers))
|
||||
23
unikernel/duniverse/ppxlib/ast/dune
Normal file
23
unikernel/duniverse/ppxlib/ast/dune
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
;; Note that to use the preprocessor for the (* IF_AT_LEAST ... *)
|
||||
;; syntax you have to make sure the module is in the module list in
|
||||
;; (per_module <action> <module_list>)
|
||||
|
||||
(library
|
||||
(name ppxlib_ast)
|
||||
(public_name ppxlib.ast)
|
||||
(libraries astlib stdlib-shims)
|
||||
(flags
|
||||
(:standard -safe-string)
|
||||
-w
|
||||
-9-27-32)
|
||||
(preprocess
|
||||
(per_module
|
||||
((action
|
||||
(run %{exe:pp/pp.exe} %{ocaml_version} %{input-file}))
|
||||
versions)))
|
||||
(lint
|
||||
(pps ppxlib_traverse -deriving-keep-w32=impl)))
|
||||
|
||||
(cinaps
|
||||
(files *.ml *.mli)
|
||||
(libraries ast_cinaps_helpers))
|
||||
214
unikernel/duniverse/ppxlib/ast/import.ml
Normal file
214
unikernel/duniverse/ppxlib/ast/import.ml
Normal file
|
|
@ -0,0 +1,214 @@
|
|||
(* This file is used to control what we use from the current compiler and what is embed in
|
||||
this library.
|
||||
|
||||
It must be opened in all modules, especially the ones coming from the compiler.
|
||||
*)
|
||||
|
||||
(*$ open Ast_cinaps_helpers $*)
|
||||
|
||||
module Js = Versions.OCaml_502
|
||||
module Ocaml = Versions.OCaml_current
|
||||
|
||||
module Select_ast (Ocaml : Versions.OCaml_version) = struct
|
||||
include Js
|
||||
|
||||
module Type = struct
|
||||
type ('js, 'ocaml) t =
|
||||
(*$ foreach_type (fun _ s ->
|
||||
printf
|
||||
" | %s\n\
|
||||
\ : ( Js.Ast.Parsetree.%s,\n\
|
||||
\ Ocaml.Ast.Parsetree.%s )\n\
|
||||
\ t\n"
|
||||
(capitalize_ascii s) s s
|
||||
)
|
||||
*)
|
||||
| Structure
|
||||
: ( Js.Ast.Parsetree.structure,
|
||||
Ocaml.Ast.Parsetree.structure )
|
||||
t
|
||||
| Signature
|
||||
: ( Js.Ast.Parsetree.signature,
|
||||
Ocaml.Ast.Parsetree.signature )
|
||||
t
|
||||
| Toplevel_phrase
|
||||
: ( Js.Ast.Parsetree.toplevel_phrase,
|
||||
Ocaml.Ast.Parsetree.toplevel_phrase )
|
||||
t
|
||||
| Core_type
|
||||
: ( Js.Ast.Parsetree.core_type,
|
||||
Ocaml.Ast.Parsetree.core_type )
|
||||
t
|
||||
| Expression
|
||||
: ( Js.Ast.Parsetree.expression,
|
||||
Ocaml.Ast.Parsetree.expression )
|
||||
t
|
||||
| Pattern
|
||||
: ( Js.Ast.Parsetree.pattern,
|
||||
Ocaml.Ast.Parsetree.pattern )
|
||||
t
|
||||
| Case
|
||||
: ( Js.Ast.Parsetree.case,
|
||||
Ocaml.Ast.Parsetree.case )
|
||||
t
|
||||
| Type_declaration
|
||||
: ( Js.Ast.Parsetree.type_declaration,
|
||||
Ocaml.Ast.Parsetree.type_declaration )
|
||||
t
|
||||
| Type_extension
|
||||
: ( Js.Ast.Parsetree.type_extension,
|
||||
Ocaml.Ast.Parsetree.type_extension )
|
||||
t
|
||||
| Extension_constructor
|
||||
: ( Js.Ast.Parsetree.extension_constructor,
|
||||
Ocaml.Ast.Parsetree.extension_constructor )
|
||||
t
|
||||
| Class_expr
|
||||
: ( Js.Ast.Parsetree.class_expr,
|
||||
Ocaml.Ast.Parsetree.class_expr )
|
||||
t
|
||||
| Class_field
|
||||
: ( Js.Ast.Parsetree.class_field,
|
||||
Ocaml.Ast.Parsetree.class_field )
|
||||
t
|
||||
| Class_type
|
||||
: ( Js.Ast.Parsetree.class_type,
|
||||
Ocaml.Ast.Parsetree.class_type )
|
||||
t
|
||||
| Class_signature
|
||||
: ( Js.Ast.Parsetree.class_signature,
|
||||
Ocaml.Ast.Parsetree.class_signature )
|
||||
t
|
||||
| Class_type_field
|
||||
: ( Js.Ast.Parsetree.class_type_field,
|
||||
Ocaml.Ast.Parsetree.class_type_field )
|
||||
t
|
||||
| Module_expr
|
||||
: ( Js.Ast.Parsetree.module_expr,
|
||||
Ocaml.Ast.Parsetree.module_expr )
|
||||
t
|
||||
| Module_type
|
||||
: ( Js.Ast.Parsetree.module_type,
|
||||
Ocaml.Ast.Parsetree.module_type )
|
||||
t
|
||||
| Signature_item
|
||||
: ( Js.Ast.Parsetree.signature_item,
|
||||
Ocaml.Ast.Parsetree.signature_item )
|
||||
t
|
||||
| Structure_item
|
||||
: ( Js.Ast.Parsetree.structure_item,
|
||||
Ocaml.Ast.Parsetree.structure_item )
|
||||
t
|
||||
(*$*)
|
||||
| List : ('a, 'b) t -> ('a list, 'b list) t
|
||||
| Pair : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
|
||||
end
|
||||
|
||||
open Type
|
||||
module Of_ocaml = Versions.Convert (Ocaml) (Js)
|
||||
module To_ocaml = Versions.Convert (Js) (Ocaml)
|
||||
|
||||
let rec of_ocaml : type ocaml js. (js, ocaml) Type.t -> ocaml -> js =
|
||||
let open Of_ocaml in
|
||||
fun node ->
|
||||
match node with
|
||||
(*$ foreach_type (fun _ s ->
|
||||
printf
|
||||
" | %s -> copy_%s\n"
|
||||
(capitalize_ascii s) s
|
||||
)
|
||||
*)
|
||||
| Structure -> copy_structure
|
||||
| Signature -> copy_signature
|
||||
| Toplevel_phrase -> copy_toplevel_phrase
|
||||
| Core_type -> copy_core_type
|
||||
| Expression -> copy_expression
|
||||
| Pattern -> copy_pattern
|
||||
| Case -> copy_case
|
||||
| Type_declaration -> copy_type_declaration
|
||||
| Type_extension -> copy_type_extension
|
||||
| Extension_constructor -> copy_extension_constructor
|
||||
| Class_expr -> copy_class_expr
|
||||
| Class_field -> copy_class_field
|
||||
| Class_type -> copy_class_type
|
||||
| Class_signature -> copy_class_signature
|
||||
| Class_type_field -> copy_class_type_field
|
||||
| Module_expr -> copy_module_expr
|
||||
| Module_type -> copy_module_type
|
||||
| Signature_item -> copy_signature_item
|
||||
| Structure_item -> copy_structure_item
|
||||
(*$*)
|
||||
| List t -> List.map (of_ocaml t)
|
||||
| Pair (a, b) ->
|
||||
let f = of_ocaml a in
|
||||
let g = of_ocaml b in
|
||||
fun (x, y) -> (f x, g y)
|
||||
|
||||
let rec to_ocaml : type ocaml js. (js, ocaml) Type.t -> js -> ocaml =
|
||||
let open To_ocaml in
|
||||
fun node ->
|
||||
match node with
|
||||
(*$ foreach_type (fun _ s ->
|
||||
printf
|
||||
" | %s -> copy_%s\n"
|
||||
(capitalize_ascii s) s
|
||||
)
|
||||
*)
|
||||
| Structure -> copy_structure
|
||||
| Signature -> copy_signature
|
||||
| Toplevel_phrase -> copy_toplevel_phrase
|
||||
| Core_type -> copy_core_type
|
||||
| Expression -> copy_expression
|
||||
| Pattern -> copy_pattern
|
||||
| Case -> copy_case
|
||||
| Type_declaration -> copy_type_declaration
|
||||
| Type_extension -> copy_type_extension
|
||||
| Extension_constructor -> copy_extension_constructor
|
||||
| Class_expr -> copy_class_expr
|
||||
| Class_field -> copy_class_field
|
||||
| Class_type -> copy_class_type
|
||||
| Class_signature -> copy_class_signature
|
||||
| Class_type_field -> copy_class_type_field
|
||||
| Module_expr -> copy_module_expr
|
||||
| Module_type -> copy_module_type
|
||||
| Signature_item -> copy_signature_item
|
||||
| Structure_item -> copy_structure_item
|
||||
(*$*)
|
||||
| List t -> List.map (to_ocaml t)
|
||||
| Pair (a, b) ->
|
||||
let f = to_ocaml a in
|
||||
let g = to_ocaml b in
|
||||
fun (x, y) -> (f x, g y)
|
||||
|
||||
let of_ocaml_mapper item f ctxt x = to_ocaml item x |> f ctxt |> of_ocaml item
|
||||
let to_ocaml_mapper item f ctxt x = of_ocaml item x |> f ctxt |> to_ocaml item
|
||||
end
|
||||
|
||||
module Selected_ast = Select_ast (Ocaml)
|
||||
module Ast_helper = Ast_helper_lite
|
||||
|
||||
(* Modules from Ast_<n> of Astlib, where <n> is the compiler version the ppxlib driver is compiled with *)
|
||||
module Parsetree = Selected_ast.Ast.Parsetree
|
||||
module Asttypes = Selected_ast.Ast.Asttypes
|
||||
|
||||
(* Other Astlib modules *)
|
||||
module Location = Astlib.Location
|
||||
module Longident = Astlib.Longident
|
||||
|
||||
module Parse = struct
|
||||
include Astlib.Parse
|
||||
module Of_ocaml = Versions.Convert (Ocaml) (Js)
|
||||
|
||||
let implementation lexbuf = implementation lexbuf |> Of_ocaml.copy_structure
|
||||
let interface lexbuf = interface lexbuf |> Of_ocaml.copy_signature
|
||||
|
||||
let toplevel_phrase lexbuf =
|
||||
toplevel_phrase lexbuf |> Of_ocaml.copy_toplevel_phrase
|
||||
|
||||
let use_file lexbuf =
|
||||
use_file lexbuf |> List.map Of_ocaml.copy_toplevel_phrase
|
||||
|
||||
let core_type lexbuf = core_type lexbuf |> Of_ocaml.copy_core_type
|
||||
let expression lexbuf = expression lexbuf |> Of_ocaml.copy_expression
|
||||
let pattern lexbuf = pattern lexbuf |> Of_ocaml.copy_pattern
|
||||
end
|
||||
72
unikernel/duniverse/ppxlib/ast/location_error.ml
Normal file
72
unikernel/duniverse/ppxlib/ast/location_error.ml
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
open Import
|
||||
|
||||
type t = Astlib.Location.Error.t
|
||||
|
||||
let to_extension (error : Astlib.Location.Error.t) =
|
||||
let open Astlib.Location.Error in
|
||||
let open Ast_helper in
|
||||
if not (is_well_formed error) then
|
||||
raise (Invalid_argument "to_extension: expected kind Report_error");
|
||||
let sub_msgs = sub_msgs error in
|
||||
let main_msg = main_msg error in
|
||||
let err_extension_name loc = { Location.loc; txt = "ocaml.error" } in
|
||||
let mk_string_constant x = Str.eval (Exp.constant (Const.string x)) in
|
||||
let extension_of_sub_msg (sub_msg : string Location.loc) =
|
||||
Str.extension
|
||||
(err_extension_name sub_msg.loc, PStr [ mk_string_constant sub_msg.txt ])
|
||||
in
|
||||
( err_extension_name main_msg.loc,
|
||||
Parsetree.PStr
|
||||
(mk_string_constant main_msg.txt :: List.map extension_of_sub_msg sub_msgs)
|
||||
)
|
||||
|
||||
let register_error_of_exn = Astlib.Location.register_error_of_exn
|
||||
|
||||
let message error =
|
||||
let { Astlib.Location.txt; _ } = Astlib.Location.Error.main_msg error in
|
||||
txt
|
||||
|
||||
let set_message = Astlib.Location.Error.set_main_msg
|
||||
|
||||
let make ~loc txt ~sub =
|
||||
let sub = List.map (fun (loc, txt) -> { Astlib.Location.loc; txt }) sub in
|
||||
Astlib.Location.Error.make ~sub { loc; txt }
|
||||
|
||||
let update_loc = Astlib.Location.Error.set_main_loc
|
||||
|
||||
let get_location error =
|
||||
let { Astlib.Location.loc; _ } = Astlib.Location.Error.main_msg error in
|
||||
loc
|
||||
|
||||
let of_exn = Astlib.Location.Error.of_exn
|
||||
let raise error = raise (Astlib.Location.Error error)
|
||||
|
||||
let of_extension (extension : Ast.extension) =
|
||||
let open Parsetree in
|
||||
let parse_msg = function
|
||||
| {
|
||||
pstr_desc =
|
||||
Pstr_eval
|
||||
({ pexp_desc = Pexp_constant (Pconst_string (msg, _, _)); _ }, []);
|
||||
_;
|
||||
} ->
|
||||
msg
|
||||
| _ -> "ppxlib: failed to extract message in ocaml.error"
|
||||
in
|
||||
let parse_sub_msg = function
|
||||
| {
|
||||
pstr_desc =
|
||||
Pstr_extension
|
||||
(({ txt = "error" | "ocaml.error"; loc }, PStr [ msg ]), []);
|
||||
_;
|
||||
} ->
|
||||
(loc, parse_msg msg)
|
||||
| { pstr_loc = loc; _ } ->
|
||||
(loc, "ppxlib: failed to parse ocaml.error sub messages")
|
||||
in
|
||||
match extension with
|
||||
| { txt = "error" | "ocaml.error"; loc }, PStr (main :: sub) ->
|
||||
let main = parse_msg main in
|
||||
let sub = List.map parse_sub_msg sub in
|
||||
Some (make ~loc main ~sub)
|
||||
| _ -> None
|
||||
14
unikernel/duniverse/ppxlib/ast/location_error.mli
Normal file
14
unikernel/duniverse/ppxlib/ast/location_error.mli
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
open Import
|
||||
|
||||
type t = Astlib.Location.Error.t
|
||||
|
||||
val of_exn : exn -> t option
|
||||
val register_error_of_exn : (exn -> t option) -> unit
|
||||
val message : t -> string
|
||||
val set_message : t -> string -> t
|
||||
val make : loc:Location.t -> string -> sub:(Location.t * string) list -> t
|
||||
val to_extension : t -> Import.Parsetree.extension
|
||||
val raise : t -> 'a
|
||||
val update_loc : t -> Location.t -> t
|
||||
val get_location : t -> Location.t
|
||||
val of_extension : Import.Parsetree.extension -> t option
|
||||
6
unikernel/duniverse/ppxlib/ast/pp/dune
Normal file
6
unikernel/duniverse/ppxlib/ast/pp/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(executables
|
||||
(names pp)
|
||||
(libraries supported_version)
|
||||
(flags :standard -w -3))
|
||||
|
||||
(ocamllex pp_rewrite)
|
||||
16
unikernel/duniverse/ppxlib/ast/pp/pp.ml
Normal file
16
unikernel/duniverse/ppxlib/ast/pp/pp.ml
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
let () =
|
||||
match Sys.argv with
|
||||
| [| _; ocaml_version_str; fname |] ->
|
||||
let ocaml_version =
|
||||
match Supported_version.of_string ocaml_version_str with
|
||||
| Some v -> string_of_int (Supported_version.to_int v)
|
||||
| None ->
|
||||
Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str;
|
||||
exit 1
|
||||
in
|
||||
let ic = open_in_bin fname in
|
||||
Printf.printf "# 1 %S\n" fname;
|
||||
Pp_rewrite.rewrite ocaml_version (Lexing.from_channel ic)
|
||||
| _ ->
|
||||
Printf.eprintf "%s: <ocaml-version> <file-name>\n" Sys.executable_name;
|
||||
exit 2
|
||||
1
unikernel/duniverse/ppxlib/ast/pp/pp.mli
Normal file
1
unikernel/duniverse/ppxlib/ast/pp/pp.mli
Normal file
|
|
@ -0,0 +1 @@
|
|||
(* empty *)
|
||||
1
unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mli
Normal file
1
unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mli
Normal file
|
|
@ -0,0 +1 @@
|
|||
val rewrite : string -> Lexing.lexbuf -> unit
|
||||
27
unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mll
Normal file
27
unikernel/duniverse/ppxlib/ast/pp/pp_rewrite.mll
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
{
|
||||
open Printf
|
||||
|
||||
let print_ocaml_version version =
|
||||
let patt_len = String.length "OCAML_VERSION" in
|
||||
(* Note: the spaces in the replacements are to preserve locations *)
|
||||
printf "%-*s" patt_len version
|
||||
}
|
||||
|
||||
rule rewrite ocaml_version = parse
|
||||
| "OCAML_VERSION"
|
||||
{ print_ocaml_version ocaml_version;
|
||||
rewrite ocaml_version lexbuf
|
||||
}
|
||||
| "(*IF_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)"
|
||||
{ let chunk = if (v <= ocaml_version)
|
||||
then " " ^ String.make (String.length v + 1) ' ' ^ s ^ " "
|
||||
else Lexing.lexeme lexbuf
|
||||
in
|
||||
print_string chunk;
|
||||
rewrite ocaml_version lexbuf
|
||||
}
|
||||
| _ as c
|
||||
{ print_char c;
|
||||
rewrite ocaml_version lexbuf
|
||||
}
|
||||
| eof { () }
|
||||
19
unikernel/duniverse/ppxlib/ast/ppxlib_ast.ml
Normal file
19
unikernel/duniverse/ppxlib/ast/ppxlib_ast.ml
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
open Import
|
||||
|
||||
module type OCaml_version = Versions.OCaml_version
|
||||
|
||||
module Ast = Ast
|
||||
module Ast_helper = Ast_helper
|
||||
module Ast_magic = Selected_ast.Ast.Config
|
||||
module Asttypes = Asttypes
|
||||
module Compiler_version = Versions.OCaml_current
|
||||
module Js = Js
|
||||
module Find_version = Versions.Find_version
|
||||
module Convert = Versions.Convert
|
||||
module Extra_warnings = Warn
|
||||
module Location_error = Location_error
|
||||
module Parse = Parse
|
||||
module Parsetree = Parsetree
|
||||
module Pprintast = Astlib.Pprintast
|
||||
module Select_ast = Select_ast
|
||||
module Selected_ast = Selected_ast
|
||||
7
unikernel/duniverse/ppxlib/ast/stdlib0.ml
Normal file
7
unikernel/duniverse/ppxlib/ast/stdlib0.ml
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
module Int = struct
|
||||
let to_string = string_of_int
|
||||
end
|
||||
|
||||
module Option = struct
|
||||
let map f o = match o with None -> None | Some v -> Some (f v)
|
||||
end
|
||||
2
unikernel/duniverse/ppxlib/ast/supported_version/dune
Normal file
2
unikernel/duniverse/ppxlib/ast/supported_version/dune
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(library
|
||||
(name supported_version))
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
type t = int * int
|
||||
|
||||
let all =
|
||||
[
|
||||
(4, 08);
|
||||
(4, 09);
|
||||
(4, 10);
|
||||
(4, 11);
|
||||
(4, 12);
|
||||
(4, 13);
|
||||
(4, 14);
|
||||
(5, 0);
|
||||
(5, 1);
|
||||
(5, 2);
|
||||
(5, 3);
|
||||
(5, 4);
|
||||
]
|
||||
|
||||
let to_string (a, b) =
|
||||
if a < 5 then Printf.sprintf "%d.%02d" a b else Printf.sprintf "%d.%d" a b
|
||||
|
||||
let to_int (a, b) = (a * 100) + b
|
||||
|
||||
let of_string s =
|
||||
let t = Scanf.sscanf s "%u.%u" (fun a b -> (a, b)) in
|
||||
if List.mem t all then Some t else None
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
(** Supported versions of the OCaml AST *)
|
||||
|
||||
type t
|
||||
|
||||
val all : t list
|
||||
|
||||
val to_string : t -> string
|
||||
(** Return a string such as "4.02" *)
|
||||
|
||||
val to_int : t -> int
|
||||
(** Return an integer such as [402] *)
|
||||
|
||||
val of_string : string -> t option
|
||||
(** Parse a string as reported by [ocamlc -version] *)
|
||||
728
unikernel/duniverse/ppxlib/ast/versions.ml
Normal file
728
unikernel/duniverse/ppxlib/ast/versions.ml
Normal file
|
|
@ -0,0 +1,728 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml Migrate Parsetree *)
|
||||
(* *)
|
||||
(* Frédéric Bour *)
|
||||
(* Jérémie Dimino, Jane Street Europe *)
|
||||
(* *)
|
||||
(* Copyright 2017 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique (INRIA). *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(* BEGIN of BLACK MAGIC *)
|
||||
(*$ open Ast_cinaps_helpers $*)
|
||||
|
||||
type _ witnesses = ..
|
||||
|
||||
type _ migration = ..
|
||||
type _ migration += Undefined : _ migration
|
||||
|
||||
type 'a migration_info = {
|
||||
mutable next_version : 'a migration;
|
||||
mutable previous_version : 'a migration;
|
||||
}
|
||||
|
||||
(** Abstract view of a version of an OCaml Ast *)
|
||||
module type Ast = sig
|
||||
(*$ foreach_module (fun m types ->
|
||||
printf " module %s : sig\n" m;
|
||||
List.iter types ~f:(printf " type %s\n");
|
||||
printf " end\n"
|
||||
)
|
||||
*)
|
||||
module Parsetree : sig
|
||||
type structure
|
||||
type signature
|
||||
type toplevel_phrase
|
||||
type core_type
|
||||
type expression
|
||||
type pattern
|
||||
type case
|
||||
type type_declaration
|
||||
type type_extension
|
||||
type extension_constructor
|
||||
type class_expr
|
||||
type class_field
|
||||
type class_type
|
||||
type class_signature
|
||||
type class_type_field
|
||||
type module_expr
|
||||
type module_type
|
||||
type signature_item
|
||||
type structure_item
|
||||
end
|
||||
(*$*)
|
||||
module Config : sig
|
||||
val ast_impl_magic_number : string
|
||||
val ast_intf_magic_number : string
|
||||
end
|
||||
end
|
||||
|
||||
(* Shortcuts for talking about ast types outside of the module language *)
|
||||
|
||||
type 'a _types = 'a constraint 'a
|
||||
= <
|
||||
(*$ foreach_type (fun _ s -> printf " %-21s : _;\n" s) *)
|
||||
structure : _;
|
||||
signature : _;
|
||||
toplevel_phrase : _;
|
||||
core_type : _;
|
||||
expression : _;
|
||||
pattern : _;
|
||||
case : _;
|
||||
type_declaration : _;
|
||||
type_extension : _;
|
||||
extension_constructor : _;
|
||||
class_expr : _;
|
||||
class_field : _;
|
||||
class_type : _;
|
||||
class_signature : _;
|
||||
class_type_field : _;
|
||||
module_expr : _;
|
||||
module_type : _;
|
||||
signature_item : _;
|
||||
structure_item : _;
|
||||
(*$*)
|
||||
>
|
||||
;;
|
||||
|
||||
(*$ foreach_type (fun _ s ->
|
||||
printf "type 'a get_%s =\n" s;
|
||||
printf " 'x constraint 'a _types = < %s : 'x; .. >\n" s
|
||||
) *)
|
||||
type 'a get_structure =
|
||||
'x constraint 'a _types = < structure : 'x; .. >
|
||||
type 'a get_signature =
|
||||
'x constraint 'a _types = < signature : 'x; .. >
|
||||
type 'a get_toplevel_phrase =
|
||||
'x constraint 'a _types = < toplevel_phrase : 'x; .. >
|
||||
type 'a get_core_type =
|
||||
'x constraint 'a _types = < core_type : 'x; .. >
|
||||
type 'a get_expression =
|
||||
'x constraint 'a _types = < expression : 'x; .. >
|
||||
type 'a get_pattern =
|
||||
'x constraint 'a _types = < pattern : 'x; .. >
|
||||
type 'a get_case =
|
||||
'x constraint 'a _types = < case : 'x; .. >
|
||||
type 'a get_type_declaration =
|
||||
'x constraint 'a _types = < type_declaration : 'x; .. >
|
||||
type 'a get_type_extension =
|
||||
'x constraint 'a _types = < type_extension : 'x; .. >
|
||||
type 'a get_extension_constructor =
|
||||
'x constraint 'a _types = < extension_constructor : 'x; .. >
|
||||
type 'a get_class_expr =
|
||||
'x constraint 'a _types = < class_expr : 'x; .. >
|
||||
type 'a get_class_field =
|
||||
'x constraint 'a _types = < class_field : 'x; .. >
|
||||
type 'a get_class_type =
|
||||
'x constraint 'a _types = < class_type : 'x; .. >
|
||||
type 'a get_class_signature =
|
||||
'x constraint 'a _types = < class_signature : 'x; .. >
|
||||
type 'a get_class_type_field =
|
||||
'x constraint 'a _types = < class_type_field : 'x; .. >
|
||||
type 'a get_module_expr =
|
||||
'x constraint 'a _types = < module_expr : 'x; .. >
|
||||
type 'a get_module_type =
|
||||
'x constraint 'a _types = < module_type : 'x; .. >
|
||||
type 'a get_signature_item =
|
||||
'x constraint 'a _types = < signature_item : 'x; .. >
|
||||
type 'a get_structure_item =
|
||||
'x constraint 'a _types = < structure_item : 'x; .. >
|
||||
(*$*)
|
||||
|
||||
module type OCaml_version = sig
|
||||
module Ast : Ast
|
||||
val version : int
|
||||
val string_version : string
|
||||
type types = <
|
||||
(*$ foreach_type (fun m s -> printf " %-21s : Ast.%s.%s;\n" s m s)*)
|
||||
structure : Ast.Parsetree.structure;
|
||||
signature : Ast.Parsetree.signature;
|
||||
toplevel_phrase : Ast.Parsetree.toplevel_phrase;
|
||||
core_type : Ast.Parsetree.core_type;
|
||||
expression : Ast.Parsetree.expression;
|
||||
pattern : Ast.Parsetree.pattern;
|
||||
case : Ast.Parsetree.case;
|
||||
type_declaration : Ast.Parsetree.type_declaration;
|
||||
type_extension : Ast.Parsetree.type_extension;
|
||||
extension_constructor : Ast.Parsetree.extension_constructor;
|
||||
class_expr : Ast.Parsetree.class_expr;
|
||||
class_field : Ast.Parsetree.class_field;
|
||||
class_type : Ast.Parsetree.class_type;
|
||||
class_signature : Ast.Parsetree.class_signature;
|
||||
class_type_field : Ast.Parsetree.class_type_field;
|
||||
module_expr : Ast.Parsetree.module_expr;
|
||||
module_type : Ast.Parsetree.module_type;
|
||||
signature_item : Ast.Parsetree.signature_item;
|
||||
structure_item : Ast.Parsetree.structure_item;
|
||||
(*$*)
|
||||
> _types
|
||||
type _ witnesses += Version : types witnesses
|
||||
val migration_info : types migration_info
|
||||
end
|
||||
|
||||
module Make_witness(Ast : Ast) =
|
||||
struct
|
||||
type types = <
|
||||
(*$ foreach_type (fun m s -> printf " %-21s : Ast.%s.%s;\n" s m s)*)
|
||||
structure : Ast.Parsetree.structure;
|
||||
signature : Ast.Parsetree.signature;
|
||||
toplevel_phrase : Ast.Parsetree.toplevel_phrase;
|
||||
core_type : Ast.Parsetree.core_type;
|
||||
expression : Ast.Parsetree.expression;
|
||||
pattern : Ast.Parsetree.pattern;
|
||||
case : Ast.Parsetree.case;
|
||||
type_declaration : Ast.Parsetree.type_declaration;
|
||||
type_extension : Ast.Parsetree.type_extension;
|
||||
extension_constructor : Ast.Parsetree.extension_constructor;
|
||||
class_expr : Ast.Parsetree.class_expr;
|
||||
class_field : Ast.Parsetree.class_field;
|
||||
class_type : Ast.Parsetree.class_type;
|
||||
class_signature : Ast.Parsetree.class_signature;
|
||||
class_type_field : Ast.Parsetree.class_type_field;
|
||||
module_expr : Ast.Parsetree.module_expr;
|
||||
module_type : Ast.Parsetree.module_type;
|
||||
signature_item : Ast.Parsetree.signature_item;
|
||||
structure_item : Ast.Parsetree.structure_item;
|
||||
(*$*)
|
||||
> _types
|
||||
type _ witnesses += Version : types witnesses
|
||||
let migration_info : types migration_info =
|
||||
{ next_version = Undefined; previous_version = Undefined }
|
||||
end
|
||||
|
||||
type 'types ocaml_version =
|
||||
(module OCaml_version
|
||||
(*$ let sep = with_then_and () in
|
||||
foreach_type (fun m s ->
|
||||
printf " %t type Ast.%s.%s = 'types get_%s\n" sep m s s) *)
|
||||
with type Ast.Parsetree.structure = 'types get_structure
|
||||
and type Ast.Parsetree.signature = 'types get_signature
|
||||
and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase
|
||||
and type Ast.Parsetree.core_type = 'types get_core_type
|
||||
and type Ast.Parsetree.expression = 'types get_expression
|
||||
and type Ast.Parsetree.pattern = 'types get_pattern
|
||||
and type Ast.Parsetree.case = 'types get_case
|
||||
and type Ast.Parsetree.type_declaration = 'types get_type_declaration
|
||||
and type Ast.Parsetree.type_extension = 'types get_type_extension
|
||||
and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor
|
||||
and type Ast.Parsetree.class_expr = 'types get_class_expr
|
||||
and type Ast.Parsetree.class_field = 'types get_class_field
|
||||
and type Ast.Parsetree.class_type = 'types get_class_type
|
||||
and type Ast.Parsetree.class_signature = 'types get_class_signature
|
||||
and type Ast.Parsetree.class_type_field = 'types get_class_type_field
|
||||
and type Ast.Parsetree.module_expr = 'types get_module_expr
|
||||
and type Ast.Parsetree.module_type = 'types get_module_type
|
||||
and type Ast.Parsetree.signature_item = 'types get_signature_item
|
||||
and type Ast.Parsetree.structure_item = 'types get_structure_item
|
||||
(*$*)
|
||||
)
|
||||
|
||||
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_class_expr: 'from get_class_expr -> 'to_ get_class_expr;
|
||||
copy_class_field: 'from get_class_field -> 'to_ get_class_field;
|
||||
copy_class_type: 'from get_class_type -> 'to_ get_class_type;
|
||||
copy_class_signature: 'from get_class_signature -> 'to_ get_class_signature;
|
||||
copy_class_type_field: 'from get_class_type_field -> 'to_ get_class_type_field;
|
||||
copy_module_expr: 'from get_module_expr -> 'to_ get_module_expr;
|
||||
copy_module_type: 'from get_module_type -> 'to_ get_module_type;
|
||||
copy_signature_item: 'from get_signature_item -> 'to_ get_signature_item;
|
||||
copy_structure_item: 'from get_structure_item -> 'to_ get_structure_item;
|
||||
(*$*)
|
||||
}
|
||||
|
||||
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_class_expr = id;
|
||||
copy_class_field = id;
|
||||
copy_class_type = id;
|
||||
copy_class_signature = id;
|
||||
copy_class_type_field = id;
|
||||
copy_module_expr = id;
|
||||
copy_module_type = id;
|
||||
copy_signature_item = id;
|
||||
copy_structure_item = id;
|
||||
(*$*)
|
||||
}
|
||||
|
||||
let compose f g x = f (g x)
|
||||
let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migration_functions) : ('a, 'c) migration_functions = {
|
||||
(*$ foreach_type (fun _ s ->
|
||||
printf " copy_%-21s = compose bc.copy_%-21s ab.copy_%s;\n" s s s) *)
|
||||
copy_structure = compose bc.copy_structure ab.copy_structure;
|
||||
copy_signature = compose bc.copy_signature ab.copy_signature;
|
||||
copy_toplevel_phrase = compose bc.copy_toplevel_phrase ab.copy_toplevel_phrase;
|
||||
copy_core_type = compose bc.copy_core_type ab.copy_core_type;
|
||||
copy_expression = compose bc.copy_expression ab.copy_expression;
|
||||
copy_pattern = compose bc.copy_pattern ab.copy_pattern;
|
||||
copy_case = compose bc.copy_case ab.copy_case;
|
||||
copy_type_declaration = compose bc.copy_type_declaration ab.copy_type_declaration;
|
||||
copy_type_extension = compose bc.copy_type_extension ab.copy_type_extension;
|
||||
copy_extension_constructor = compose bc.copy_extension_constructor ab.copy_extension_constructor;
|
||||
copy_class_expr = compose bc.copy_class_expr ab.copy_class_expr;
|
||||
copy_class_field = compose bc.copy_class_field ab.copy_class_field;
|
||||
copy_class_type = compose bc.copy_class_type ab.copy_class_type;
|
||||
copy_class_signature = compose bc.copy_class_signature ab.copy_class_signature;
|
||||
copy_class_type_field = compose bc.copy_class_type_field ab.copy_class_type_field;
|
||||
copy_module_expr = compose bc.copy_module_expr ab.copy_module_expr;
|
||||
copy_module_type = compose bc.copy_module_type ab.copy_module_type;
|
||||
copy_signature_item = compose bc.copy_signature_item ab.copy_signature_item;
|
||||
copy_structure_item = compose bc.copy_structure_item ab.copy_structure_item;
|
||||
(*$*)
|
||||
}
|
||||
|
||||
type _ migration += Migration : 'from ocaml_version * ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from migration
|
||||
|
||||
module type Migrate_module = sig
|
||||
module From : Ast
|
||||
module To : Ast
|
||||
(*$ foreach_type (fun m s ->
|
||||
printf " val copy_%-21s: From.%s.%s -> To.%s.%s\n" s m s m s) *)
|
||||
val copy_structure : From.Parsetree.structure -> To.Parsetree.structure
|
||||
val copy_signature : From.Parsetree.signature -> To.Parsetree.signature
|
||||
val copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase
|
||||
val copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type
|
||||
val copy_expression : From.Parsetree.expression -> To.Parsetree.expression
|
||||
val copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern
|
||||
val copy_case : From.Parsetree.case -> To.Parsetree.case
|
||||
val copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration
|
||||
val copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension
|
||||
val copy_extension_constructor: From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor
|
||||
val copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr
|
||||
val copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field
|
||||
val copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type
|
||||
val copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature
|
||||
val copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field
|
||||
val copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr
|
||||
val copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type
|
||||
val copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item
|
||||
val copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item
|
||||
(*$*)
|
||||
end
|
||||
|
||||
module Migration_functions
|
||||
(A : OCaml_version) (B : OCaml_version)
|
||||
(A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast)
|
||||
=
|
||||
struct
|
||||
let migration_functions : (A.types, B.types) migration_functions =
|
||||
let open A_to_B in
|
||||
{
|
||||
(*$ foreach_type (fun _ s -> printf " copy_%s;\n" s) *)
|
||||
copy_structure;
|
||||
copy_signature;
|
||||
copy_toplevel_phrase;
|
||||
copy_core_type;
|
||||
copy_expression;
|
||||
copy_pattern;
|
||||
copy_case;
|
||||
copy_type_declaration;
|
||||
copy_type_extension;
|
||||
copy_extension_constructor;
|
||||
copy_class_expr;
|
||||
copy_class_field;
|
||||
copy_class_type;
|
||||
copy_class_signature;
|
||||
copy_class_type_field;
|
||||
copy_module_expr;
|
||||
copy_module_type;
|
||||
copy_signature_item;
|
||||
copy_structure_item;
|
||||
(*$*)
|
||||
}
|
||||
end
|
||||
|
||||
module Register_migration (A : OCaml_version) (B : OCaml_version)
|
||||
(A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast)
|
||||
(B_to_A : Migrate_module with module From = B.Ast and module To = A.Ast)
|
||||
=
|
||||
struct
|
||||
let () = (
|
||||
let is_undefined : type a. a migration -> bool = function
|
||||
| Undefined -> true
|
||||
| _ -> false
|
||||
in
|
||||
assert (A.version < B.version);
|
||||
assert (is_undefined A.migration_info.next_version);
|
||||
assert (is_undefined B.migration_info.previous_version);
|
||||
let module A_to_B_fun = Migration_functions(A)(B)(A_to_B) in
|
||||
let module B_to_A_fun = Migration_functions(B)(A)(B_to_A) in
|
||||
A.migration_info.next_version <-
|
||||
Migration ((module A), A_to_B_fun.migration_functions, (module B));
|
||||
B.migration_info.previous_version <-
|
||||
Migration ((module B), B_to_A_fun.migration_functions, (module A));
|
||||
)
|
||||
end
|
||||
|
||||
type 'from immediate_migration =
|
||||
| No_migration : 'from immediate_migration
|
||||
| Immediate_migration
|
||||
: ('from, 'to_) migration_functions * 'to_ ocaml_version
|
||||
-> 'from immediate_migration
|
||||
|
||||
let immediate_migration
|
||||
(*$ foreach_type (fun _ s -> printf " (type %s)\n" s) *)
|
||||
(type structure)
|
||||
(type signature)
|
||||
(type toplevel_phrase)
|
||||
(type core_type)
|
||||
(type expression)
|
||||
(type pattern)
|
||||
(type case)
|
||||
(type type_declaration)
|
||||
(type type_extension)
|
||||
(type extension_constructor)
|
||||
(type class_expr)
|
||||
(type class_field)
|
||||
(type class_type)
|
||||
(type class_signature)
|
||||
(type class_type_field)
|
||||
(type module_expr)
|
||||
(type module_type)
|
||||
(type signature_item)
|
||||
(type structure_item)
|
||||
(*$*)
|
||||
((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;
|
||||
class_expr : class_expr;
|
||||
class_field : class_field;
|
||||
class_type : class_type;
|
||||
class_signature : class_signature;
|
||||
class_type_field : class_type_field;
|
||||
module_expr : module_expr;
|
||||
module_type : module_type;
|
||||
signature_item : signature_item;
|
||||
structure_item : structure_item;
|
||||
(*$*)
|
||||
> ocaml_version)
|
||||
direction
|
||||
=
|
||||
let version = match direction with
|
||||
| `Next -> A.migration_info.next_version
|
||||
| `Previous -> A.migration_info.previous_version
|
||||
in
|
||||
match version with
|
||||
| Undefined -> No_migration
|
||||
| Migration (_, funs, to_) -> Immediate_migration (funs, to_)
|
||||
| _ -> assert false
|
||||
|
||||
let migrate
|
||||
(*$ foreach_type (fun _ s -> printf " (type %s1) (type %s2)\n" s s) *)
|
||||
(type structure1) (type structure2)
|
||||
(type signature1) (type signature2)
|
||||
(type toplevel_phrase1) (type toplevel_phrase2)
|
||||
(type core_type1) (type core_type2)
|
||||
(type expression1) (type expression2)
|
||||
(type pattern1) (type pattern2)
|
||||
(type case1) (type case2)
|
||||
(type type_declaration1) (type type_declaration2)
|
||||
(type type_extension1) (type type_extension2)
|
||||
(type extension_constructor1) (type extension_constructor2)
|
||||
(type class_expr1) (type class_expr2)
|
||||
(type class_field1) (type class_field2)
|
||||
(type class_type1) (type class_type2)
|
||||
(type class_signature1) (type class_signature2)
|
||||
(type class_type_field1) (type class_type_field2)
|
||||
(type module_expr1) (type module_expr2)
|
||||
(type module_type1) (type module_type2)
|
||||
(type signature_item1) (type signature_item2)
|
||||
(type structure_item1) (type structure_item2)
|
||||
(*$*)
|
||||
((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;
|
||||
class_expr : class_expr1;
|
||||
class_field : class_field1;
|
||||
class_type : class_type1;
|
||||
class_signature : class_signature1;
|
||||
class_type_field : class_type_field1;
|
||||
module_expr : module_expr1;
|
||||
module_type : module_type1;
|
||||
signature_item : signature_item1;
|
||||
structure_item : structure_item1;
|
||||
(*$*)
|
||||
> 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;
|
||||
class_expr : class_expr2;
|
||||
class_field : class_field2;
|
||||
class_type : class_type2;
|
||||
class_signature : class_signature2;
|
||||
class_type_field : class_type_field2;
|
||||
module_expr : module_expr2;
|
||||
module_type : module_type2;
|
||||
signature_item : signature_item2;
|
||||
structure_item : structure_item2;
|
||||
(*$*)
|
||||
> ocaml_version)
|
||||
: (A.types, B.types) migration_functions
|
||||
=
|
||||
match A.Version with
|
||||
| B.Version -> migration_identity
|
||||
| _ ->
|
||||
let direction = if A.version < B.version then `Next else `Previous in
|
||||
let rec migrate (m : A.types immediate_migration) : (A.types, B.types) migration_functions =
|
||||
match m with
|
||||
| No_migration -> assert false
|
||||
| Immediate_migration (f, (module To)) ->
|
||||
match To.Version with
|
||||
| B.Version -> f
|
||||
| _ ->
|
||||
match immediate_migration (module To) direction with
|
||||
| No_migration -> assert false
|
||||
| Immediate_migration (g, to2) ->
|
||||
migrate (Immediate_migration (migration_compose f g, to2))
|
||||
in
|
||||
migrate (immediate_migration (module A) direction)
|
||||
|
||||
module Convert (A : OCaml_version) (B : OCaml_version) = struct
|
||||
let {
|
||||
(*$ foreach_type (fun _ s -> printf " copy_%s;\n" s) *)
|
||||
copy_structure;
|
||||
copy_signature;
|
||||
copy_toplevel_phrase;
|
||||
copy_core_type;
|
||||
copy_expression;
|
||||
copy_pattern;
|
||||
copy_case;
|
||||
copy_type_declaration;
|
||||
copy_type_extension;
|
||||
copy_extension_constructor;
|
||||
copy_class_expr;
|
||||
copy_class_field;
|
||||
copy_class_type;
|
||||
copy_class_signature;
|
||||
copy_class_type_field;
|
||||
copy_module_expr;
|
||||
copy_module_type;
|
||||
copy_signature_item;
|
||||
copy_structure_item;
|
||||
(*$*)
|
||||
} : (A.types, B.types) migration_functions =
|
||||
migrate (module A) (module B)
|
||||
end
|
||||
|
||||
(*$ foreach_version (fun n version ->
|
||||
printf "module OCaml_%d = struct\n" n;
|
||||
printf " module Ast = Astlib.Ast_%d\n" n;
|
||||
printf " include Make_witness(Astlib.Ast_%d)\n" n;
|
||||
printf " let version = %d\n" n;
|
||||
printf " let string_version = %S\n" version;
|
||||
printf "end\n";
|
||||
printf "let ocaml_%d : OCaml_%d.types ocaml_version = (module OCaml_%d)\n"
|
||||
n n n;
|
||||
)
|
||||
*)
|
||||
module OCaml_408 = struct
|
||||
module Ast = Astlib.Ast_408
|
||||
include Make_witness(Astlib.Ast_408)
|
||||
let version = 408
|
||||
let string_version = "4.08"
|
||||
end
|
||||
let ocaml_408 : OCaml_408.types ocaml_version = (module OCaml_408)
|
||||
module OCaml_409 = struct
|
||||
module Ast = Astlib.Ast_409
|
||||
include Make_witness(Astlib.Ast_409)
|
||||
let version = 409
|
||||
let string_version = "4.09"
|
||||
end
|
||||
let ocaml_409 : OCaml_409.types ocaml_version = (module OCaml_409)
|
||||
module OCaml_410 = struct
|
||||
module Ast = Astlib.Ast_410
|
||||
include Make_witness(Astlib.Ast_410)
|
||||
let version = 410
|
||||
let string_version = "4.10"
|
||||
end
|
||||
let ocaml_410 : OCaml_410.types ocaml_version = (module OCaml_410)
|
||||
module OCaml_411 = struct
|
||||
module Ast = Astlib.Ast_411
|
||||
include Make_witness(Astlib.Ast_411)
|
||||
let version = 411
|
||||
let string_version = "4.11"
|
||||
end
|
||||
let ocaml_411 : OCaml_411.types ocaml_version = (module OCaml_411)
|
||||
module OCaml_412 = struct
|
||||
module Ast = Astlib.Ast_412
|
||||
include Make_witness(Astlib.Ast_412)
|
||||
let version = 412
|
||||
let string_version = "4.12"
|
||||
end
|
||||
let ocaml_412 : OCaml_412.types ocaml_version = (module OCaml_412)
|
||||
module OCaml_413 = struct
|
||||
module Ast = Astlib.Ast_413
|
||||
include Make_witness(Astlib.Ast_413)
|
||||
let version = 413
|
||||
let string_version = "4.13"
|
||||
end
|
||||
let ocaml_413 : OCaml_413.types ocaml_version = (module OCaml_413)
|
||||
module OCaml_414 = struct
|
||||
module Ast = Astlib.Ast_414
|
||||
include Make_witness(Astlib.Ast_414)
|
||||
let version = 414
|
||||
let string_version = "4.14"
|
||||
end
|
||||
let ocaml_414 : OCaml_414.types ocaml_version = (module OCaml_414)
|
||||
module OCaml_500 = struct
|
||||
module Ast = Astlib.Ast_500
|
||||
include Make_witness(Astlib.Ast_500)
|
||||
let version = 500
|
||||
let string_version = "5.0"
|
||||
end
|
||||
let ocaml_500 : OCaml_500.types ocaml_version = (module OCaml_500)
|
||||
module OCaml_501 = struct
|
||||
module Ast = Astlib.Ast_501
|
||||
include Make_witness(Astlib.Ast_501)
|
||||
let version = 501
|
||||
let string_version = "5.1"
|
||||
end
|
||||
let ocaml_501 : OCaml_501.types ocaml_version = (module OCaml_501)
|
||||
module OCaml_502 = struct
|
||||
module Ast = Astlib.Ast_502
|
||||
include Make_witness(Astlib.Ast_502)
|
||||
let version = 502
|
||||
let string_version = "5.2"
|
||||
end
|
||||
let ocaml_502 : OCaml_502.types ocaml_version = (module OCaml_502)
|
||||
module OCaml_503 = struct
|
||||
module Ast = Astlib.Ast_503
|
||||
include Make_witness(Astlib.Ast_503)
|
||||
let version = 503
|
||||
let string_version = "5.3"
|
||||
end
|
||||
let ocaml_503 : OCaml_503.types ocaml_version = (module OCaml_503)
|
||||
module OCaml_504 = struct
|
||||
module Ast = Astlib.Ast_504
|
||||
include Make_witness(Astlib.Ast_504)
|
||||
let version = 504
|
||||
let string_version = "5.4"
|
||||
end
|
||||
let ocaml_504 : OCaml_504.types ocaml_version = (module OCaml_504)
|
||||
(*$*)
|
||||
|
||||
let all_versions : (module OCaml_version) list = [
|
||||
(*$foreach_version (fun n _ ->
|
||||
printf "(module OCaml_%d : OCaml_version);\n" n)*)
|
||||
(module OCaml_408 : OCaml_version);
|
||||
(module OCaml_409 : OCaml_version);
|
||||
(module OCaml_410 : OCaml_version);
|
||||
(module OCaml_411 : OCaml_version);
|
||||
(module OCaml_412 : OCaml_version);
|
||||
(module OCaml_413 : OCaml_version);
|
||||
(module OCaml_414 : OCaml_version);
|
||||
(module OCaml_500 : OCaml_version);
|
||||
(module OCaml_501 : OCaml_version);
|
||||
(module OCaml_502 : OCaml_version);
|
||||
(module OCaml_503 : OCaml_version);
|
||||
(module OCaml_504 : OCaml_version);
|
||||
(*$*)
|
||||
]
|
||||
|
||||
(*$foreach_version_pair (fun a b ->
|
||||
printf "include Register_migration(OCaml_%d)(OCaml_%d)\n" a b;
|
||||
printf " (Astlib.Migrate_%d_%d)(Astlib.Migrate_%d_%d)\n" a b b a
|
||||
)
|
||||
*)
|
||||
include Register_migration(OCaml_408)(OCaml_409)
|
||||
(Astlib.Migrate_408_409)(Astlib.Migrate_409_408)
|
||||
include Register_migration(OCaml_409)(OCaml_410)
|
||||
(Astlib.Migrate_409_410)(Astlib.Migrate_410_409)
|
||||
include Register_migration(OCaml_410)(OCaml_411)
|
||||
(Astlib.Migrate_410_411)(Astlib.Migrate_411_410)
|
||||
include Register_migration(OCaml_411)(OCaml_412)
|
||||
(Astlib.Migrate_411_412)(Astlib.Migrate_412_411)
|
||||
include Register_migration(OCaml_412)(OCaml_413)
|
||||
(Astlib.Migrate_412_413)(Astlib.Migrate_413_412)
|
||||
include Register_migration(OCaml_413)(OCaml_414)
|
||||
(Astlib.Migrate_413_414)(Astlib.Migrate_414_413)
|
||||
include Register_migration(OCaml_414)(OCaml_500)
|
||||
(Astlib.Migrate_414_500)(Astlib.Migrate_500_414)
|
||||
include Register_migration(OCaml_500)(OCaml_501)
|
||||
(Astlib.Migrate_500_501)(Astlib.Migrate_501_500)
|
||||
include Register_migration(OCaml_501)(OCaml_502)
|
||||
(Astlib.Migrate_501_502)(Astlib.Migrate_502_501)
|
||||
include Register_migration(OCaml_502)(OCaml_503)
|
||||
(Astlib.Migrate_502_503)(Astlib.Migrate_503_502)
|
||||
include Register_migration(OCaml_503)(OCaml_504)
|
||||
(Astlib.Migrate_503_504)(Astlib.Migrate_504_503)
|
||||
(*$*)
|
||||
|
||||
module OCaml_current = OCaml_OCAML_VERSION
|
||||
|
||||
module Find_version = struct
|
||||
type t = Impl of (module OCaml_version) | Intf of (module OCaml_version) | Unknown
|
||||
|
||||
let from_magic magic =
|
||||
let rec loop = function
|
||||
| [] -> Unknown
|
||||
| (module Version : OCaml_version) :: tail ->
|
||||
if Version.Ast.Config.ast_impl_magic_number = magic then
|
||||
Impl (module Version)
|
||||
else if Version.Ast.Config.ast_intf_magic_number = magic then
|
||||
Intf (module Version)
|
||||
else
|
||||
loop tail
|
||||
in
|
||||
(* Traverse the versions from last to first:
|
||||
if the magic numbers aren't unique among versions,
|
||||
we want the latest version with a magic number match.
|
||||
The situation in mind is trunk support. *)
|
||||
let all_versions_top_down = List.rev all_versions in
|
||||
loop all_versions_top_down
|
||||
end
|
||||
199
unikernel/duniverse/ppxlib/ast/versions.mli
Normal file
199
unikernel/duniverse/ppxlib/ast/versions.mli
Normal file
|
|
@ -0,0 +1,199 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml Migrate Parsetree *)
|
||||
(* *)
|
||||
(* Frédéric Bour *)
|
||||
(* Jérémie Dimino, Jane Street Europe *)
|
||||
(* *)
|
||||
(* Copyright 2017 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique (INRIA). *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(*$ open Ast_cinaps_helpers $*)
|
||||
|
||||
(** {1 Abstracting an OCaml frontend} *)
|
||||
|
||||
(** Abstract view of a version of an OCaml Ast *)
|
||||
module type Ast = sig
|
||||
(*$ foreach_module (fun m types ->
|
||||
printf " module %s : sig\n" m;
|
||||
List.iter types ~f:(printf " type %s\n");
|
||||
printf " end\n"
|
||||
)
|
||||
*)
|
||||
module Parsetree : sig
|
||||
type structure
|
||||
type signature
|
||||
type toplevel_phrase
|
||||
type core_type
|
||||
type expression
|
||||
type pattern
|
||||
type case
|
||||
type type_declaration
|
||||
type type_extension
|
||||
type extension_constructor
|
||||
type class_expr
|
||||
type class_field
|
||||
type class_type
|
||||
type class_signature
|
||||
type class_type_field
|
||||
type module_expr
|
||||
type module_type
|
||||
type signature_item
|
||||
type structure_item
|
||||
end
|
||||
(*$*)
|
||||
module Config : sig
|
||||
val ast_impl_magic_number : string
|
||||
val ast_intf_magic_number : string
|
||||
end
|
||||
end
|
||||
|
||||
(* Shortcuts for talking about ast types outside of the module language *)
|
||||
|
||||
type 'a _types = 'a constraint 'a
|
||||
= <
|
||||
(*$ foreach_type (fun _ s -> printf " %-21s : _;\n" s) *)
|
||||
structure : _;
|
||||
signature : _;
|
||||
toplevel_phrase : _;
|
||||
core_type : _;
|
||||
expression : _;
|
||||
pattern : _;
|
||||
case : _;
|
||||
type_declaration : _;
|
||||
type_extension : _;
|
||||
extension_constructor : _;
|
||||
class_expr : _;
|
||||
class_field : _;
|
||||
class_type : _;
|
||||
class_signature : _;
|
||||
class_type_field : _;
|
||||
module_expr : _;
|
||||
module_type : _;
|
||||
signature_item : _;
|
||||
structure_item : _;
|
||||
(*$*)
|
||||
>
|
||||
;;
|
||||
|
||||
(** A version of the OCaml frontend packs the ast with type witnesses
|
||||
so that equalities can be recovered dynamically. *)
|
||||
type _ witnesses (*IF_AT_LEAST 406 = private ..*)
|
||||
|
||||
(** [migration_info] is an opaque type that is used to generate migration
|
||||
functions. *)
|
||||
type _ migration_info
|
||||
|
||||
(** An OCaml frontend versions an Ast, version number and some witnesses for
|
||||
conversion. *)
|
||||
module type OCaml_version = sig
|
||||
|
||||
(** Ast definition for this version *)
|
||||
module Ast : Ast
|
||||
|
||||
(* Version number as an integer, 402, 403, 404, ... *)
|
||||
val version : int
|
||||
|
||||
(* Version number as a user-friendly string *)
|
||||
val string_version : string (* 4.02, 4.03, 4.04, ... *)
|
||||
|
||||
(** Shortcut for talking about Ast types *)
|
||||
type types = <
|
||||
(*$ foreach_type (fun m s -> printf " %-21s : Ast.%s.%s;\n" s m s) *)
|
||||
structure : Ast.Parsetree.structure;
|
||||
signature : Ast.Parsetree.signature;
|
||||
toplevel_phrase : Ast.Parsetree.toplevel_phrase;
|
||||
core_type : Ast.Parsetree.core_type;
|
||||
expression : Ast.Parsetree.expression;
|
||||
pattern : Ast.Parsetree.pattern;
|
||||
case : Ast.Parsetree.case;
|
||||
type_declaration : Ast.Parsetree.type_declaration;
|
||||
type_extension : Ast.Parsetree.type_extension;
|
||||
extension_constructor : Ast.Parsetree.extension_constructor;
|
||||
class_expr : Ast.Parsetree.class_expr;
|
||||
class_field : Ast.Parsetree.class_field;
|
||||
class_type : Ast.Parsetree.class_type;
|
||||
class_signature : Ast.Parsetree.class_signature;
|
||||
class_type_field : Ast.Parsetree.class_type_field;
|
||||
module_expr : Ast.Parsetree.module_expr;
|
||||
module_type : Ast.Parsetree.module_type;
|
||||
signature_item : Ast.Parsetree.signature_item;
|
||||
structure_item : Ast.Parsetree.structure_item;
|
||||
(*$*)
|
||||
> _types
|
||||
|
||||
(** A construtor for recovering type equalities between two arbitrary
|
||||
versions. *)
|
||||
type _ witnesses += Version : types witnesses
|
||||
|
||||
(** Information used to derive migration functions, see below *)
|
||||
val migration_info : types migration_info
|
||||
end
|
||||
|
||||
(** {1 Concrete frontend instances} *)
|
||||
|
||||
(*$foreach_version (fun n _ ->
|
||||
printf "module OCaml_%d : OCaml_version with module Ast = Astlib.Ast_%d\n"
|
||||
n n
|
||||
)*)
|
||||
module OCaml_408 : OCaml_version with module Ast = Astlib.Ast_408
|
||||
module OCaml_409 : OCaml_version with module Ast = Astlib.Ast_409
|
||||
module OCaml_410 : OCaml_version with module Ast = Astlib.Ast_410
|
||||
module OCaml_411 : OCaml_version with module Ast = Astlib.Ast_411
|
||||
module OCaml_412 : OCaml_version with module Ast = Astlib.Ast_412
|
||||
module OCaml_413 : OCaml_version with module Ast = Astlib.Ast_413
|
||||
module OCaml_414 : OCaml_version with module Ast = Astlib.Ast_414
|
||||
module OCaml_500 : OCaml_version with module Ast = Astlib.Ast_500
|
||||
module OCaml_501 : OCaml_version with module Ast = Astlib.Ast_501
|
||||
module OCaml_502 : OCaml_version with module Ast = Astlib.Ast_502
|
||||
module OCaml_503 : OCaml_version with module Ast = Astlib.Ast_503
|
||||
module OCaml_504 : OCaml_version with module Ast = Astlib.Ast_504
|
||||
(*$*)
|
||||
|
||||
(* An alias to the current compiler version *)
|
||||
module OCaml_current = OCaml_OCAML_VERSION
|
||||
|
||||
(* The list of all supported versions *)
|
||||
val all_versions : (module OCaml_version) list
|
||||
|
||||
(** {1 Convenience definitions} *)
|
||||
|
||||
(** Module level migration *)
|
||||
module Convert (A : OCaml_version) (B : OCaml_version) : sig
|
||||
(*$ foreach_type (fun m s ->
|
||||
let fq = sprintf "%s.%s" m s in
|
||||
printf " val copy_%-21s : A.Ast.%-31s -> B.Ast.%s\n" s fq fq) *)
|
||||
val copy_structure : A.Ast.Parsetree.structure -> B.Ast.Parsetree.structure
|
||||
val copy_signature : A.Ast.Parsetree.signature -> B.Ast.Parsetree.signature
|
||||
val copy_toplevel_phrase : A.Ast.Parsetree.toplevel_phrase -> B.Ast.Parsetree.toplevel_phrase
|
||||
val copy_core_type : A.Ast.Parsetree.core_type -> B.Ast.Parsetree.core_type
|
||||
val copy_expression : A.Ast.Parsetree.expression -> B.Ast.Parsetree.expression
|
||||
val copy_pattern : A.Ast.Parsetree.pattern -> B.Ast.Parsetree.pattern
|
||||
val copy_case : A.Ast.Parsetree.case -> B.Ast.Parsetree.case
|
||||
val copy_type_declaration : A.Ast.Parsetree.type_declaration -> B.Ast.Parsetree.type_declaration
|
||||
val copy_type_extension : A.Ast.Parsetree.type_extension -> B.Ast.Parsetree.type_extension
|
||||
val copy_extension_constructor : A.Ast.Parsetree.extension_constructor -> B.Ast.Parsetree.extension_constructor
|
||||
val copy_class_expr : A.Ast.Parsetree.class_expr -> B.Ast.Parsetree.class_expr
|
||||
val copy_class_field : A.Ast.Parsetree.class_field -> B.Ast.Parsetree.class_field
|
||||
val copy_class_type : A.Ast.Parsetree.class_type -> B.Ast.Parsetree.class_type
|
||||
val copy_class_signature : A.Ast.Parsetree.class_signature -> B.Ast.Parsetree.class_signature
|
||||
val copy_class_type_field : A.Ast.Parsetree.class_type_field -> B.Ast.Parsetree.class_type_field
|
||||
val copy_module_expr : A.Ast.Parsetree.module_expr -> B.Ast.Parsetree.module_expr
|
||||
val copy_module_type : A.Ast.Parsetree.module_type -> B.Ast.Parsetree.module_type
|
||||
val copy_signature_item : A.Ast.Parsetree.signature_item -> B.Ast.Parsetree.signature_item
|
||||
val copy_structure_item : A.Ast.Parsetree.structure_item -> B.Ast.Parsetree.structure_item
|
||||
(*$*)
|
||||
end
|
||||
|
||||
(** Helper to find the frontend corresponding to a given magic number *)
|
||||
module Find_version : sig
|
||||
type t = Impl of (module OCaml_version) | Intf of (module OCaml_version) | Unknown
|
||||
|
||||
val from_magic : string -> t
|
||||
end
|
||||
6
unikernel/duniverse/ppxlib/ast/warn.ml
Normal file
6
unikernel/duniverse/ppxlib/ast/warn.ml
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
open! Import
|
||||
|
||||
let default_print_warning _loc = ()
|
||||
let about_ite_branch_ref = ref default_print_warning
|
||||
let care_about_ite_branch = ref false
|
||||
let about_ite_branch loc = !about_ite_branch_ref loc
|
||||
10
unikernel/duniverse/ppxlib/ast/warn.mli
Normal file
10
unikernel/duniverse/ppxlib/ast/warn.mli
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
open Import
|
||||
|
||||
val care_about_ite_branch : bool ref
|
||||
(** Ignored -- kept for compatibility. *)
|
||||
|
||||
val about_ite_branch_ref : (Location.t -> unit) ref
|
||||
(** Ignored -- kept for compatibility. *)
|
||||
|
||||
val about_ite_branch : Location.t -> unit
|
||||
(** Ignored -- kept for compatibility. *)
|
||||
1027
unikernel/duniverse/ppxlib/astlib/ast_408.ml
Normal file
1027
unikernel/duniverse/ppxlib/astlib/ast_408.ml
Normal file
File diff suppressed because it is too large
Load diff
1016
unikernel/duniverse/ppxlib/astlib/ast_409.ml
Normal file
1016
unikernel/duniverse/ppxlib/astlib/ast_409.ml
Normal file
File diff suppressed because it is too large
Load diff
1017
unikernel/duniverse/ppxlib/astlib/ast_410.ml
Normal file
1017
unikernel/duniverse/ppxlib/astlib/ast_410.ml
Normal file
File diff suppressed because it is too large
Load diff
1017
unikernel/duniverse/ppxlib/astlib/ast_411.ml
Normal file
1017
unikernel/duniverse/ppxlib/astlib/ast_411.ml
Normal file
File diff suppressed because it is too large
Load diff
1020
unikernel/duniverse/ppxlib/astlib/ast_412.ml
Normal file
1020
unikernel/duniverse/ppxlib/astlib/ast_412.ml
Normal file
File diff suppressed because it is too large
Load diff
1027
unikernel/duniverse/ppxlib/astlib/ast_413.ml
Normal file
1027
unikernel/duniverse/ppxlib/astlib/ast_413.ml
Normal file
File diff suppressed because it is too large
Load diff
1099
unikernel/duniverse/ppxlib/astlib/ast_414.ml
Normal file
1099
unikernel/duniverse/ppxlib/astlib/ast_414.ml
Normal file
File diff suppressed because it is too large
Load diff
14
unikernel/duniverse/ppxlib/astlib/ast_500.ml
Normal file
14
unikernel/duniverse/ppxlib/astlib/ast_500.ml
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(* The only difference between 4.14 and 5.0 from a Parsetree point of view are the magic numbers *)
|
||||
|
||||
module Asttypes = struct
|
||||
include Ast_414.Asttypes
|
||||
end
|
||||
|
||||
module Parsetree = struct
|
||||
include Ast_414.Parsetree
|
||||
end
|
||||
|
||||
module Config = struct
|
||||
let ast_impl_magic_number = "Caml1999M032"
|
||||
let ast_intf_magic_number = "Caml1999N032"
|
||||
end
|
||||
1090
unikernel/duniverse/ppxlib/astlib/ast_501.ml
Normal file
1090
unikernel/duniverse/ppxlib/astlib/ast_501.ml
Normal file
File diff suppressed because it is too large
Load diff
1140
unikernel/duniverse/ppxlib/astlib/ast_502.ml
Normal file
1140
unikernel/duniverse/ppxlib/astlib/ast_502.ml
Normal file
File diff suppressed because it is too large
Load diff
1159
unikernel/duniverse/ppxlib/astlib/ast_503.ml
Normal file
1159
unikernel/duniverse/ppxlib/astlib/ast_503.ml
Normal file
File diff suppressed because it is too large
Load diff
1185
unikernel/duniverse/ppxlib/astlib/ast_504.ml
Normal file
1185
unikernel/duniverse/ppxlib/astlib/ast_504.ml
Normal file
File diff suppressed because it is too large
Load diff
1
unikernel/duniverse/ppxlib/astlib/ast_metadata.ml
Normal file
1
unikernel/duniverse/ppxlib/astlib/ast_metadata.ml
Normal file
|
|
@ -0,0 +1 @@
|
|||
include Ocaml_common.Ast_mapper
|
||||
40
unikernel/duniverse/ppxlib/astlib/ast_metadata.mli
Normal file
40
unikernel/duniverse/ppxlib/astlib/ast_metadata.mli
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
(** Meta data related interface for a ppx rewriter *)
|
||||
|
||||
val add_ppx_context_str :
|
||||
tool_name:string ->
|
||||
Parsetree.structure_item list ->
|
||||
Parsetree.structure_item list
|
||||
(** 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 drop_ppx_context_str :
|
||||
restore:bool -> Parsetree.structure_item list -> Parsetree.structure_item list
|
||||
(** Drop the ocaml.ppx.context attribute from a structure. If [restore] is true,
|
||||
also restore the associated data in the current process. *)
|
||||
|
||||
val add_ppx_context_sig :
|
||||
tool_name:string ->
|
||||
Parsetree.signature_item list ->
|
||||
Parsetree.signature_item list
|
||||
(** Same as [add_ppx_context_str], but for signatures. *)
|
||||
|
||||
val drop_ppx_context_sig :
|
||||
restore:bool -> Parsetree.signature_item list -> Parsetree.signature_item list
|
||||
(** Same as [drop_ppx_context_str], but for signatures. *)
|
||||
|
||||
val tool_name : unit -> string
|
||||
(** Can be used within a ppx preprocessor to know which tool is calling it
|
||||
["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], ["ocaml"], ... *)
|
||||
|
||||
(** {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
|
||||
(* [set_cookie name expr] registers a cookie with name [name] and value [expr]. *)
|
||||
|
||||
val get_cookie : string -> Parsetree.expression option
|
||||
(* Returns the registered cookie with name [name], if any. *)
|
||||
97
unikernel/duniverse/ppxlib/astlib/astlib.ml
Normal file
97
unikernel/duniverse/ppxlib/astlib/astlib.ml
Normal file
|
|
@ -0,0 +1,97 @@
|
|||
(**************************************************************************)
|
||||
(* *)
|
||||
(* OCaml Migrate Parsetree *)
|
||||
(* *)
|
||||
(* Frédéric Bour *)
|
||||
(* Jérémie Dimino, Jane Street Europe *)
|
||||
(* *)
|
||||
(* Copyright 2017 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique (INRIA). *)
|
||||
(* *)
|
||||
(* All rights reserved. This file is distributed under the terms of *)
|
||||
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||
(* special exception on linking described in the file LICENSE. *)
|
||||
(* *)
|
||||
(**************************************************************************)
|
||||
|
||||
(*$ open Astlib_cinaps_helpers
|
||||
open Printf $*)
|
||||
|
||||
(* Copy of OCaml parsetrees *)
|
||||
(*$
|
||||
foreach_version (fun suffix _ ->
|
||||
printf "module Ast_%s = Ast_%s\n" suffix suffix)
|
||||
*)
|
||||
module Ast_408 = Ast_408
|
||||
module Ast_409 = Ast_409
|
||||
module Ast_410 = Ast_410
|
||||
module Ast_411 = Ast_411
|
||||
module Ast_412 = Ast_412
|
||||
module Ast_413 = Ast_413
|
||||
module Ast_414 = Ast_414
|
||||
module Ast_500 = Ast_500
|
||||
module Ast_501 = Ast_501
|
||||
module Ast_502 = Ast_502
|
||||
module Ast_503 = Ast_503
|
||||
module Ast_504 = Ast_504
|
||||
(*$*)
|
||||
|
||||
(* Manual migration between versions *)
|
||||
(*$
|
||||
foreach_version_pair (fun x y ->
|
||||
printf "module Migrate_%s_%s = Migrate_%s_%s\n" x y x y;
|
||||
printf "module Migrate_%s_%s = Migrate_%s_%s\n" y x y x)
|
||||
*)
|
||||
module Migrate_408_409 = Migrate_408_409
|
||||
module Migrate_409_408 = Migrate_409_408
|
||||
module Migrate_409_410 = Migrate_409_410
|
||||
module Migrate_410_409 = Migrate_410_409
|
||||
module Migrate_410_411 = Migrate_410_411
|
||||
module Migrate_411_410 = Migrate_411_410
|
||||
module Migrate_411_412 = Migrate_411_412
|
||||
module Migrate_412_411 = Migrate_412_411
|
||||
module Migrate_412_413 = Migrate_412_413
|
||||
module Migrate_413_412 = Migrate_413_412
|
||||
module Migrate_413_414 = Migrate_413_414
|
||||
module Migrate_414_413 = Migrate_414_413
|
||||
module Migrate_414_500 = Migrate_414_500
|
||||
module Migrate_500_414 = Migrate_500_414
|
||||
module Migrate_500_501 = Migrate_500_501
|
||||
module Migrate_501_500 = Migrate_501_500
|
||||
module Migrate_501_502 = Migrate_501_502
|
||||
module Migrate_502_501 = Migrate_502_501
|
||||
module Migrate_502_503 = Migrate_502_503
|
||||
module Migrate_503_502 = Migrate_503_502
|
||||
module Migrate_503_504 = Migrate_503_504
|
||||
module Migrate_504_503 = Migrate_504_503
|
||||
(*$*)
|
||||
|
||||
(* Compiler modules *)
|
||||
module Ast_metadata = Ast_metadata
|
||||
module Config = Config
|
||||
module Keyword = Keyword
|
||||
module Location = Location
|
||||
module Longident = Longident
|
||||
module Parse = Parse
|
||||
module Pprintast = Pprintast
|
||||
module Compiler_pprintast = struct
|
||||
include Ocaml_common.Pprintast
|
||||
|
||||
let structure_item fmt t = structure fmt [t]
|
||||
let signature_item fmt t = signature fmt [t]
|
||||
|
||||
exception Unavailable
|
||||
|
||||
(*IF_NOT_AT_LEAST 414 let class_field _fmt _t = raise Unavailable *)
|
||||
(*IF_NOT_AT_LEAST 414 let class_type_field _fmt _t = raise Unavailable *)
|
||||
(*IF_NOT_AT_LEAST 414 let class_expr _fmt _t = raise Unavailable *)
|
||||
(*IF_NOT_AT_LEAST 414 let class_type _fmt _t = raise Unavailable *)
|
||||
(*IF_NOT_AT_LEAST 414 let module_type _fmt _t = raise Unavailable *)
|
||||
(*IF_NOT_AT_LEAST 414 let module_expr _fmt _t = raise Unavailable *)
|
||||
end
|
||||
|
||||
module Clean = Clean
|
||||
|
||||
let init_error_reporting_style_using_env_vars () =
|
||||
Ocaml_common.Compmisc.read_clflags_from_env ()
|
||||
(** Adjust the reporting style of error messages to the environment variables OCAML_COLOR and OCAML_ERROR_STYLE. *)
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
(* -*- tuareg -*- *)
|
||||
|
||||
open StdLabels
|
||||
open Printf
|
||||
|
||||
let nl () = printf "\n"
|
||||
|
||||
let supported_versions =
|
||||
[
|
||||
("408", "4.08");
|
||||
("409", "4.09");
|
||||
("410", "4.10");
|
||||
("411", "4.11");
|
||||
("412", "4.12");
|
||||
("413", "4.13");
|
||||
("414", "4.14");
|
||||
("500", "5.00");
|
||||
("501", "5.01");
|
||||
("502", "5.02");
|
||||
("503", "5.03");
|
||||
("504", "5.04");
|
||||
]
|
||||
|
||||
let foreach_version f =
|
||||
nl ();
|
||||
List.iter supported_versions ~f:(fun (suffix, version) -> f suffix version)
|
||||
|
||||
let foreach_version_pair f =
|
||||
nl ();
|
||||
let rec aux = function
|
||||
| (x, _) :: ((y, _) :: _ as tail) ->
|
||||
f x y;
|
||||
aux tail
|
||||
| [ _ ] | [] -> ()
|
||||
in
|
||||
aux supported_versions
|
||||
|
||||
(* Just for 4.14 <-> 5.00, mostly used by [ast_cinaps_helpers] *)
|
||||
|
||||
let qualified_types =
|
||||
[
|
||||
( "Parsetree",
|
||||
[
|
||||
"structure";
|
||||
"signature";
|
||||
"toplevel_phrase";
|
||||
"core_type";
|
||||
"expression";
|
||||
"pattern";
|
||||
"case";
|
||||
"type_declaration";
|
||||
"type_extension";
|
||||
"extension_constructor";
|
||||
"class_expr";
|
||||
"class_field";
|
||||
"class_type";
|
||||
"class_signature";
|
||||
"class_type_field";
|
||||
"module_expr";
|
||||
"module_type";
|
||||
"signature_item";
|
||||
"structure_item";
|
||||
] );
|
||||
]
|
||||
|
||||
let foreach_module f =
|
||||
nl ();
|
||||
List.iter qualified_types ~f:(fun (m, types) -> f m types)
|
||||
|
||||
let foreach_type f = foreach_module (fun m -> List.iter ~f:(f m))
|
||||
2
unikernel/duniverse/ppxlib/astlib/cinaps/dune
Normal file
2
unikernel/duniverse/ppxlib/astlib/cinaps/dune
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(library
|
||||
(name astlib_cinaps_helpers))
|
||||
19
unikernel/duniverse/ppxlib/astlib/clean.ml
Normal file
19
unikernel/duniverse/ppxlib/astlib/clean.ml
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
let remove_ppxlib_migration_from_ast_mapper =
|
||||
let should_keep_attribute (a : Parsetree.attribute) =
|
||||
not (Stdlib0.String.is_prefix ~prefix:"ppxlib.migration" a.attr_name.txt)
|
||||
in
|
||||
let mapper =
|
||||
{
|
||||
Ast_mapper.default_mapper with
|
||||
attributes = (fun _ -> List.filter should_keep_attribute);
|
||||
}
|
||||
in
|
||||
mapper
|
||||
|
||||
let remove_migration_attributes_from_str =
|
||||
remove_ppxlib_migration_from_ast_mapper.structure
|
||||
remove_ppxlib_migration_from_ast_mapper
|
||||
|
||||
let remove_migration_attributes_from_sig =
|
||||
remove_ppxlib_migration_from_ast_mapper.signature
|
||||
remove_ppxlib_migration_from_ast_mapper
|
||||
10
unikernel/duniverse/ppxlib/astlib/clean.mli
Normal file
10
unikernel/duniverse/ppxlib/astlib/clean.mli
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
val remove_migration_attributes_from_str :
|
||||
Parsetree.structure -> Parsetree.structure
|
||||
(** [remove_migration_attributes_from_str str] removes any left-over metadata
|
||||
that be in the parsetree after a migration. Most users will not have to
|
||||
worry about applying this function.*)
|
||||
|
||||
val remove_migration_attributes_from_sig :
|
||||
Parsetree.signature -> Parsetree.signature
|
||||
(** The same as {! remove_migration_attributes_from_str} except for
|
||||
{! Parsetree.signature}. *)
|
||||
1
unikernel/duniverse/ppxlib/astlib/config.ml
Normal file
1
unikernel/duniverse/ppxlib/astlib/config.ml
Normal file
|
|
@ -0,0 +1 @@
|
|||
include Ocaml_common.Config
|
||||
7
unikernel/duniverse/ppxlib/astlib/config.mli
Normal file
7
unikernel/duniverse/ppxlib/astlib/config.mli
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(** Magic numbers *)
|
||||
|
||||
val ast_intf_magic_number : string
|
||||
(** Magic number for file holding an interface syntax tree *)
|
||||
|
||||
val ast_impl_magic_number : string
|
||||
(** Magic number for file holding an implementation syntax tree *)
|
||||
29
unikernel/duniverse/ppxlib/astlib/config/gen.ml
Normal file
29
unikernel/duniverse/ppxlib/astlib/config/gen.ml
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
let write fn s =
|
||||
let oc = open_out fn in
|
||||
output_string oc s;
|
||||
close_out oc
|
||||
|
||||
let () =
|
||||
let ocaml_version_str = Sys.argv.(1) in
|
||||
let ocaml_version =
|
||||
Scanf.sscanf ocaml_version_str "%u.%u" (fun a b -> (a, b))
|
||||
in
|
||||
write "ast-version"
|
||||
(match ocaml_version with
|
||||
| 4, 08 -> "408"
|
||||
| 4, 09 -> "409"
|
||||
| 4, 10 -> "410"
|
||||
| 4, 11 -> "411"
|
||||
| 4, 12 -> "412"
|
||||
| 4, 13 -> "413"
|
||||
| 4, 14 -> "414"
|
||||
| 5, 0 ->
|
||||
"414"
|
||||
(* Ast_500 aliases Ast_414, since the AST hasn't changed between those two *)
|
||||
| 5, 1 -> "501"
|
||||
| 5, 2 -> "502"
|
||||
| 5, 3 -> "503"
|
||||
| 5, 4 -> "504"
|
||||
| _ ->
|
||||
Printf.eprintf "Unknown OCaml version %s\n" ocaml_version_str;
|
||||
exit 1)
|
||||
17
unikernel/duniverse/ppxlib/astlib/dune
Normal file
17
unikernel/duniverse/ppxlib/astlib/dune
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
(library
|
||||
(name astlib)
|
||||
(public_name ppxlib.astlib)
|
||||
(libraries ocaml-compiler-libs.common compiler-libs.common)
|
||||
(flags -w -9)
|
||||
(preprocess
|
||||
(action
|
||||
(run %{exe:pp/pp.exe} %{read:ast-version} %{input-file}))))
|
||||
|
||||
(rule
|
||||
(targets ast-version)
|
||||
(action
|
||||
(run %{ocaml} %{dep:config/gen.ml} %{ocaml_version})))
|
||||
|
||||
(cinaps
|
||||
(files *.ml *.mli)
|
||||
(libraries astlib_cinaps_helpers))
|
||||
99
unikernel/duniverse/ppxlib/astlib/keyword.ml
Normal file
99
unikernel/duniverse/ppxlib/astlib/keyword.ml
Normal file
|
|
@ -0,0 +1,99 @@
|
|||
let is_keyword = function
|
||||
| "and" -> true
|
||||
| "as" -> true
|
||||
| "assert" -> true
|
||||
| "begin" -> true
|
||||
| "class" -> true
|
||||
| "constraint" -> true
|
||||
| "do" -> true
|
||||
| "done" -> true
|
||||
| "downto" -> true
|
||||
| "else" -> true
|
||||
| "end" -> true
|
||||
| "exception" -> true
|
||||
| "external" -> true
|
||||
| "false" -> true
|
||||
| "for" -> true
|
||||
| "fun" -> true
|
||||
| "function" -> true
|
||||
| "functor" -> true
|
||||
| "if" -> true
|
||||
| "in" -> true
|
||||
| "include" -> true
|
||||
| "inherit" -> true
|
||||
| "initializer" -> true
|
||||
| "lazy" -> true
|
||||
| "let" -> true
|
||||
| "match" -> true
|
||||
| "method" -> true
|
||||
| "module" -> true
|
||||
| "mutable" -> true
|
||||
| "new" -> true
|
||||
| "nonrec" -> true
|
||||
| "object" -> true
|
||||
| "of" -> true
|
||||
| "open" -> true
|
||||
| "or" -> true
|
||||
(* | "parser" -> true *)
|
||||
| "private" -> true
|
||||
| "rec" -> true
|
||||
| "sig" -> true
|
||||
| "struct" -> true
|
||||
| "then" -> true
|
||||
| "to" -> true
|
||||
| "true" -> true
|
||||
| "try" -> true
|
||||
| "type" -> true
|
||||
| "val" -> true
|
||||
| "virtual" -> true
|
||||
| "when" -> true
|
||||
| "while" -> true
|
||||
| "with" -> true
|
||||
| "lor" -> true
|
||||
| "lxor" -> true
|
||||
| "mod" -> true
|
||||
| "land" -> true
|
||||
| "lsl" -> true
|
||||
| "lsr" -> true
|
||||
| "asr" -> true
|
||||
| _ -> false
|
||||
|
||||
let apply_keyword_edition ~cli () =
|
||||
let from_ocaml_param =
|
||||
match Sys.getenv "OCAMLPARAM" with
|
||||
| s -> (
|
||||
let items =
|
||||
if String.equal s "" then []
|
||||
else
|
||||
(* cf. Compenv.parse_args *)
|
||||
match s.[0] with
|
||||
| (':' | '|' | ';' | ' ' | ',') as c ->
|
||||
List.tl (String.split_on_char c s)
|
||||
| _ -> String.split_on_char ',' s
|
||||
in
|
||||
let fold_settings (acc, after_cli) item =
|
||||
match (item, acc) with
|
||||
| "_", None -> (acc, true)
|
||||
| _ ->
|
||||
let len = String.length item in
|
||||
if len >= 9 && String.sub item 0 9 = "keywords=" then
|
||||
(Some (String.sub item 9 (len - 9)), after_cli)
|
||||
else (acc, after_cli)
|
||||
in
|
||||
let from_ocaml_param, after_cli =
|
||||
List.fold_left fold_settings (None, false) items
|
||||
in
|
||||
match from_ocaml_param with
|
||||
| None -> None
|
||||
| Some s -> Some (s, after_cli))
|
||||
| exception Not_found -> None
|
||||
in
|
||||
let keyword_edition =
|
||||
match (cli, from_ocaml_param) with
|
||||
| None, None -> None
|
||||
| None, Some (s, _) | Some _, Some (s, true) -> Some s
|
||||
| _ -> cli
|
||||
in
|
||||
(*IF_AT_LEAST 503 let () = if Option.is_some keyword_edition then Clflags.keyword_edition := keyword_edition in*)
|
||||
(*IF_NOT_AT_LEAST 503 let () = ignore keyword_edition in*)
|
||||
()
|
||||
7
unikernel/duniverse/ppxlib/astlib/keyword.mli
Normal file
7
unikernel/duniverse/ppxlib/astlib/keyword.mli
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
val is_keyword : string -> bool
|
||||
(** Check if a string is an OCaml keyword. *)
|
||||
|
||||
val apply_keyword_edition : cli:string option -> unit -> unit
|
||||
(** Processes any keywords= sections from the OCAMLPARAM environment variable
|
||||
and CLI option and initialises the compiler's lexer with the correct keyword
|
||||
set. *)
|
||||
84
unikernel/duniverse/ppxlib/astlib/location.ml
Normal file
84
unikernel/duniverse/ppxlib/astlib/location.ml
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
include Ocaml_common.Location
|
||||
|
||||
let set_input_name name = input_name := name
|
||||
let set_input_lexbuf lexbuf_opt = input_lexbuf := lexbuf_opt
|
||||
|
||||
module Error = struct
|
||||
[@@@warning "-37"]
|
||||
|
||||
type old_t (*IF_NOT_AT_LEAST 408 = Ocaml_common.Location.error *) = {
|
||||
loc: t;
|
||||
msg: string;
|
||||
sub: old_t list;
|
||||
if_highlight: string;
|
||||
}
|
||||
|
||||
type location_report_kind = Ocaml_common.Location.report_kind =
|
||||
| Report_error
|
||||
| Report_warning of string
|
||||
| Report_warning_as_error of string
|
||||
| Report_alert of string
|
||||
| Report_alert_as_error of string
|
||||
|
||||
type location_msg =
|
||||
(*IF_AT_LEAST 503 Ocaml_common.Format_doc.t loc *)
|
||||
(*IF_NOT_AT_LEAST 503 (Format.formatter -> unit) loc *)
|
||||
|
||||
type location_report = Ocaml_common.Location.report = {
|
||||
kind : location_report_kind;
|
||||
main : location_msg;
|
||||
sub : location_msg list;
|
||||
(*IF_AT_LEAST 503 footnote: Format_doc.t option; *)
|
||||
}
|
||||
|
||||
type t = Ocaml_common.Location.error
|
||||
|
||||
let is_well_formed error =
|
||||
match error with
|
||||
| { kind = Report_error; _ } -> true
|
||||
| _ -> false
|
||||
|
||||
let string_of_location_msg (msg : location_msg) =
|
||||
(*IF_AT_LEAST 503 Format.asprintf "%a" Ocaml_common.Format_doc.Doc.format msg.txt *)
|
||||
(*IF_NOT_AT_LEAST 503 Format.asprintf "%t" msg.txt *)
|
||||
|
||||
let main_msg { main; _ } =
|
||||
{ txt = string_of_location_msg main; loc = main.loc }
|
||||
|
||||
let sub_msgs { sub; _ } =
|
||||
List.map
|
||||
(fun err -> { txt = string_of_location_msg err; loc = err.loc })
|
||||
sub
|
||||
|
||||
let of_exn exn =
|
||||
match error_of_exn exn with
|
||||
| Some (`Ok e) -> Some e
|
||||
| None | Some `Already_displayed -> None
|
||||
|
||||
let set_main_msg error msg =
|
||||
(*IF_AT_LEAST 503 let txt = Ocaml_common.Format_doc.Doc.msg "%s" msg in *)
|
||||
(*IF_NOT_AT_LEAST 503 let txt ppf = Format.pp_print_string ppf msg in *)
|
||||
let main = { error.main with txt } in
|
||||
{ error with main }
|
||||
|
||||
let make ~sub { loc; txt } =
|
||||
(*IF_AT_LEAST 503 let mk_txt x = Ocaml_common.Format_doc.Doc.msg "%s" x in *)
|
||||
(*IF_NOT_AT_LEAST 503 let mk_txt x ppf = Format.pp_print_string ppf x in *)
|
||||
let mk loc x = { loc; txt = mk_txt x } in
|
||||
{
|
||||
kind = Report_error;
|
||||
main = mk loc txt;
|
||||
sub = List.map (fun { loc; txt } -> mk loc txt) sub;
|
||||
(*IF_AT_LEAST 503 footnote = None; *)
|
||||
}
|
||||
|
||||
let set_main_loc error loc =
|
||||
let main = { error.main with loc } in
|
||||
{ error with main }
|
||||
end
|
||||
|
||||
let raise_errorf ?loc msg =
|
||||
(* Update from [kasprintf] to [kdprintf] + [Format_doc.deprecated_printer]
|
||||
when ocaml lower bound is 4.08+ *)
|
||||
(*IF_AT_LEAST 503 Format.kdprintf (fun pr -> raise_errorf ?loc "%t" (Format_doc.deprecated_printer pr)) msg *)
|
||||
(*IF_NOT_AT_LEAST 503 raise_errorf ?loc msg *)
|
||||
71
unikernel/duniverse/ppxlib/astlib/location.mli
Normal file
71
unikernel/duniverse/ppxlib/astlib/location.mli
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
(** Source code locations (ranges of positions), used in parsetrees *)
|
||||
|
||||
type t = Ocaml_common.Location.t = {
|
||||
loc_start : Lexing.position;
|
||||
loc_end : Lexing.position;
|
||||
loc_ghost : bool;
|
||||
}
|
||||
(** The location type *)
|
||||
|
||||
type 'a loc = 'a Ocaml_common.Location.loc = { txt : 'a; loc : t }
|
||||
(** A located type *)
|
||||
|
||||
module Error : sig
|
||||
type location
|
||||
|
||||
type t
|
||||
(** The location error type. It contains a located main message and a
|
||||
(possibly empty) list of located submessages. *)
|
||||
|
||||
val is_well_formed : t -> bool
|
||||
(** A location error constructed via [make] is always well-formed. A malformed
|
||||
location error is a value of type [location_report] on compilers >= 4.08,
|
||||
whose [kind] is different from [Report_error]. Notice that
|
||||
[location_report] does not explicitly form part of Astlib. *)
|
||||
|
||||
val main_msg : t -> string loc
|
||||
(** Get the located error main message. *)
|
||||
|
||||
val sub_msgs : t -> string loc list
|
||||
(** Get the located error sub-messages. *)
|
||||
|
||||
val set_main_msg : t -> string -> t
|
||||
(** Set the text of the error's main message. The location stays as is. *)
|
||||
|
||||
val set_main_loc : t -> location -> t
|
||||
(** Set the location of the error's main message. The text satys as is. *)
|
||||
|
||||
val make : sub:string loc list -> string loc -> t
|
||||
(** Construct a location error. *)
|
||||
|
||||
val of_exn : exn -> t option
|
||||
(** Turn an exception into a location error, if possible. *)
|
||||
end
|
||||
with type location := t
|
||||
|
||||
val set_input_name : string -> unit
|
||||
(** Set the name of the input source, e.g. the file name. *)
|
||||
|
||||
val set_input_lexbuf : Lexing.lexbuf option -> unit
|
||||
(** Set the name of the input source, e.g. the file name. *)
|
||||
|
||||
val none : t
|
||||
(** An arbitrary value of type [t]; describes an empty ghost range. *)
|
||||
|
||||
(** {1 Automatically reporting errors for raised exceptions} *)
|
||||
|
||||
val register_error_of_exn : (exn -> Error.t option) -> unit
|
||||
(** Each compiler module which defines a custom type of exception which can
|
||||
surface as a user-visible error should register a "printer" for this
|
||||
exception using [register_error_of_exn]. The result of the printer is an
|
||||
[error] value containing a location, a message, and optionally sub-messages
|
||||
(each of them being located as well). *)
|
||||
|
||||
exception Error of Error.t
|
||||
(** Located exception. *)
|
||||
|
||||
val raise_errorf : ?loc:t -> ('a, Format.formatter, unit, 'b) format4 -> 'a
|
||||
(** Raise a located exception. *)
|
||||
|
||||
val report_exception : Format.formatter -> exn -> unit
|
||||
(** Report an exception on the given formatter *)
|
||||
56
unikernel/duniverse/ppxlib/astlib/longident.ml
Normal file
56
unikernel/duniverse/ppxlib/astlib/longident.ml
Normal file
|
|
@ -0,0 +1,56 @@
|
|||
type t =
|
||||
(*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *)
|
||||
| Lident of string
|
||||
| Ldot of t * string
|
||||
| Lapply of t * t
|
||||
|
||||
let rec flat accu = function
|
||||
| Lident s -> s :: accu
|
||||
| Ldot (lid, s) -> flat (s :: accu) lid
|
||||
| Lapply (_, _) -> Misc.fatal_error "Longident.flat"
|
||||
|
||||
let flatten lid = flat [] lid
|
||||
|
||||
let rec split_at_dots s pos =
|
||||
try
|
||||
let dot = String.index_from s pos '.' in
|
||||
String.sub s pos (dot - pos) :: split_at_dots s (dot + 1)
|
||||
with Not_found -> [ String.sub s pos (String.length s - pos) ]
|
||||
|
||||
let unflatten l =
|
||||
match l with
|
||||
| [] -> None
|
||||
| hd :: tl -> Some (List.fold_left (fun p s -> Ldot (p, s)) (Lident hd) tl)
|
||||
|
||||
let parse s =
|
||||
match unflatten (split_at_dots s 0) with
|
||||
| None ->
|
||||
Lident ""
|
||||
(* should not happen, but don't put assert false
|
||||
so as not to crash the toplevel (see Genprintval) *)
|
||||
| Some v -> v
|
||||
|
||||
let rec to_504_plus lid =
|
||||
let loc = Location.none in
|
||||
match lid with
|
||||
| Lident s -> Longident_504.Lident s
|
||||
| Ldot (lid, s) ->
|
||||
Longident_504.Ldot ({txt = to_504_plus lid; loc}, { txt = s; loc})
|
||||
| Lapply (lid, lid2) ->
|
||||
Longident_504.Lapply
|
||||
({txt = to_504_plus lid; loc}, {txt= to_504_plus lid2; loc})
|
||||
|
||||
let rec from_504_plus lid =
|
||||
match lid with
|
||||
| Longident_504.Lident s -> Lident s
|
||||
| Longident_504.Ldot (lid, s) -> Ldot (from_504_plus lid.txt, s.txt)
|
||||
| Longident_504.Lapply (lid, lid2) ->
|
||||
Lapply (from_504_plus lid.txt, from_504_plus lid2.txt)
|
||||
|
||||
let to_compiler lid =
|
||||
(*IF_NOT_AT_LEAST 504 lid *)
|
||||
(*IF_AT_LEAST 504 to_504_plus lid *)
|
||||
|
||||
let from_compiler lid =
|
||||
(*IF_NOT_AT_LEAST 504 lid *)
|
||||
(*IF_AT_LEAST 504 from_504_plus lid *)
|
||||
19
unikernel/duniverse/ppxlib/astlib/longident.mli
Normal file
19
unikernel/duniverse/ppxlib/astlib/longident.mli
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
(** Long identifiers, used in parsetrees. *)
|
||||
|
||||
(** The long identifier type *)
|
||||
type t =
|
||||
(*IF_NOT_AT_LEAST 504 Ocaml_common.Longident.t = *)
|
||||
| Lident of string
|
||||
| Ldot of t * string
|
||||
| Lapply of t * t
|
||||
|
||||
val flatten : t -> string list
|
||||
(** Flatten a long identifier built upon [Lident] and [Ldot]. Raise when hitting
|
||||
[Lapply].*)
|
||||
|
||||
val parse : string -> t
|
||||
(** Parse a string into a long identifier built upon [Lident] and [Ldot]. *)
|
||||
|
||||
val to_compiler : t -> Ocaml_common.Longident.t
|
||||
|
||||
val from_compiler : Ocaml_common.Longident.t -> t
|
||||
5
unikernel/duniverse/ppxlib/astlib/longident_504.ml
Normal file
5
unikernel/duniverse/ppxlib/astlib/longident_504.ml
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
type t =
|
||||
(*IF_AT_LEAST 504 Ocaml_common.Longident.t = *)
|
||||
| Lident of string
|
||||
| Ldot of t Location.loc * string Location.loc
|
||||
| Lapply of t Location.loc * t Location.loc
|
||||
5
unikernel/duniverse/ppxlib/astlib/longident_504.mli
Normal file
5
unikernel/duniverse/ppxlib/astlib/longident_504.mli
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
type t =
|
||||
(*IF_AT_LEAST 504 Ocaml_common.Longident.t = *)
|
||||
| Lident of string
|
||||
| Ldot of t Location.loc * string Location.loc
|
||||
| Lapply of t Location.loc * t Location.loc
|
||||
1185
unikernel/duniverse/ppxlib/astlib/migrate_408_409.ml
Normal file
1185
unikernel/duniverse/ppxlib/astlib/migrate_408_409.ml
Normal file
File diff suppressed because it is too large
Load diff
1185
unikernel/duniverse/ppxlib/astlib/migrate_409_408.ml
Normal file
1185
unikernel/duniverse/ppxlib/astlib/migrate_409_408.ml
Normal file
File diff suppressed because it is too large
Load diff
1191
unikernel/duniverse/ppxlib/astlib/migrate_409_410.ml
Normal file
1191
unikernel/duniverse/ppxlib/astlib/migrate_409_410.ml
Normal file
File diff suppressed because it is too large
Load diff
1213
unikernel/duniverse/ppxlib/astlib/migrate_410_409.ml
Normal file
1213
unikernel/duniverse/ppxlib/astlib/migrate_410_409.ml
Normal file
File diff suppressed because it is too large
Load diff
1196
unikernel/duniverse/ppxlib/astlib/migrate_410_411.ml
Normal file
1196
unikernel/duniverse/ppxlib/astlib/migrate_410_411.ml
Normal file
File diff suppressed because it is too large
Load diff
1195
unikernel/duniverse/ppxlib/astlib/migrate_411_410.ml
Normal file
1195
unikernel/duniverse/ppxlib/astlib/migrate_411_410.ml
Normal file
File diff suppressed because it is too large
Load diff
1187
unikernel/duniverse/ppxlib/astlib/migrate_411_412.ml
Normal file
1187
unikernel/duniverse/ppxlib/astlib/migrate_411_412.ml
Normal file
File diff suppressed because it is too large
Load diff
1193
unikernel/duniverse/ppxlib/astlib/migrate_412_411.ml
Normal file
1193
unikernel/duniverse/ppxlib/astlib/migrate_412_411.ml
Normal file
File diff suppressed because it is too large
Load diff
1199
unikernel/duniverse/ppxlib/astlib/migrate_412_413.ml
Normal file
1199
unikernel/duniverse/ppxlib/astlib/migrate_412_413.ml
Normal file
File diff suppressed because it is too large
Load diff
1220
unikernel/duniverse/ppxlib/astlib/migrate_413_412.ml
Normal file
1220
unikernel/duniverse/ppxlib/astlib/migrate_413_412.ml
Normal file
File diff suppressed because it is too large
Load diff
1212
unikernel/duniverse/ppxlib/astlib/migrate_413_414.ml
Normal file
1212
unikernel/duniverse/ppxlib/astlib/migrate_413_414.ml
Normal file
File diff suppressed because it is too large
Load diff
1223
unikernel/duniverse/ppxlib/astlib/migrate_414_413.ml
Normal file
1223
unikernel/duniverse/ppxlib/astlib/migrate_414_413.ml
Normal file
File diff suppressed because it is too large
Load diff
90
unikernel/duniverse/ppxlib/astlib/migrate_414_500.ml
Normal file
90
unikernel/duniverse/ppxlib/astlib/migrate_414_500.ml
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
module From = Ast_414
|
||||
module To = Ast_500
|
||||
|
||||
(*$ open Astlib_cinaps_helpers $*)
|
||||
|
||||
(*$ foreach_type (fun _ s ->
|
||||
Printf.printf
|
||||
"let copy_%s\n\
|
||||
\ : Ast_414.Parsetree.%s -> Ast_500.Parsetree.%s\n\
|
||||
\ = fun x -> x\n\n"
|
||||
s s s
|
||||
)
|
||||
*)
|
||||
let copy_structure
|
||||
: Ast_414.Parsetree.structure -> Ast_500.Parsetree.structure
|
||||
= fun x -> x
|
||||
|
||||
let copy_signature
|
||||
: Ast_414.Parsetree.signature -> Ast_500.Parsetree.signature
|
||||
= fun x -> x
|
||||
|
||||
let copy_toplevel_phrase
|
||||
: Ast_414.Parsetree.toplevel_phrase -> Ast_500.Parsetree.toplevel_phrase
|
||||
= fun x -> x
|
||||
|
||||
let copy_core_type
|
||||
: Ast_414.Parsetree.core_type -> Ast_500.Parsetree.core_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_expression
|
||||
: Ast_414.Parsetree.expression -> Ast_500.Parsetree.expression
|
||||
= fun x -> x
|
||||
|
||||
let copy_pattern
|
||||
: Ast_414.Parsetree.pattern -> Ast_500.Parsetree.pattern
|
||||
= fun x -> x
|
||||
|
||||
let copy_case
|
||||
: Ast_414.Parsetree.case -> Ast_500.Parsetree.case
|
||||
= fun x -> x
|
||||
|
||||
let copy_type_declaration
|
||||
: Ast_414.Parsetree.type_declaration -> Ast_500.Parsetree.type_declaration
|
||||
= fun x -> x
|
||||
|
||||
let copy_type_extension
|
||||
: Ast_414.Parsetree.type_extension -> Ast_500.Parsetree.type_extension
|
||||
= fun x -> x
|
||||
|
||||
let copy_extension_constructor
|
||||
: Ast_414.Parsetree.extension_constructor -> Ast_500.Parsetree.extension_constructor
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_expr
|
||||
: Ast_414.Parsetree.class_expr -> Ast_500.Parsetree.class_expr
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_field
|
||||
: Ast_414.Parsetree.class_field -> Ast_500.Parsetree.class_field
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_type
|
||||
: Ast_414.Parsetree.class_type -> Ast_500.Parsetree.class_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_signature
|
||||
: Ast_414.Parsetree.class_signature -> Ast_500.Parsetree.class_signature
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_type_field
|
||||
: Ast_414.Parsetree.class_type_field -> Ast_500.Parsetree.class_type_field
|
||||
= fun x -> x
|
||||
|
||||
let copy_module_expr
|
||||
: Ast_414.Parsetree.module_expr -> Ast_500.Parsetree.module_expr
|
||||
= fun x -> x
|
||||
|
||||
let copy_module_type
|
||||
: Ast_414.Parsetree.module_type -> Ast_500.Parsetree.module_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_signature_item
|
||||
: Ast_414.Parsetree.signature_item -> Ast_500.Parsetree.signature_item
|
||||
= fun x -> x
|
||||
|
||||
let copy_structure_item
|
||||
: Ast_414.Parsetree.structure_item -> Ast_500.Parsetree.structure_item
|
||||
= fun x -> x
|
||||
|
||||
(*$*)
|
||||
90
unikernel/duniverse/ppxlib/astlib/migrate_500_414.ml
Normal file
90
unikernel/duniverse/ppxlib/astlib/migrate_500_414.ml
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
module From = Ast_500
|
||||
module To = Ast_414
|
||||
|
||||
(*$ open Astlib_cinaps_helpers $*)
|
||||
|
||||
(*$ foreach_type (fun _ s ->
|
||||
Printf.printf
|
||||
"let copy_%s\n\
|
||||
\ : Ast_500.Parsetree.%s -> Ast_414.Parsetree.%s\n\
|
||||
\ = fun x -> x\n\n"
|
||||
s s s
|
||||
)
|
||||
*)
|
||||
let copy_structure
|
||||
: Ast_500.Parsetree.structure -> Ast_414.Parsetree.structure
|
||||
= fun x -> x
|
||||
|
||||
let copy_signature
|
||||
: Ast_500.Parsetree.signature -> Ast_414.Parsetree.signature
|
||||
= fun x -> x
|
||||
|
||||
let copy_toplevel_phrase
|
||||
: Ast_500.Parsetree.toplevel_phrase -> Ast_414.Parsetree.toplevel_phrase
|
||||
= fun x -> x
|
||||
|
||||
let copy_core_type
|
||||
: Ast_500.Parsetree.core_type -> Ast_414.Parsetree.core_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_expression
|
||||
: Ast_500.Parsetree.expression -> Ast_414.Parsetree.expression
|
||||
= fun x -> x
|
||||
|
||||
let copy_pattern
|
||||
: Ast_500.Parsetree.pattern -> Ast_414.Parsetree.pattern
|
||||
= fun x -> x
|
||||
|
||||
let copy_case
|
||||
: Ast_500.Parsetree.case -> Ast_414.Parsetree.case
|
||||
= fun x -> x
|
||||
|
||||
let copy_type_declaration
|
||||
: Ast_500.Parsetree.type_declaration -> Ast_414.Parsetree.type_declaration
|
||||
= fun x -> x
|
||||
|
||||
let copy_type_extension
|
||||
: Ast_500.Parsetree.type_extension -> Ast_414.Parsetree.type_extension
|
||||
= fun x -> x
|
||||
|
||||
let copy_extension_constructor
|
||||
: Ast_500.Parsetree.extension_constructor -> Ast_414.Parsetree.extension_constructor
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_expr
|
||||
: Ast_500.Parsetree.class_expr -> Ast_414.Parsetree.class_expr
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_field
|
||||
: Ast_500.Parsetree.class_field -> Ast_414.Parsetree.class_field
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_type
|
||||
: Ast_500.Parsetree.class_type -> Ast_414.Parsetree.class_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_signature
|
||||
: Ast_500.Parsetree.class_signature -> Ast_414.Parsetree.class_signature
|
||||
= fun x -> x
|
||||
|
||||
let copy_class_type_field
|
||||
: Ast_500.Parsetree.class_type_field -> Ast_414.Parsetree.class_type_field
|
||||
= fun x -> x
|
||||
|
||||
let copy_module_expr
|
||||
: Ast_500.Parsetree.module_expr -> Ast_414.Parsetree.module_expr
|
||||
= fun x -> x
|
||||
|
||||
let copy_module_type
|
||||
: Ast_500.Parsetree.module_type -> Ast_414.Parsetree.module_type
|
||||
= fun x -> x
|
||||
|
||||
let copy_signature_item
|
||||
: Ast_500.Parsetree.signature_item -> Ast_414.Parsetree.signature_item
|
||||
= fun x -> x
|
||||
|
||||
let copy_structure_item
|
||||
: Ast_500.Parsetree.structure_item -> Ast_414.Parsetree.structure_item
|
||||
= fun x -> x
|
||||
|
||||
(*$*)
|
||||
1378
unikernel/duniverse/ppxlib/astlib/migrate_500_501.ml
Normal file
1378
unikernel/duniverse/ppxlib/astlib/migrate_500_501.ml
Normal file
File diff suppressed because it is too large
Load diff
1422
unikernel/duniverse/ppxlib/astlib/migrate_501_500.ml
Normal file
1422
unikernel/duniverse/ppxlib/astlib/migrate_501_500.ml
Normal file
File diff suppressed because it is too large
Load diff
1378
unikernel/duniverse/ppxlib/astlib/migrate_501_502.ml
Normal file
1378
unikernel/duniverse/ppxlib/astlib/migrate_501_502.ml
Normal file
File diff suppressed because it is too large
Load diff
1404
unikernel/duniverse/ppxlib/astlib/migrate_502_501.ml
Normal file
1404
unikernel/duniverse/ppxlib/astlib/migrate_502_501.ml
Normal file
File diff suppressed because it is too large
Load diff
1308
unikernel/duniverse/ppxlib/astlib/migrate_502_503.ml
Normal file
1308
unikernel/duniverse/ppxlib/astlib/migrate_502_503.ml
Normal file
File diff suppressed because it is too large
Load diff
1289
unikernel/duniverse/ppxlib/astlib/migrate_503_502.ml
Normal file
1289
unikernel/duniverse/ppxlib/astlib/migrate_503_502.ml
Normal file
File diff suppressed because it is too large
Load diff
1323
unikernel/duniverse/ppxlib/astlib/migrate_503_504.ml
Normal file
1323
unikernel/duniverse/ppxlib/astlib/migrate_503_504.ml
Normal file
File diff suppressed because it is too large
Load diff
1340
unikernel/duniverse/ppxlib/astlib/migrate_504_503.ml
Normal file
1340
unikernel/duniverse/ppxlib/astlib/migrate_504_503.ml
Normal file
File diff suppressed because it is too large
Load diff
1
unikernel/duniverse/ppxlib/astlib/parse.ml
Normal file
1
unikernel/duniverse/ppxlib/astlib/parse.ml
Normal file
|
|
@ -0,0 +1 @@
|
|||
include Ocaml_common.Parse
|
||||
22
unikernel/duniverse/ppxlib/astlib/parse.mli
Normal file
22
unikernel/duniverse/ppxlib/astlib/parse.mli
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
(** Entry points in the parser *)
|
||||
|
||||
val implementation : Lexing.lexbuf -> Parsetree.structure_item list
|
||||
(** Parse a structure *)
|
||||
|
||||
val interface : Lexing.lexbuf -> Parsetree.signature_item list
|
||||
(** Parse a signature *)
|
||||
|
||||
val toplevel_phrase : Lexing.lexbuf -> Parsetree.toplevel_phrase
|
||||
(** Parse a toplevel phrase *)
|
||||
|
||||
val use_file : Lexing.lexbuf -> Parsetree.toplevel_phrase list
|
||||
(** Parse a series of toplevel phrases *)
|
||||
|
||||
val core_type : Lexing.lexbuf -> Parsetree.core_type
|
||||
(** Parse a core type *)
|
||||
|
||||
val expression : Lexing.lexbuf -> Parsetree.expression
|
||||
(** Parse an expression *)
|
||||
|
||||
val pattern : Lexing.lexbuf -> Parsetree.pattern
|
||||
(** Parse a pattern *)
|
||||
5
unikernel/duniverse/ppxlib/astlib/pp/dune
Normal file
5
unikernel/duniverse/ppxlib/astlib/pp/dune
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
(executables
|
||||
(names pp)
|
||||
(flags :standard -w -3))
|
||||
|
||||
(ocamllex pp_rewrite)
|
||||
12
unikernel/duniverse/ppxlib/astlib/pp/pp.ml
Normal file
12
unikernel/duniverse/ppxlib/astlib/pp/pp.ml
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
let () =
|
||||
match Sys.argv with
|
||||
| [| _; ocaml_version; fname |] ->
|
||||
let is_current =
|
||||
Filename.basename fname = Printf.sprintf "ast_%s.ml" ocaml_version
|
||||
in
|
||||
let ic = open_in_bin fname in
|
||||
Printf.printf "# 1 %S\n" fname;
|
||||
Pp_rewrite.rewrite is_current ocaml_version (Lexing.from_channel ic)
|
||||
| _ ->
|
||||
Printf.eprintf "%s: <ocaml-version> <file-name>\n" Sys.executable_name;
|
||||
exit 2
|
||||
1
unikernel/duniverse/ppxlib/astlib/pp/pp.mli
Normal file
1
unikernel/duniverse/ppxlib/astlib/pp/pp.mli
Normal file
|
|
@ -0,0 +1 @@
|
|||
(* empty *)
|
||||
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Add a link
Reference in a new issue