From 806636d2d576fe231e4e65f2d264730ef3c935df Mon Sep 17 00:00:00 2001 From: Andy Li Date: Tue, 25 Dec 2018 17:38:42 +0100 Subject: Import ppx-tools-versioned_5.2.1-1.debian.tar.xz [dgit import tarball ppx-tools-versioned 5.2.1-1 ppx-tools-versioned_5.2.1-1.debian.tar.xz] --- changelog | 14 ++++ compat | 1 + control | 101 +++++++++++++++++++++++++++ copyright | 33 +++++++++ gbp.conf | 2 + libppx-tools-versioned-ocaml-dev.install.in | 10 +++ libppx-tools-versioned-ocaml-doc.install | 1 + libppx-tools-versioned-ocaml-doc.ocamldoc.in | 3 + libppx-tools-versioned-ocaml.install.in | 4 ++ not-installed | 1 + rules | 17 +++++ source/format | 1 + tests/control | 3 + tests/ppx-once | 14 ++++ watch | 2 + 15 files changed, 207 insertions(+) create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 gbp.conf create mode 100644 libppx-tools-versioned-ocaml-dev.install.in create mode 100644 libppx-tools-versioned-ocaml-doc.install create mode 100644 libppx-tools-versioned-ocaml-doc.ocamldoc.in create mode 100644 libppx-tools-versioned-ocaml.install.in create mode 100644 not-installed create mode 100755 rules create mode 100644 source/format create mode 100644 tests/control create mode 100755 tests/ppx-once create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..9dc4c63 --- /dev/null +++ b/changelog @@ -0,0 +1,14 @@ +ppx-tools-versioned (5.2.1-1) unstable; urgency=medium + + * New upstream release. + * Update d/rules regarding changes to dune. + * Bump Standards-Version to 4.3.0 (no changes). + * Fix autopkgtest. + + -- Andy Li Wed, 26 Dec 2018 00:38:42 +0800 + +ppx-tools-versioned (5.2-1) unstable; urgency=low + + * Initial release. (Closes: #899238) + + -- Andy Li Wed, 20 Jun 2018 11:13:02 +0800 diff --git a/compat b/compat new file mode 100644 index 0000000..f11c82a --- /dev/null +++ b/compat @@ -0,0 +1 @@ +9 \ No newline at end of file diff --git a/control b/control new file mode 100644 index 0000000..4115704 --- /dev/null +++ b/control @@ -0,0 +1,101 @@ +Source: ppx-tools-versioned +Section: ocaml +Priority: optional +Maintainer: Debian OCaml Maintainers +Uploaders: Andy Li +Standards-Version: 4.3.0 +Build-Depends: + debhelper (>= 10.3), + ocaml-nox (>= 4.02.0), + ocamlbuild, + dune, + libmigrate-parsetree-ocaml-dev, + ocaml-findlib, + opam, + dh-ocaml +Homepage: https://github.com/ocaml-ppx/ppx_tools_versioned +Vcs-Browser: https://salsa.debian.org/ocaml-team/ppx-tools-versioned +Vcs-Git: https://salsa.debian.org/ocaml-team/ppx-tools-versioned.git + +Package: libppx-tools-versioned-ocaml +Architecture: any +Depends: + ${shlibs:Depends}, + ${misc:Depends}, + ${ocaml:Depends} +Provides: + ${ocaml:Provides} +Recommends: ocaml-findlib +Description: Tools for authors of OCaml syntactic tools (Runtime library) + A variant of ppx-tools based on ocaml-migrate-parsetree. + . + It includes tools for authors of syntactic tools (such as + ppx rewriters): + * ppx_metaquot: a ppx filter to help writing programs which + manipulate the Parsetree, by allowing the programmer to use + concrete syntax for expressions creating Parsetree fragments and + patterns deconstructing Parsetree fragments; + * rewriter: a utility to help testing ppx rewriters that runs the + rewriter on user-provided code and returns the result; + * Ast_mapper_class: a generic mapper from Parsetree to Parsetree + implementing a deep identity copy, which can be customized with a + custom behavior for each syntactic category; + * dumpast: parses fragments of OCaml code (or entire source files) + and dump the resulting internal Parsetree representation; + * genlifter: generates a virtual "lifter" class for one or several + OCaml type constructors. + +Package: libppx-tools-versioned-ocaml-dev +Architecture: any +Depends: + ${shlibs:Depends}, + ${misc:Depends}, + ${ocaml:Depends} +Provides: + ${ocaml:Provides} +Recommends: ocaml-findlib +Description: Tools for authors of OCaml syntactic tools (Development package) + A variant of ppx-tools based on ocaml-migrate-parsetree. + . + It includes tools for authors of syntactic tools (such as + ppx rewriters): + * ppx_metaquot: a ppx filter to help writing programs which + manipulate the Parsetree, by allowing the programmer to use + concrete syntax for expressions creating Parsetree fragments and + patterns deconstructing Parsetree fragments; + * rewriter: a utility to help testing ppx rewriters that runs the + rewriter on user-provided code and returns the result; + * Ast_mapper_class: a generic mapper from Parsetree to Parsetree + implementing a deep identity copy, which can be customized with a + custom behavior for each syntactic category; + * dumpast: parses fragments of OCaml code (or entire source files) + and dump the resulting internal Parsetree representation; + * genlifter: generates a virtual "lifter" class for one or several + OCaml type constructors. + +Package: libppx-tools-versioned-ocaml-doc +Section: doc +Architecture: all +Depends: ${misc:Depends} +Enhances: libppx-tools-versioned-ocaml-dev +Description: Documentation for ppx-tools-versioned + A variant of ppx-tools based on ocaml-migrate-parsetree. + . + It includes tools for authors of syntactic tools (such as + ppx rewriters): + * ppx_metaquot: a ppx filter to help writing programs which + manipulate the Parsetree, by allowing the programmer to use + concrete syntax for expressions creating Parsetree fragments and + patterns deconstructing Parsetree fragments; + * rewriter: a utility to help testing ppx rewriters that runs the + rewriter on user-provided code and returns the result; + * Ast_mapper_class: a generic mapper from Parsetree to Parsetree + implementing a deep identity copy, which can be customized with a + custom behavior for each syntactic category; + * dumpast: parses fragments of OCaml code (or entire source files) + and dump the resulting internal Parsetree representation; + * genlifter: generates a virtual "lifter" class for one or several + OCaml type constructors. + . + This package contains documentation for ppx-tools-versioned in html + format. \ No newline at end of file diff --git a/copyright b/copyright new file mode 100644 index 0000000..711cb2c --- /dev/null +++ b/copyright @@ -0,0 +1,33 @@ +Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: ppx_tools_versioned +Upstream-Contact: + Alain Frisch + Peter Zotov + Gabriel Radanne +Source: https://github.com/ocaml-ppx/ppx_tools_versioned + +Files: * +Copyright: Copyright (c) 2013 Alain Frisch and LexiFi +License: Expat + +License: Expat + The MIT License (MIT) + . + Copyright (c) 2013 Alain Frisch and LexiFi + . + 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. diff --git a/gbp.conf b/gbp.conf new file mode 100644 index 0000000..cec628c --- /dev/null +++ b/gbp.conf @@ -0,0 +1,2 @@ +[DEFAULT] +pristine-tar = True diff --git a/libppx-tools-versioned-ocaml-dev.install.in b/libppx-tools-versioned-ocaml-dev.install.in new file mode 100644 index 0000000..b3c93a2 --- /dev/null +++ b/libppx-tools-versioned-ocaml-dev.install.in @@ -0,0 +1,10 @@ +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.dune +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmi +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmt +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmti +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.ml +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.mli +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.exe +OPT: @OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.a +OPT: @OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmxa +OPT: @OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmx diff --git a/libppx-tools-versioned-ocaml-doc.install b/libppx-tools-versioned-ocaml-doc.install new file mode 100644 index 0000000..a93f7f2 --- /dev/null +++ b/libppx-tools-versioned-ocaml-doc.install @@ -0,0 +1 @@ +usr/doc/ppx_tools_versioned/README.md /usr/share/doc/libppx-tools-versioned-ocaml-doc/ diff --git a/libppx-tools-versioned-ocaml-doc.ocamldoc.in b/libppx-tools-versioned-ocaml-doc.ocamldoc.in new file mode 100644 index 0000000..1c5f232 --- /dev/null +++ b/libppx-tools-versioned-ocaml-doc.ocamldoc.in @@ -0,0 +1,3 @@ +# Documentation generated by dh_ocamldoc +--include debian/tmp@OCamlStdlibDir@ +-package ocaml-migrate-parsetree \ No newline at end of file diff --git a/libppx-tools-versioned-ocaml.install.in b/libppx-tools-versioned-ocaml.install.in new file mode 100644 index 0000000..42a84e4 --- /dev/null +++ b/libppx-tools-versioned-ocaml.install.in @@ -0,0 +1,4 @@ +@OCamlStdlibDir@/ppx_tools_versioned/META +@OCamlStdlibDir@/ppx_tools_versioned/opam +@OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cma +DYN: @OCamlStdlibDir@/ppx_tools_versioned/{,**/}*.cmxs diff --git a/not-installed b/not-installed new file mode 100644 index 0000000..1c31f84 --- /dev/null +++ b/not-installed @@ -0,0 +1 @@ +usr/doc/ppx_tools_versioned/LICENSE diff --git a/rules b/rules new file mode 100755 index 0000000..932c5be --- /dev/null +++ b/rules @@ -0,0 +1,17 @@ +#!/usr/bin/make -f + +DESTDIR=$(CURDIR)/debian/tmp +include /usr/share/ocaml/ocamlvars.mk +export OCAMLFIND_DESTDIR=$(DESTDIR)$(OCAML_STDLIB_DIR) + +%: + dh $@ --with ocaml + +override_dh_auto_configure: + +override_dh_auto_install: + mkdir -p '$(OCAMLFIND_DESTDIR)' + dh_auto_install -- INSTALL_ARGS='--verbose' + +override_dh_missing: + dh_missing --fail-missing diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/tests/control b/tests/control new file mode 100644 index 0000000..7bb1b57 --- /dev/null +++ b/tests/control @@ -0,0 +1,3 @@ +Tests: ppx-once +Depends: ocaml-nox, ocaml-findlib, @ +Restrictions: allow-stderr diff --git a/tests/ppx-once b/tests/ppx-once new file mode 100755 index 0000000..ad3f6e3 --- /dev/null +++ b/tests/ppx-once @@ -0,0 +1,14 @@ +#!/bin/sh + +set -e + +cd "$(dirname "$0")/../../example/ppx_once" + +if [ -x '/usr/bin/ocamlopt' ] +then + make "FLAGS=-package ocaml-migrate-parsetree,ppx_tools_versioned.metaquot_405,ppx_tools_versioned" +else + make ppx_once.cmo "FLAGS=-package ocaml-migrate-parsetree,ppx_tools_versioned.metaquot_405,ppx_tools_versioned" +fi + +make clean diff --git a/watch b/watch new file mode 100644 index 0000000..0ea2011 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=3 +https://github.com/ocaml-ppx/ppx_tools_versioned/releases .*/archive/(\d\S*)\.tar\.gz -- cgit v1.2.3 From b7d66e4608b829ad7791a53f54d5aac1ee23715d Mon Sep 17 00:00:00 2001 From: Andy Li Date: Tue, 25 Dec 2018 17:38:42 +0100 Subject: Import ppx-tools-versioned_5.2.1.orig.tar.gz [dgit import orig ppx-tools-versioned_5.2.1.orig.tar.gz] --- .depend | 62 ++ .gitignore | 20 + .ocp-indent | 2 + .travis.yml | 17 + LICENSE | 20 + Makefile | 26 + README.md | 138 ++++ ast_convenience_402.ml | 155 +++++ ast_convenience_402.mli | 110 ++++ ast_convenience_403.ml | 122 ++++ ast_convenience_403.mli | 110 ++++ ast_convenience_404.ml | 124 ++++ ast_convenience_404.mli | 112 ++++ ast_convenience_405.ml | 124 ++++ ast_convenience_405.mli | 112 ++++ ast_convenience_406.ml | 124 ++++ ast_convenience_406.mli | 112 ++++ ast_lifter_402.ml | 1353 ++++++++++++++++++++++++++++++++++++++ ast_lifter_403.ml | 1378 +++++++++++++++++++++++++++++++++++++++ ast_lifter_404.ml | 1388 +++++++++++++++++++++++++++++++++++++++ ast_lifter_405.ml | 1393 +++++++++++++++++++++++++++++++++++++++ ast_lifter_406.ml | 1409 ++++++++++++++++++++++++++++++++++++++++ ast_mapper_class_402.ml | 576 ++++++++++++++++ ast_mapper_class_402.mli | 57 ++ ast_mapper_class_403.ml | 581 +++++++++++++++++ ast_mapper_class_403.mli | 58 ++ ast_mapper_class_404.ml | 586 +++++++++++++++++ ast_mapper_class_404.mli | 58 ++ ast_mapper_class_405.ml | 586 +++++++++++++++++ ast_mapper_class_405.mli | 58 ++ ast_mapper_class_406.ml | 594 +++++++++++++++++ ast_mapper_class_406.mli | 58 ++ example/ppx_once/.merlin | 3 + example/ppx_once/META | 8 + example/ppx_once/Makefile | 34 + example/ppx_once/ppx_once.ml | 70 ++ example/ppx_once/standalone.ml | 4 + gen/update_jbuild.ml | 47 ++ jbuild | 11 + jbuild-workspace.dev | 5 + jbuild.inc | 63 ++ pkg/pkg.ml | 2 + ppx_metaquot_402.ml | 236 +++++++ ppx_metaquot_403.ml | 236 +++++++ ppx_metaquot_404.ml | 281 ++++++++ ppx_metaquot_405.ml | 281 ++++++++ ppx_metaquot_406.ml | 281 ++++++++ ppx_metaquot_run.ml | 1 + ppx_tools_402.ml | 2 + ppx_tools_403.ml | 2 + ppx_tools_404.ml | 2 + ppx_tools_405.ml | 2 + ppx_tools_406.ml | 2 + ppx_tools_versioned.opam | 21 + 54 files changed, 13217 insertions(+) create mode 100644 .depend create mode 100644 .gitignore create mode 100644 .ocp-indent create mode 100644 .travis.yml create mode 100644 LICENSE create mode 100644 Makefile create mode 100644 README.md create mode 100644 ast_convenience_402.ml create mode 100644 ast_convenience_402.mli create mode 100644 ast_convenience_403.ml create mode 100644 ast_convenience_403.mli create mode 100644 ast_convenience_404.ml create mode 100644 ast_convenience_404.mli create mode 100644 ast_convenience_405.ml create mode 100644 ast_convenience_405.mli create mode 100644 ast_convenience_406.ml create mode 100644 ast_convenience_406.mli create mode 100644 ast_lifter_402.ml create mode 100644 ast_lifter_403.ml create mode 100644 ast_lifter_404.ml create mode 100644 ast_lifter_405.ml create mode 100644 ast_lifter_406.ml create mode 100644 ast_mapper_class_402.ml create mode 100644 ast_mapper_class_402.mli create mode 100644 ast_mapper_class_403.ml create mode 100644 ast_mapper_class_403.mli create mode 100644 ast_mapper_class_404.ml create mode 100644 ast_mapper_class_404.mli create mode 100644 ast_mapper_class_405.ml create mode 100644 ast_mapper_class_405.mli create mode 100644 ast_mapper_class_406.ml create mode 100644 ast_mapper_class_406.mli create mode 100644 example/ppx_once/.merlin create mode 100644 example/ppx_once/META create mode 100644 example/ppx_once/Makefile create mode 100644 example/ppx_once/ppx_once.ml create mode 100644 example/ppx_once/standalone.ml create mode 100644 gen/update_jbuild.ml create mode 100644 jbuild create mode 100644 jbuild-workspace.dev create mode 100644 jbuild.inc create mode 100644 pkg/pkg.ml create mode 100644 ppx_metaquot_402.ml create mode 100644 ppx_metaquot_403.ml create mode 100644 ppx_metaquot_404.ml create mode 100644 ppx_metaquot_405.ml create mode 100644 ppx_metaquot_406.ml create mode 100644 ppx_metaquot_run.ml create mode 100644 ppx_tools_402.ml create mode 100644 ppx_tools_403.ml create mode 100644 ppx_tools_404.ml create mode 100644 ppx_tools_405.ml create mode 100644 ppx_tools_406.ml create mode 100644 ppx_tools_versioned.opam diff --git a/.depend b/.depend new file mode 100644 index 0000000..560d8b0 --- /dev/null +++ b/.depend @@ -0,0 +1,62 @@ +ast_convenience_402.cmo : ast_convenience_402.cmi +ast_convenience_402.cmx : ast_convenience_402.cmi +ast_convenience_402.cmi : +ast_convenience_403.cmo : ast_convenience_403.cmi +ast_convenience_403.cmx : ast_convenience_403.cmi +ast_convenience_403.cmi : +ast_convenience_404.cmo : ast_convenience_404.cmi +ast_convenience_404.cmx : ast_convenience_404.cmi +ast_convenience_404.cmi : +ast_convenience_405.cmo : ast_convenience_405.cmi +ast_convenience_405.cmx : ast_convenience_405.cmi +ast_convenience_405.cmi : +ast_convenience_406.cmo : ast_convenience_406.cmi +ast_convenience_406.cmx : ast_convenience_406.cmi +ast_convenience_406.cmi : +ast_lifter_402.cmo : +ast_lifter_402.cmx : +ast_lifter_403.cmo : +ast_lifter_403.cmx : +ast_lifter_404.cmo : +ast_lifter_404.cmx : +ast_lifter_405.cmo : +ast_lifter_405.cmx : +ast_lifter_406.cmo : +ast_lifter_406.cmx : +ast_mapper_class_402.cmo : ast_mapper_class_402.cmi +ast_mapper_class_402.cmx : ast_mapper_class_402.cmi +ast_mapper_class_402.cmi : +ast_mapper_class_403.cmo : ast_mapper_class_403.cmi +ast_mapper_class_403.cmx : ast_mapper_class_403.cmi +ast_mapper_class_403.cmi : +ast_mapper_class_404.cmo : ast_mapper_class_404.cmi +ast_mapper_class_404.cmx : ast_mapper_class_404.cmi +ast_mapper_class_404.cmi : +ast_mapper_class_405.cmo : ast_mapper_class_405.cmi +ast_mapper_class_405.cmx : ast_mapper_class_405.cmi +ast_mapper_class_405.cmi : +ast_mapper_class_406.cmo : ast_mapper_class_406.cmi +ast_mapper_class_406.cmx : ast_mapper_class_406.cmi +ast_mapper_class_406.cmi : +ppx_metaquot_402.cmo : ast_lifter_402.cmo ast_convenience_402.cmi +ppx_metaquot_402.cmx : ast_lifter_402.cmx ast_convenience_402.cmx +ppx_metaquot_403.cmo : ast_lifter_403.cmo ast_convenience_403.cmi +ppx_metaquot_403.cmx : ast_lifter_403.cmx ast_convenience_403.cmx +ppx_metaquot_404.cmo : ast_lifter_404.cmo ast_convenience_404.cmi +ppx_metaquot_404.cmx : ast_lifter_404.cmx ast_convenience_404.cmx +ppx_metaquot_405.cmo : ast_lifter_405.cmo ast_convenience_405.cmi +ppx_metaquot_405.cmx : ast_lifter_405.cmx ast_convenience_405.cmx +ppx_metaquot_406.cmo : ast_lifter_406.cmo ast_convenience_406.cmi +ppx_metaquot_406.cmx : ast_lifter_406.cmx ast_convenience_406.cmx +ppx_metaquot_run.cmo : +ppx_metaquot_run.cmx : +ppx_tools_402.cmo : ast_mapper_class_402.cmi ast_convenience_402.cmi +ppx_tools_402.cmx : ast_mapper_class_402.cmx ast_convenience_402.cmx +ppx_tools_403.cmo : ast_mapper_class_403.cmi ast_convenience_403.cmi +ppx_tools_403.cmx : ast_mapper_class_403.cmx ast_convenience_403.cmx +ppx_tools_404.cmo : ast_mapper_class_404.cmi ast_convenience_404.cmi +ppx_tools_404.cmx : ast_mapper_class_404.cmx ast_convenience_404.cmx +ppx_tools_405.cmo : ast_mapper_class_405.cmi ast_convenience_405.cmi +ppx_tools_405.cmx : ast_mapper_class_405.cmx ast_convenience_405.cmx +ppx_tools_406.cmo : ast_mapper_class_406.cmi ast_convenience_406.cmi +ppx_tools_406.cmx : ast_mapper_class_406.cmx ast_convenience_406.cmx diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..0590846 --- /dev/null +++ b/.gitignore @@ -0,0 +1,20 @@ +*.annot +*.cmo +*.cma +*.cmi +*.a +*.o +*.cmx +*.cmxs +*.cmxa +*.exe +*.cmt +*.cmti +dumpast +genlifter +ppx_metaquot +rewriter +ast_lifter.ml +.gitignore +*.install +.merlin \ No newline at end of file diff --git a/.ocp-indent b/.ocp-indent new file mode 100644 index 0000000..324a382 --- /dev/null +++ b/.ocp-indent @@ -0,0 +1,2 @@ +match_clause=4 +strict_with=auto diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..6464693 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,17 @@ +language: c +install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-docker.sh +script: bash -ex .travis-docker.sh +services: + - docker +sudo: false +env: + global: + - PACKAGE="ppx_tools_versioned" + - PRE_INSTALL_HOOK="cd /home/opam/opam-repository && git pull origin master && opam update -u -y" + matrix: + - DISTRO=debian-stable OCAML_VERSION=4.03.0 + - DISTRO=debian-testing OCAML_VERSION=4.02.3 + - DISTRO=debian-unstable OCAML_VERSION=4.04.0 + - DISTRO=ubuntu-16.04 OCAML_VERSION=4.03.0 + - DISTRO=alpine OCAML_VERSION=4.04.0 + #- DISTRO=alpine OCAML_VERSION=4.05.0+trunk diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..cb4dd09 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2013 Alain Frisch and LexiFi + +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. diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..2ac7b59 --- /dev/null +++ b/Makefile @@ -0,0 +1,26 @@ +INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) + +all: + jbuilder build --dev @install + +install: + jbuilder install $(INSTALL_ARGS) + +uninstall: + jbuilder uninstall $(INSTALL_ARGS) + +reinstall: uninstall reinstall + +test: + jbuilder runtest --dev + +promote: + jbuilder promote + +clean: + jbuilder clean + +all-supported-ocaml-versions: + jbuilder runtest --dev --workspace jbuild-workspace.dev + +.PHONY: all-supported-ocaml-versions all install uninstall reinstall test clean diff --git a/README.md b/README.md new file mode 100644 index 0000000..1c88d45 --- /dev/null +++ b/README.md @@ -0,0 +1,138 @@ +ppx_tools +========= + +Tools for authors of syntactic tools (such as ppx rewriters). + +This package is licensed by LexiFi under the terms of the MIT license. + +The tools are installed as a findlib package called 'ppx_tools'. +Executables are thus accessible through the ocamlfind driver (e.g.: +ocamlfind ppx_tools/dumpast). + +Main contributors: + + - Alain Frisch + - Peter Zotov (whitequark) + - Gabriel Radanne (Drup) + +Master : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=master)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.05 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.05)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.04 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.04)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.03 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.03)](https://travis-ci.org/alainfrisch/ppx_tools) + +4.02 : [![Build Status](https://travis-ci.org/alainfrisch/ppx_tools.svg?branch=4.02)](https://travis-ci.org/alainfrisch/ppx_tools) + +ppx_metaquot +------------ + +A ppx filter to help writing programs which manipulate the Parsetree, +by allowing the programmer to use concrete syntax for expressions +creating Parsetree fragments and patterns deconstructing Parsetree +fragments. See the top of ppx_metaquot.ml for a description of the +supported extensions. + +Usage: + + ocamlfind ocamlc -c -package ppx_tools.metaquot my_ppx_code.ml + + +rewriter +-------- + +An utility to help testing ppx rewriters that runs the rewriter on +user-provided code and returns the result. + +Usage: + + ocamlfind ppx_tools/rewriter ./my_ppx_rewriter sample.ml + +See the integrated help message for more details: + + ocamlfind ppx_tools/rewriter -help + + +Ast_mapper_class +---------------- + +This module implements an API similar to Ast_mapper from the +compiler-libs, i.e. a generic mapper from Parsetree to Parsetree +implemeting a deep identity copy, which can be customized with a +custom behavior for each syntactic category. The difference with +Ast_mapper is that Ast_mapper_class implements the open recursion +using a class. + + +dumpast +------- + +This tool parses fragments of OCaml code (or entire source files) and +dump the resulting internal Parsetree representation. Intended uses: + + - Help to learn about the OCaml Parsetree structure and how it + corresponds to OCaml source syntax. + + - Create fragments of Parsetree to be copy-pasted into the source + code of syntax-manipulating programs (such as ppx rewriters). + +Usage: + + ocamlfind ppx_tools/dumpast -e "1 + 2" + +The tool can be used to show the Parsetree representation of small +fragments of syntax passed on the command line (-e for expressions, -p +for patterns, -t for type expressions) or for entire .ml/mli files. +The standard -pp and -ppx options are supported, but only applied on +whole files. The tool has further option to control how location and +attribute fields in the Parsetree should be displayed. + + +genlifter +--------- + +This tool generates a virtual "lifter" class for one or several OCaml +type constructors. It does so by loading the .cmi files which define +those types. The generated lifter class exposes one method to "reify" +type constructors passed on the command-line and other type +constructors accessible from them. The class is parametrized over the +target type of the reification, and it must provide method to deal +with basic types (int, string, char, int32, int64, nativeint) and data +type builders (record, constr, tuple, list, array). As an example, +calling: + + ocamlfind ppx_tools/genlifter -I +compiler-libs Location.t + +produces the following class: + + class virtual ['res] lifter = + object (this) + method lift_Location_t : Location.t -> 'res= + fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] + method lift_bool : bool -> 'res= + function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) + method lift_Lexing_position : Lexing.position -> 'res= + fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] + end + +_dumpast_ is a direct example of using _genlifter_ applied on the +OCaml Parsetree definition itself. ppx_metaquot is another +similar example. diff --git a/ast_convenience_402.ml b/ast_convenience_402.ml new file mode 100644 index 0000000..1c65380 --- /dev/null +++ b/ast_convenience_402.ml @@ -0,0 +1,155 @@ +open Ast_402 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +open Parsetree +open Asttypes +open Location +open Ast_helper + + +module Label = struct + + type t = string + + type desc = + Nolabel + | Labelled of string + | Optional of string + + let explode s = + if s = "" then Nolabel + else if s.[0] = '?' then Optional (String.sub s 1 (String.length s - 1)) + else Labelled s + + let nolabel = "" + let labelled s = s + let optional s = "?"^s + +end + +module Constant = struct + type t = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + exception Unknown_literal of string * char + + (** Backport Int_literal_converter from ocaml 4.03 - + * https://github.com/ocaml/ocaml/blob/trunk/utils/misc.ml#L298 *) + module Int_literal_converter = struct + let cvt_int_aux str neg of_string = + if String.length str = 0 || str.[0] = '-' + then of_string str + else neg (of_string ("-" ^ str)) + let int s = cvt_int_aux s (~-) int_of_string + let int32 s = cvt_int_aux s Int32.neg Int32.of_string + let int64 s = cvt_int_aux s Int64.neg Int64.of_string + let nativeint s = cvt_int_aux s Nativeint.neg Nativeint.of_string + end + + let of_constant = function + | Asttypes.Const_int32(i) -> Pconst_integer(Int32.to_string i, Some 'l') + | Asttypes.Const_int64(i) -> Pconst_integer(Int64.to_string i, Some 'L') + | Asttypes.Const_nativeint(i) -> Pconst_integer(Nativeint.to_string i, Some 'n') + | Asttypes.Const_int(i) -> Pconst_integer(string_of_int i, None) + | Asttypes.Const_char c -> Pconst_char c + | Asttypes.Const_string(s, s_opt) -> Pconst_string(s, s_opt) + | Asttypes.Const_float f -> Pconst_float(f, None) + + let to_constant = function + | Pconst_integer(i,Some 'l') -> Asttypes.Const_int32 (Int_literal_converter.int32 i) + | Pconst_integer(i,Some 'L') -> Asttypes.Const_int64 (Int_literal_converter.int64 i) + | Pconst_integer(i,Some 'n') -> Asttypes.Const_nativeint (Int_literal_converter.nativeint i) + | Pconst_integer(i,None) -> Asttypes.Const_int (Int_literal_converter.int i) + | Pconst_integer(i,Some c) -> raise (Unknown_literal (i, c)) + | Pconst_char c -> Asttypes.Const_char c + | Pconst_string(s,d) -> Asttypes.Const_string(s, d) + | Pconst_float(f,None) -> Asttypes.Const_float f + | Pconst_float(f,Some c) -> raise (Unknown_literal (f, c)) +end + +let may_tuple ?loc tup = function + | [] -> None + | [x] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + +let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc +let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) +let nil ?loc ?attrs () = constr ?loc ?attrs "[]" [] +let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] +let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [x] -> x + | xs -> Exp.tuple ?loc ?attrs xs +let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] +let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) +let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Const_string (s, None)) +let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Const_int x) +let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Const_char x) +let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Const_float (string_of_float x)) +let record ?loc ?attrs ?over l = + Exp.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.pexp_loc s, e)) l) over +let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) +let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp +let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> Label.nolabel, a) l) +let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) +let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + +let sequence ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl + +let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) +let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) +let precord ?loc ?attrs ?(closed = Open) l = + Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed +let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" [] +let pcons ?loc ?attrs hd tl = pconstr ?loc ?attrs "::" [hd; tl] +let punit ?loc ?attrs () = pconstr ?loc ?attrs "()" [] +let ptuple ?loc ?attrs = function + | [] -> punit ?loc ?attrs () + | [x] -> x + | xs -> Pat.tuple ?loc ?attrs xs +let plist ?loc ?attrs l = List.fold_right (pcons ?loc ?attrs) l (pnil ?loc ?attrs ()) + +let pstr ?loc ?attrs s = Pat.constant ?loc ?attrs (Const_string (s, None)) +let pint ?loc ?attrs x = Pat.constant ?loc ?attrs (Const_int x) +let pchar ?loc ?attrs x = Pat.constant ?loc ?attrs (Const_char x) +let pfloat ?loc ?attrs x = Pat.constant ?loc ?attrs (Const_float (string_of_float x)) + +let tconstr ?loc ?attrs c l = Typ.constr ?loc ?attrs (lid ?loc c) l + +let get_str = function + | {pexp_desc=Pexp_constant (Const_string (s, _)); _} -> Some s + | _ -> None + +let get_str_with_quotation_delimiter = function + | {pexp_desc=Pexp_constant (Const_string (s, d)); _} -> Some (s, d) + | _ -> None + +let get_lid = function + | {pexp_desc=Pexp_ident{txt=id;_};_} -> + Some (String.concat "." (Longident.flatten id)) + | _ -> None + +let find_attr s attrs = + try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs)) + with Not_found -> None + +let expr_of_payload = function + | PStr [{pstr_desc=Pstr_eval(e, _); _}] -> Some e + | _ -> None + +let find_attr_expr s attrs = + match find_attr s attrs with + | Some e -> expr_of_payload e + | None -> None + +let has_attr s attrs = + find_attr s attrs <> None diff --git a/ast_convenience_402.mli b/ast_convenience_402.mli new file mode 100644 index 0000000..a07b92d --- /dev/null +++ b/ast_convenience_402.mli @@ -0,0 +1,110 @@ +open Ast_402 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** {1 Convenience functions to help build and deconstruct AST fragments.} *) + +open Parsetree +open Asttypes +open Ast_helper + +(** {2 Compatibility modules} *) + +module Label : sig + type t = string + + type desc = + Nolabel + | Labelled of string + | Optional of string + + val explode : t -> desc + + val nolabel : t + val labelled : string -> t + val optional : string -> t + +end + +(** {2 Provides abstraction over Asttypes.constant type }*) +module Constant : sig + type t = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + exception Unknown_literal of string * char + + (** Converts Asttypes.constant to Constant.t *) + val of_constant : constant -> t + + (** Converts Constant.t to Asttypes.constant. Raises Unknown_literal if conversion fails *) + val to_constant : t -> constant +end + +(** {2 Misc} *) + +val lid: ?loc:loc -> string -> lid + +(** {2 Expressions} *) + +val evar: ?loc:loc -> ?attrs:attrs -> string -> expression +val let_in: ?loc:loc -> ?attrs:attrs -> ?recursive:bool -> value_binding list -> expression -> expression + +val constr: ?loc:loc -> ?attrs:attrs -> string -> expression list -> expression +val record: ?loc:loc -> ?attrs:attrs -> ?over:expression -> (string * expression) list -> expression +val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val nil: ?loc:loc -> ?attrs:attrs -> unit -> expression +val cons: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression +val list: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val unit: ?loc:loc -> ?attrs:attrs -> unit -> expression + +val func: ?loc:loc -> ?attrs:attrs -> (pattern * expression) list -> expression +val lam: ?loc:loc -> ?attrs:attrs -> ?label:Label.t -> ?default:expression -> pattern -> expression -> expression +val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression + +val str: ?loc:loc -> ?attrs:attrs -> string -> expression +val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val char: ?loc:loc -> ?attrs:attrs -> char -> expression +val float: ?loc:loc -> ?attrs:attrs -> float -> expression + +val sequence: ?loc:loc -> ?attrs:attrs -> expression list -> expression +(** Return [()] if the list is empty. Tail rec. *) + +(** {2 Patterns} *) + +val pvar: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pconstr: ?loc:loc -> ?attrs:attrs -> string -> pattern list -> pattern +val precord: ?loc:loc -> ?attrs:attrs -> ?closed:closed_flag -> (string * pattern) list -> pattern +val ptuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pnil: ?loc:loc -> ?attrs:attrs -> unit -> pattern +val pcons: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern +val plist: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pstr: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pint: ?loc:loc -> ?attrs:attrs -> int -> pattern +val pchar: ?loc:loc -> ?attrs:attrs -> char -> pattern +val pfloat: ?loc:loc -> ?attrs:attrs -> float -> pattern + +val punit: ?loc:loc -> ?attrs:attrs -> unit -> pattern + + +(** {2 Types} *) + +val tconstr: ?loc:loc -> ?attrs:attrs -> string -> core_type list -> core_type + +(** {2 AST deconstruction} *) + +val get_str: expression -> string option +val get_str_with_quotation_delimiter: expression -> (string * string option) option +val get_lid: expression -> string option + +val has_attr: string -> attributes -> bool +val find_attr: string -> attributes -> payload option +val find_attr_expr: string -> attributes -> expression option diff --git a/ast_convenience_403.ml b/ast_convenience_403.ml new file mode 100644 index 0000000..3187cb4 --- /dev/null +++ b/ast_convenience_403.ml @@ -0,0 +1,122 @@ +open Ast_403 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +open Parsetree +open Asttypes +open Location +open Ast_helper + + +module Label = struct + + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + let explode x = x + + let nolabel = Nolabel + let labelled x = Labelled x + let optional x = Optional x + +end + +module Constant = struct + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + let of_constant x = x + + let to_constant x = x + +end + +let may_tuple ?loc tup = function + | [] -> None + | [x] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + +let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc +let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) +let nil ?loc ?attrs () = constr ?loc ?attrs "[]" [] +let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] +let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [x] -> x + | xs -> Exp.tuple ?loc ?attrs xs +let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] +let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) +let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Pconst_string (s, None)) +let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_char x) +let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) +let record ?loc ?attrs ?over l = + Exp.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.pexp_loc s, e)) l) over +let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) +let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp +let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> Label.nolabel, a) l) +let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) +let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + +let sequence ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl + +let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) +let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) +let precord ?loc ?attrs ?(closed = Open) l = + Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed +let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" [] +let pcons ?loc ?attrs hd tl = pconstr ?loc ?attrs "::" [hd; tl] +let punit ?loc ?attrs () = pconstr ?loc ?attrs "()" [] +let ptuple ?loc ?attrs = function + | [] -> punit ?loc ?attrs () + | [x] -> x + | xs -> Pat.tuple ?loc ?attrs xs +let plist ?loc ?attrs l = List.fold_right (pcons ?loc ?attrs) l (pnil ?loc ?attrs ()) + +let pstr ?loc ?attrs s = Pat.constant ?loc ?attrs (Pconst_string (s, None)) +let pint ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let pchar ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_char x) +let pfloat ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) + +let tconstr ?loc ?attrs c l = Typ.constr ?loc ?attrs (lid ?loc c) l + +let get_str = function + | {pexp_desc=Pexp_constant (Pconst_string (s, _)); _} -> Some s + | _ -> None + +let get_str_with_quotation_delimiter = function + | {pexp_desc=Pexp_constant (Pconst_string (s, d)); _} -> Some (s, d) + | _ -> None + +let get_lid = function + | {pexp_desc=Pexp_ident{txt=id;_};_} -> + Some (String.concat "." (Longident.flatten id)) + | _ -> None + +let find_attr s attrs = + try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs)) + with Not_found -> None + +let expr_of_payload = function + | PStr [{pstr_desc=Pstr_eval(e, _); _}] -> Some e + | _ -> None + +let find_attr_expr s attrs = + match find_attr s attrs with + | Some e -> expr_of_payload e + | None -> None + +let has_attr s attrs = + find_attr s attrs <> None diff --git a/ast_convenience_403.mli b/ast_convenience_403.mli new file mode 100644 index 0000000..4e9690a --- /dev/null +++ b/ast_convenience_403.mli @@ -0,0 +1,110 @@ +open Ast_403 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** {1 Convenience functions to help build and deconstruct AST fragments.} *) + +open Asttypes +open Ast_helper +open Parsetree + +(** {2 Compatibility modules} *) + +module Label : sig + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + val explode : t -> desc + + val nolabel : t + val labelled : string -> t + val optional : string -> t + +end + +(** {2 Provides a unified abstraction over differences in Parsetree.constant and Asttypes.constant + * types defined in ocaml 4.03 and 4.02 respectively}*) +module Constant : sig + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + (** Convert Asttypes.constant to Constant.t *) + val of_constant : Parsetree.constant -> t + + (** Convert Constant.t to Asttypes.constant *) + val to_constant : t -> Parsetree.constant + +end + +(** {2 Misc} *) + +val lid: ?loc:loc -> string -> lid + +(** {2 Expressions} *) + +val evar: ?loc:loc -> ?attrs:attrs -> string -> expression +val let_in: ?loc:loc -> ?attrs:attrs -> ?recursive:bool -> value_binding list -> expression -> expression + +val constr: ?loc:loc -> ?attrs:attrs -> string -> expression list -> expression +val record: ?loc:loc -> ?attrs:attrs -> ?over:expression -> (string * expression) list -> expression +val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val nil: ?loc:loc -> ?attrs:attrs -> unit -> expression +val cons: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression +val list: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val unit: ?loc:loc -> ?attrs:attrs -> unit -> expression + +val func: ?loc:loc -> ?attrs:attrs -> (pattern * expression) list -> expression +val lam: ?loc:loc -> ?attrs:attrs -> ?label:Label.t -> ?default:expression -> pattern -> expression -> expression +val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression + +val str: ?loc:loc -> ?attrs:attrs -> string -> expression +val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val char: ?loc:loc -> ?attrs:attrs -> char -> expression +val float: ?loc:loc -> ?attrs:attrs -> float -> expression + +val sequence: ?loc:loc -> ?attrs:attrs -> expression list -> expression +(** Return [()] if the list is empty. Tail rec. *) + +(** {2 Patterns} *) + +val pvar: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pconstr: ?loc:loc -> ?attrs:attrs -> string -> pattern list -> pattern +val precord: ?loc:loc -> ?attrs:attrs -> ?closed:closed_flag -> (string * pattern) list -> pattern +val ptuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pnil: ?loc:loc -> ?attrs:attrs -> unit -> pattern +val pcons: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern +val plist: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pstr: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pint: ?loc:loc -> ?attrs:attrs -> int -> pattern +val pchar: ?loc:loc -> ?attrs:attrs -> char -> pattern +val pfloat: ?loc:loc -> ?attrs:attrs -> float -> pattern + +val punit: ?loc:loc -> ?attrs:attrs -> unit -> pattern + + +(** {2 Types} *) + +val tconstr: ?loc:loc -> ?attrs:attrs -> string -> core_type list -> core_type + +(** {2 AST deconstruction} *) + +val get_str: expression -> string option +val get_str_with_quotation_delimiter: expression -> (string * string option) option +val get_lid: expression -> string option + +val has_attr: string -> attributes -> bool +val find_attr: string -> attributes -> payload option +val find_attr_expr: string -> attributes -> expression option diff --git a/ast_convenience_404.ml b/ast_convenience_404.ml new file mode 100644 index 0000000..1af2660 --- /dev/null +++ b/ast_convenience_404.ml @@ -0,0 +1,124 @@ +open Ast_404 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +open Parsetree +open Asttypes +open Location +open Ast_helper + + +module Label = struct + + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + let explode x = x + + let nolabel = Nolabel + let labelled x = Labelled x + let optional x = Optional x + +end + +module Constant = struct + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + let of_constant x = x + + let to_constant x = x + +end + +let may_tuple ?loc tup = function + | [] -> None + | [x] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + +let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc +let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) +let nil ?loc ?attrs () = constr ?loc ?attrs "[]" [] +let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] +let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [x] -> x + | xs -> Exp.tuple ?loc ?attrs xs +let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] +let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) +let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Pconst_string (s, None)) +let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let int32 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int32.to_string x, Some 'l')) +let int64 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int64.to_string x, Some 'L')) +let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_char x) +let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) +let record ?loc ?attrs ?over l = + Exp.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.pexp_loc s, e)) l) over +let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) +let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp +let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> Label.nolabel, a) l) +let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) +let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + +let sequence ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl + +let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) +let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) +let precord ?loc ?attrs ?(closed = Open) l = + Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed +let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" [] +let pcons ?loc ?attrs hd tl = pconstr ?loc ?attrs "::" [hd; tl] +let punit ?loc ?attrs () = pconstr ?loc ?attrs "()" [] +let ptuple ?loc ?attrs = function + | [] -> punit ?loc ?attrs () + | [x] -> x + | xs -> Pat.tuple ?loc ?attrs xs +let plist ?loc ?attrs l = List.fold_right (pcons ?loc ?attrs) l (pnil ?loc ?attrs ()) + +let pstr ?loc ?attrs s = Pat.constant ?loc ?attrs (Pconst_string (s, None)) +let pint ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let pchar ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_char x) +let pfloat ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) + +let tconstr ?loc ?attrs c l = Typ.constr ?loc ?attrs (lid ?loc c) l + +let get_str = function + | {pexp_desc=Pexp_constant (Pconst_string (s, _)); _} -> Some s + | _ -> None + +let get_str_with_quotation_delimiter = function + | {pexp_desc=Pexp_constant (Pconst_string (s, d)); _} -> Some (s, d) + | _ -> None + +let get_lid = function + | {pexp_desc=Pexp_ident{txt=id;_};_} -> + Some (String.concat "." (Longident.flatten id)) + | _ -> None + +let find_attr s attrs = + try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs)) + with Not_found -> None + +let expr_of_payload = function + | PStr [{pstr_desc=Pstr_eval(e, _); _}] -> Some e + | _ -> None + +let find_attr_expr s attrs = + match find_attr s attrs with + | Some e -> expr_of_payload e + | None -> None + +let has_attr s attrs = + find_attr s attrs <> None diff --git a/ast_convenience_404.mli b/ast_convenience_404.mli new file mode 100644 index 0000000..75fdf73 --- /dev/null +++ b/ast_convenience_404.mli @@ -0,0 +1,112 @@ +open Ast_404 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** {1 Convenience functions to help build and deconstruct AST fragments.} *) + +open Asttypes +open Ast_helper +open Parsetree + +(** {2 Compatibility modules} *) + +module Label : sig + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + val explode : t -> desc + + val nolabel : t + val labelled : string -> t + val optional : string -> t + +end + +(** {2 Provides a unified abstraction over differences in Parsetree.constant and Asttypes.constant + * types defined in ocaml 4.03 and 4.02 respectively}*) +module Constant : sig + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + (** Convert Asttypes.constant to Constant.t *) + val of_constant : Parsetree.constant -> t + + (** Convert Constant.t to Asttypes.constant *) + val to_constant : t -> Parsetree.constant + +end + +(** {2 Misc} *) + +val lid: ?loc:loc -> string -> lid + +(** {2 Expressions} *) + +val evar: ?loc:loc -> ?attrs:attrs -> string -> expression +val let_in: ?loc:loc -> ?attrs:attrs -> ?recursive:bool -> value_binding list -> expression -> expression + +val constr: ?loc:loc -> ?attrs:attrs -> string -> expression list -> expression +val record: ?loc:loc -> ?attrs:attrs -> ?over:expression -> (string * expression) list -> expression +val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val nil: ?loc:loc -> ?attrs:attrs -> unit -> expression +val cons: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression +val list: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val unit: ?loc:loc -> ?attrs:attrs -> unit -> expression + +val func: ?loc:loc -> ?attrs:attrs -> (pattern * expression) list -> expression +val lam: ?loc:loc -> ?attrs:attrs -> ?label:Label.t -> ?default:expression -> pattern -> expression -> expression +val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression + +val str: ?loc:loc -> ?attrs:attrs -> string -> expression +val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val int32: ?loc:loc -> ?attrs:attrs -> int32 -> expression +val int64: ?loc:loc -> ?attrs:attrs -> int64 -> expression +val char: ?loc:loc -> ?attrs:attrs -> char -> expression +val float: ?loc:loc -> ?attrs:attrs -> float -> expression + +val sequence: ?loc:loc -> ?attrs:attrs -> expression list -> expression +(** Return [()] if the list is empty. Tail rec. *) + +(** {2 Patterns} *) + +val pvar: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pconstr: ?loc:loc -> ?attrs:attrs -> string -> pattern list -> pattern +val precord: ?loc:loc -> ?attrs:attrs -> ?closed:closed_flag -> (string * pattern) list -> pattern +val ptuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pnil: ?loc:loc -> ?attrs:attrs -> unit -> pattern +val pcons: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern +val plist: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pstr: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pint: ?loc:loc -> ?attrs:attrs -> int -> pattern +val pchar: ?loc:loc -> ?attrs:attrs -> char -> pattern +val pfloat: ?loc:loc -> ?attrs:attrs -> float -> pattern + +val punit: ?loc:loc -> ?attrs:attrs -> unit -> pattern + + +(** {2 Types} *) + +val tconstr: ?loc:loc -> ?attrs:attrs -> string -> core_type list -> core_type + +(** {2 AST deconstruction} *) + +val get_str: expression -> string option +val get_str_with_quotation_delimiter: expression -> (string * string option) option +val get_lid: expression -> string option + +val has_attr: string -> attributes -> bool +val find_attr: string -> attributes -> payload option +val find_attr_expr: string -> attributes -> expression option diff --git a/ast_convenience_405.ml b/ast_convenience_405.ml new file mode 100644 index 0000000..a99b712 --- /dev/null +++ b/ast_convenience_405.ml @@ -0,0 +1,124 @@ +open Ast_405 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +open Parsetree +open Asttypes +open Location +open Ast_helper + + +module Label = struct + + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + let explode x = x + + let nolabel = Nolabel + let labelled x = Labelled x + let optional x = Optional x + +end + +module Constant = struct + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + let of_constant x = x + + let to_constant x = x + +end + +let may_tuple ?loc tup = function + | [] -> None + | [x] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + +let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc +let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) +let nil ?loc ?attrs () = constr ?loc ?attrs "[]" [] +let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] +let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [x] -> x + | xs -> Exp.tuple ?loc ?attrs xs +let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] +let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) +let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Pconst_string (s, None)) +let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let int32 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int32.to_string x, Some 'l')) +let int64 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int64.to_string x, Some 'L')) +let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_char x) +let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) +let record ?loc ?attrs ?over l = + Exp.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.pexp_loc s, e)) l) over +let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) +let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp +let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> Label.nolabel, a) l) +let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) +let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + +let sequence ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl + +let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) +let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) +let precord ?loc ?attrs ?(closed = Open) l = + Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed +let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" [] +let pcons ?loc ?attrs hd tl = pconstr ?loc ?attrs "::" [hd; tl] +let punit ?loc ?attrs () = pconstr ?loc ?attrs "()" [] +let ptuple ?loc ?attrs = function + | [] -> punit ?loc ?attrs () + | [x] -> x + | xs -> Pat.tuple ?loc ?attrs xs +let plist ?loc ?attrs l = List.fold_right (pcons ?loc ?attrs) l (pnil ?loc ?attrs ()) + +let pstr ?loc ?attrs s = Pat.constant ?loc ?attrs (Pconst_string (s, None)) +let pint ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let pchar ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_char x) +let pfloat ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) + +let tconstr ?loc ?attrs c l = Typ.constr ?loc ?attrs (lid ?loc c) l + +let get_str = function + | {pexp_desc=Pexp_constant (Pconst_string (s, _)); _} -> Some s + | _ -> None + +let get_str_with_quotation_delimiter = function + | {pexp_desc=Pexp_constant (Pconst_string (s, d)); _} -> Some (s, d) + | _ -> None + +let get_lid = function + | {pexp_desc=Pexp_ident{txt=id;_};_} -> + Some (String.concat "." (Longident.flatten id)) + | _ -> None + +let find_attr s attrs = + try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs)) + with Not_found -> None + +let expr_of_payload = function + | PStr [{pstr_desc=Pstr_eval(e, _); _}] -> Some e + | _ -> None + +let find_attr_expr s attrs = + match find_attr s attrs with + | Some e -> expr_of_payload e + | None -> None + +let has_attr s attrs = + find_attr s attrs <> None diff --git a/ast_convenience_405.mli b/ast_convenience_405.mli new file mode 100644 index 0000000..4e2b6ba --- /dev/null +++ b/ast_convenience_405.mli @@ -0,0 +1,112 @@ +open Ast_405 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** {1 Convenience functions to help build and deconstruct AST fragments.} *) + +open Asttypes +open Ast_helper +open Parsetree + +(** {2 Compatibility modules} *) + +module Label : sig + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + val explode : t -> desc + + val nolabel : t + val labelled : string -> t + val optional : string -> t + +end + +(** {2 Provides a unified abstraction over differences in Parsetree.constant and Asttypes.constant + * types defined in ocaml 4.03 and 4.02 respectively}*) +module Constant : sig + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + (** Convert Asttypes.constant to Constant.t *) + val of_constant : Parsetree.constant -> t + + (** Convert Constant.t to Asttypes.constant *) + val to_constant : t -> Parsetree.constant + +end + +(** {2 Misc} *) + +val lid: ?loc:loc -> string -> lid + +(** {2 Expressions} *) + +val evar: ?loc:loc -> ?attrs:attrs -> string -> expression +val let_in: ?loc:loc -> ?attrs:attrs -> ?recursive:bool -> value_binding list -> expression -> expression + +val constr: ?loc:loc -> ?attrs:attrs -> string -> expression list -> expression +val record: ?loc:loc -> ?attrs:attrs -> ?over:expression -> (string * expression) list -> expression +val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val nil: ?loc:loc -> ?attrs:attrs -> unit -> expression +val cons: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression +val list: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val unit: ?loc:loc -> ?attrs:attrs -> unit -> expression + +val func: ?loc:loc -> ?attrs:attrs -> (pattern * expression) list -> expression +val lam: ?loc:loc -> ?attrs:attrs -> ?label:Label.t -> ?default:expression -> pattern -> expression -> expression +val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression + +val str: ?loc:loc -> ?attrs:attrs -> string -> expression +val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val int32: ?loc:loc -> ?attrs:attrs -> int32 -> expression +val int64: ?loc:loc -> ?attrs:attrs -> int64 -> expression +val char: ?loc:loc -> ?attrs:attrs -> char -> expression +val float: ?loc:loc -> ?attrs:attrs -> float -> expression + +val sequence: ?loc:loc -> ?attrs:attrs -> expression list -> expression +(** Return [()] if the list is empty. Tail rec. *) + +(** {2 Patterns} *) + +val pvar: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pconstr: ?loc:loc -> ?attrs:attrs -> string -> pattern list -> pattern +val precord: ?loc:loc -> ?attrs:attrs -> ?closed:closed_flag -> (string * pattern) list -> pattern +val ptuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pnil: ?loc:loc -> ?attrs:attrs -> unit -> pattern +val pcons: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern +val plist: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pstr: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pint: ?loc:loc -> ?attrs:attrs -> int -> pattern +val pchar: ?loc:loc -> ?attrs:attrs -> char -> pattern +val pfloat: ?loc:loc -> ?attrs:attrs -> float -> pattern + +val punit: ?loc:loc -> ?attrs:attrs -> unit -> pattern + + +(** {2 Types} *) + +val tconstr: ?loc:loc -> ?attrs:attrs -> string -> core_type list -> core_type + +(** {2 AST deconstruction} *) + +val get_str: expression -> string option +val get_str_with_quotation_delimiter: expression -> (string * string option) option +val get_lid: expression -> string option + +val has_attr: string -> attributes -> bool +val find_attr: string -> attributes -> payload option +val find_attr_expr: string -> attributes -> expression option diff --git a/ast_convenience_406.ml b/ast_convenience_406.ml new file mode 100644 index 0000000..7a8f2d0 --- /dev/null +++ b/ast_convenience_406.ml @@ -0,0 +1,124 @@ +open Ast_406 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +open Parsetree +open Asttypes +open Location +open Ast_helper + + +module Label = struct + + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + let explode x = x + + let nolabel = Nolabel + let labelled x = Labelled x + let optional x = Optional x + +end + +module Constant = struct + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + let of_constant x = x + + let to_constant x = x + +end + +let may_tuple ?loc tup = function + | [] -> None + | [x] -> Some x + | l -> Some (tup ?loc ?attrs:None l) + +let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc +let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) +let nil ?loc ?attrs () = constr ?loc ?attrs "[]" [] +let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] +let tuple ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | [x] -> x + | xs -> Exp.tuple ?loc ?attrs xs +let cons ?loc ?attrs hd tl = constr ?loc ?attrs "::" [hd; tl] +let list ?loc ?attrs l = List.fold_right (cons ?loc ?attrs) l (nil ?loc ?attrs ()) +let str ?loc ?attrs s = Exp.constant ?loc ?attrs (Pconst_string (s, None)) +let int ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let int32 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int32.to_string x, Some 'l')) +let int64 ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_integer (Int64.to_string x, Some 'L')) +let char ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_char x) +let float ?loc ?attrs x = Exp.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) +let record ?loc ?attrs ?over l = + Exp.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.pexp_loc s, e)) l) over +let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) +let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp +let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> Label.nolabel, a) l) +let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) +let let_in ?loc ?attrs ?(recursive = false) b body = + Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body + +let sequence ?loc ?attrs = function + | [] -> unit ?loc ?attrs () + | hd :: tl -> List.fold_left (fun e1 e2 -> Exp.sequence ?loc ?attrs e1 e2) hd tl + +let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) +let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) +let precord ?loc ?attrs ?(closed = Open) l = + Pat.record ?loc ?attrs (List.map (fun (s, e) -> (lid ~loc:e.ppat_loc s, e)) l) closed +let pnil ?loc ?attrs () = pconstr ?loc ?attrs "[]" [] +let pcons ?loc ?attrs hd tl = pconstr ?loc ?attrs "::" [hd; tl] +let punit ?loc ?attrs () = pconstr ?loc ?attrs "()" [] +let ptuple ?loc ?attrs = function + | [] -> punit ?loc ?attrs () + | [x] -> x + | xs -> Pat.tuple ?loc ?attrs xs +let plist ?loc ?attrs l = List.fold_right (pcons ?loc ?attrs) l (pnil ?loc ?attrs ()) + +let pstr ?loc ?attrs s = Pat.constant ?loc ?attrs (Pconst_string (s, None)) +let pint ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_integer (string_of_int x, None)) +let pchar ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_char x) +let pfloat ?loc ?attrs x = Pat.constant ?loc ?attrs (Pconst_float (string_of_float x, None)) + +let tconstr ?loc ?attrs c l = Typ.constr ?loc ?attrs (lid ?loc c) l + +let get_str = function + | {pexp_desc=Pexp_constant (Pconst_string (s, _)); _} -> Some s + | _ -> None + +let get_str_with_quotation_delimiter = function + | {pexp_desc=Pexp_constant (Pconst_string (s, d)); _} -> Some (s, d) + | _ -> None + +let get_lid = function + | {pexp_desc=Pexp_ident{txt=id;_};_} -> + Some (String.concat "." (Longident.flatten id)) + | _ -> None + +let find_attr s attrs = + try Some (snd (List.find (fun (x, _) -> x.txt = s) attrs)) + with Not_found -> None + +let expr_of_payload = function + | PStr [{pstr_desc=Pstr_eval(e, _); _}] -> Some e + | _ -> None + +let find_attr_expr s attrs = + match find_attr s attrs with + | Some e -> expr_of_payload e + | None -> None + +let has_attr s attrs = + find_attr s attrs <> None diff --git a/ast_convenience_406.mli b/ast_convenience_406.mli new file mode 100644 index 0000000..43da159 --- /dev/null +++ b/ast_convenience_406.mli @@ -0,0 +1,112 @@ +open Ast_406 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** {1 Convenience functions to help build and deconstruct AST fragments.} *) + +open Asttypes +open Ast_helper +open Parsetree + +(** {2 Compatibility modules} *) + +module Label : sig + type t = Asttypes.arg_label + + type desc = Asttypes.arg_label = + Nolabel + | Labelled of string + | Optional of string + + val explode : t -> desc + + val nolabel : t + val labelled : string -> t + val optional : string -> t + +end + +(** {2 Provides a unified abstraction over differences in Parsetree.constant and Asttypes.constant + * types defined in ocaml 4.03 and 4.02 respectively}*) +module Constant : sig + type t = Parsetree.constant = + Pconst_integer of string * char option + | Pconst_char of char + | Pconst_string of string * string option + | Pconst_float of string * char option + + (** Convert Asttypes.constant to Constant.t *) + val of_constant : Parsetree.constant -> t + + (** Convert Constant.t to Asttypes.constant *) + val to_constant : t -> Parsetree.constant + +end + +(** {2 Misc} *) + +val lid: ?loc:loc -> string -> lid + +(** {2 Expressions} *) + +val evar: ?loc:loc -> ?attrs:attrs -> string -> expression +val let_in: ?loc:loc -> ?attrs:attrs -> ?recursive:bool -> value_binding list -> expression -> expression + +val constr: ?loc:loc -> ?attrs:attrs -> string -> expression list -> expression +val record: ?loc:loc -> ?attrs:attrs -> ?over:expression -> (string * expression) list -> expression +val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val nil: ?loc:loc -> ?attrs:attrs -> unit -> expression +val cons: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression +val list: ?loc:loc -> ?attrs:attrs -> expression list -> expression + +val unit: ?loc:loc -> ?attrs:attrs -> unit -> expression + +val func: ?loc:loc -> ?attrs:attrs -> (pattern * expression) list -> expression +val lam: ?loc:loc -> ?attrs:attrs -> ?label:Label.t -> ?default:expression -> pattern -> expression -> expression +val app: ?loc:loc -> ?attrs:attrs -> expression -> expression list -> expression + +val str: ?loc:loc -> ?attrs:attrs -> string -> expression +val int: ?loc:loc -> ?attrs:attrs -> int -> expression +val int32: ?loc:loc -> ?attrs:attrs -> int32 -> expression +val int64: ?loc:loc -> ?attrs:attrs -> int64 -> expression +val char: ?loc:loc -> ?attrs:attrs -> char -> expression +val float: ?loc:loc -> ?attrs:attrs -> float -> expression + +val sequence: ?loc:loc -> ?attrs:attrs -> expression list -> expression +(** Return [()] if the list is empty. Tail rec. *) + +(** {2 Patterns} *) + +val pvar: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pconstr: ?loc:loc -> ?attrs:attrs -> string -> pattern list -> pattern +val precord: ?loc:loc -> ?attrs:attrs -> ?closed:closed_flag -> (string * pattern) list -> pattern +val ptuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pnil: ?loc:loc -> ?attrs:attrs -> unit -> pattern +val pcons: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern +val plist: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern + +val pstr: ?loc:loc -> ?attrs:attrs -> string -> pattern +val pint: ?loc:loc -> ?attrs:attrs -> int -> pattern +val pchar: ?loc:loc -> ?attrs:attrs -> char -> pattern +val pfloat: ?loc:loc -> ?attrs:attrs -> float -> pattern + +val punit: ?loc:loc -> ?attrs:attrs -> unit -> pattern + + +(** {2 Types} *) + +val tconstr: ?loc:loc -> ?attrs:attrs -> string -> core_type list -> core_type + +(** {2 AST deconstruction} *) + +val get_str: expression -> string option +val get_str_with_quotation_delimiter: expression -> (string * string option) option +val get_lid: expression -> string option + +val has_attr: string -> attributes -> bool +val find_attr: string -> attributes -> payload option +val find_attr_expr: string -> attributes -> expression option diff --git a/ast_lifter_402.ml b/ast_lifter_402.ml new file mode 100644 index 0000000..8b44f8b --- /dev/null +++ b/ast_lifter_402.ml @@ -0,0 +1,1353 @@ +open Ast_402 + +class virtual ['res] lifter = + object (this) + method lift_Parsetree_expression : Parsetree.expression -> 'res= + (fun + { Parsetree.pexp_desc = pexp_desc; Parsetree.pexp_loc = pexp_loc; + Parsetree.pexp_attributes = pexp_attributes } + -> + this#record "Ast_402.Parsetree.expression" + [("pexp_desc", (this#lift_Parsetree_expression_desc pexp_desc)); + ("pexp_loc", (this#lift_Location_t pexp_loc)); + ("pexp_attributes", + (this#lift_Parsetree_attributes pexp_attributes))] : Parsetree.expression + -> + 'res) + method lift_Parsetree_expression_desc : + Parsetree.expression_desc -> 'res= + (function + | Parsetree.Pexp_ident x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_constant x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_constant", [this#lift_Asttypes_constant x0]) + | Parsetree.Pexp_let (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_function x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_function", + [this#list (List.map this#lift_Parsetree_case x0)]) + | Parsetree.Pexp_fun (x0,x1,x2,x3) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_fun", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_expression x3]) + | Parsetree.Pexp_apply (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_apply", + [this#lift_Parsetree_expression x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pexp_match (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_match", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_try (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_try", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_tuple x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_tuple", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_construct (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_variant (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_record (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_expression x1]) x0); + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_field (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_field", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pexp_setfield (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_setfield", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_array x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_array", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_ifthenelse", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1; + this#lift_option this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_sequence (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_sequence", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_while (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_while", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_for", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_expression x1; + this#lift_Parsetree_expression x2; + this#lift_Asttypes_direction_flag x3; + this#lift_Parsetree_expression x4]) + | Parsetree.Pexp_constraint (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_constraint", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_coerce (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_coerce", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Pexp_send (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_send", + [this#lift_Parsetree_expression x0; this#string x1]) + | Parsetree.Pexp_new x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_new", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_setinstvar (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_setinstvar", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_override x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_override", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) x0)]) + | Parsetree.Pexp_letmodule (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_letmodule", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_module_expr x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_assert x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_assert", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_lazy x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_lazy", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_poly (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_poly", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_object x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_object", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pexp_newtype (x0,x1) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_newtype", + [this#string x0; this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_pack x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_pack", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pexp_open (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_extension x0 -> + this#constr "Ast_402.Parsetree.expression_desc" + ("Pexp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.expression_desc -> 'res) + method lift_Asttypes_direction_flag : Asttypes.direction_flag -> 'res= + (function + | Asttypes.Upto -> this#constr "Ast_402.Asttypes.direction_flag" ("Upto", []) + | Asttypes.Downto -> + this#constr "Ast_402.Asttypes.direction_flag" ("Downto", []) : Asttypes.direction_flag + -> + 'res) + method lift_Parsetree_case : Parsetree.case -> 'res= + (fun + { Parsetree.pc_lhs = pc_lhs; Parsetree.pc_guard = pc_guard; + Parsetree.pc_rhs = pc_rhs } + -> + this#record "Ast_402.Parsetree.case" + [("pc_lhs", (this#lift_Parsetree_pattern pc_lhs)); + ("pc_guard", + (this#lift_option this#lift_Parsetree_expression pc_guard)); + ("pc_rhs", (this#lift_Parsetree_expression pc_rhs))] : Parsetree.case + -> + 'res) + method lift_Parsetree_value_binding : Parsetree.value_binding -> 'res= + (fun + { Parsetree.pvb_pat = pvb_pat; Parsetree.pvb_expr = pvb_expr; + Parsetree.pvb_attributes = pvb_attributes; + Parsetree.pvb_loc = pvb_loc } + -> + this#record "Ast_402.Parsetree.value_binding" + [("pvb_pat", (this#lift_Parsetree_pattern pvb_pat)); + ("pvb_expr", (this#lift_Parsetree_expression pvb_expr)); + ("pvb_attributes", + (this#lift_Parsetree_attributes pvb_attributes)); + ("pvb_loc", (this#lift_Location_t pvb_loc))] : Parsetree.value_binding + -> 'res) + method lift_Parsetree_pattern : Parsetree.pattern -> 'res= + (fun + { Parsetree.ppat_desc = ppat_desc; Parsetree.ppat_loc = ppat_loc; + Parsetree.ppat_attributes = ppat_attributes } + -> + this#record "Ast_402.Parsetree.pattern" + [("ppat_desc", (this#lift_Parsetree_pattern_desc ppat_desc)); + ("ppat_loc", (this#lift_Location_t ppat_loc)); + ("ppat_attributes", + (this#lift_Parsetree_attributes ppat_attributes))] : Parsetree.pattern + -> + 'res) + method lift_Parsetree_pattern_desc : Parsetree.pattern_desc -> 'res= + (function + | Parsetree.Ppat_any -> + this#constr "Ast_402.Parsetree.pattern_desc" ("Ppat_any", []) + | Parsetree.Ppat_var x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_var", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_alias (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_alias", + [this#lift_Parsetree_pattern x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Ppat_constant x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_constant", [this#lift_Asttypes_constant x0]) + | Parsetree.Ppat_interval (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_interval", + [this#lift_Asttypes_constant x0; + this#lift_Asttypes_constant x1]) + | Parsetree.Ppat_tuple x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_tuple", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_construct (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_variant (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_record (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ppat_array x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_array", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_or (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_or", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_constraint (x0,x1) -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_constraint", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Ppat_type x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_type", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Ppat_lazy x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_lazy", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_unpack x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_unpack", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_exception x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_exception", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_extension x0 -> + this#constr "Ast_402.Parsetree.pattern_desc" + ("Ppat_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.pattern_desc -> 'res) + method lift_Parsetree_core_type : Parsetree.core_type -> 'res= + (fun + { Parsetree.ptyp_desc = ptyp_desc; Parsetree.ptyp_loc = ptyp_loc; + Parsetree.ptyp_attributes = ptyp_attributes } + -> + this#record "Ast_402.Parsetree.core_type" + [("ptyp_desc", (this#lift_Parsetree_core_type_desc ptyp_desc)); + ("ptyp_loc", (this#lift_Location_t ptyp_loc)); + ("ptyp_attributes", + (this#lift_Parsetree_attributes ptyp_attributes))] : Parsetree.core_type + -> + 'res) + method lift_Parsetree_core_type_desc : Parsetree.core_type_desc -> 'res= + (function + | Parsetree.Ptyp_any -> + this#constr "Ast_402.Parsetree.core_type_desc" ("Ptyp_any", []) + | Parsetree.Ptyp_var x0 -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_var", [this#string x0]) + | Parsetree.Ptyp_arrow (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_arrow", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Ptyp_tuple x0 -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Ptyp_constr (x0,x1) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_object (x0,x1) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_object", + [this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#string x0; + this#lift_Parsetree_attributes x1; + this#lift_Parsetree_core_type x2]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ptyp_class (x0,x1) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_class", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_alias (x0,x1) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_alias", + [this#lift_Parsetree_core_type x0; this#string x1]) + | Parsetree.Ptyp_variant (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_variant", + [this#list (List.map this#lift_Parsetree_row_field x0); + this#lift_Asttypes_closed_flag x1; + this#lift_option + (fun x -> this#list (List.map this#lift_Asttypes_label x)) + x2]) + | Parsetree.Ptyp_poly (x0,x1) -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_poly", + [this#list (List.map this#string x0); + this#lift_Parsetree_core_type x1]) + | Parsetree.Ptyp_package x0 -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_package", [this#lift_Parsetree_package_type x0]) + | Parsetree.Ptyp_extension x0 -> + this#constr "Ast_402.Parsetree.core_type_desc" + ("Ptyp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.core_type_desc -> 'res) + method lift_Parsetree_package_type : Parsetree.package_type -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_core_type x1]) x1)] : Parsetree.package_type + -> 'res) + method lift_Parsetree_row_field : Parsetree.row_field -> 'res= + (function + | Parsetree.Rtag (x0,x1,x2,x3) -> + this#constr "Ast_402.Parsetree.row_field" + ("Rtag", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_bool x2; + this#list (List.map this#lift_Parsetree_core_type x3)]) + | Parsetree.Rinherit x0 -> + this#constr "Ast_402.Parsetree.row_field" + ("Rinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.row_field + -> + 'res) + method lift_Parsetree_attributes : Parsetree.attributes -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_attribute x) : + Parsetree.attributes -> 'res) + method lift_Parsetree_attribute : Parsetree.attribute -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.attribute -> 'res) + method lift_Parsetree_payload : Parsetree.payload -> 'res= + (function + | Parsetree.PStr x0 -> + this#constr "Ast_402.Parsetree.payload" + ("PStr", [this#lift_Parsetree_structure x0]) + | Parsetree.PTyp x0 -> + this#constr "Ast_402.Parsetree.payload" + ("PTyp", [this#lift_Parsetree_core_type x0]) + | Parsetree.PPat (x0,x1) -> + this#constr "Ast_402.Parsetree.payload" + ("PPat", + [this#lift_Parsetree_pattern x0; + this#lift_option this#lift_Parsetree_expression x1]) : + Parsetree.payload -> 'res) + method lift_Parsetree_structure : Parsetree.structure -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_structure_item x) : + Parsetree.structure -> 'res) + method lift_Parsetree_structure_item : Parsetree.structure_item -> 'res= + (fun { Parsetree.pstr_desc = pstr_desc; Parsetree.pstr_loc = pstr_loc } + -> + this#record "Ast_402.Parsetree.structure_item" + [("pstr_desc", + (this#lift_Parsetree_structure_item_desc pstr_desc)); + ("pstr_loc", (this#lift_Location_t pstr_loc))] : Parsetree.structure_item + -> 'res) + method lift_Parsetree_structure_item_desc : + Parsetree.structure_item_desc -> 'res= + (function + | Parsetree.Pstr_eval (x0,x1) -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_eval", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_attributes x1]) + | Parsetree.Pstr_value (x0,x1) -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_value", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1)]) + | Parsetree.Pstr_primitive x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_primitive", [this#lift_Parsetree_value_description x0]) + | Parsetree.Pstr_type x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_type", + [this#list (List.map this#lift_Parsetree_type_declaration x0)]) + | Parsetree.Pstr_typext x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Pstr_exception x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Pstr_module x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_module", [this#lift_Parsetree_module_binding x0]) + | Parsetree.Pstr_recmodule x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_recmodule", + [this#list (List.map this#lift_Parsetree_module_binding x0)]) + | Parsetree.Pstr_modtype x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Pstr_open x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Pstr_class x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_class", + [this#list (List.map this#lift_Parsetree_class_declaration x0)]) + | Parsetree.Pstr_class_type x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Pstr_include x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_include", [this#lift_Parsetree_include_declaration x0]) + | Parsetree.Pstr_attribute x0 -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pstr_extension (x0,x1) -> + this#constr "Ast_402.Parsetree.structure_item_desc" + ("Pstr_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.structure_item_desc + -> 'res) + method lift_Parsetree_include_declaration : + Parsetree.include_declaration -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_expr x : + Parsetree.include_declaration -> 'res) + method lift_Parsetree_class_declaration : + Parsetree.class_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_expr x : + Parsetree.class_declaration -> 'res) + method lift_Parsetree_class_expr : Parsetree.class_expr -> 'res= + (fun + { Parsetree.pcl_desc = pcl_desc; Parsetree.pcl_loc = pcl_loc; + Parsetree.pcl_attributes = pcl_attributes } + -> + this#record "Ast_402.Parsetree.class_expr" + [("pcl_desc", (this#lift_Parsetree_class_expr_desc pcl_desc)); + ("pcl_loc", (this#lift_Location_t pcl_loc)); + ("pcl_attributes", + (this#lift_Parsetree_attributes pcl_attributes))] : Parsetree.class_expr + -> + 'res) + method lift_Parsetree_class_expr_desc : + Parsetree.class_expr_desc -> 'res= + (function + | Parsetree.Pcl_constr (x0,x1) -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcl_structure x0 -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_structure", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pcl_fun (x0,x1,x2,x3) -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_fun", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_class_expr x3]) + | Parsetree.Pcl_apply (x0,x1) -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_apply", + [this#lift_Parsetree_class_expr x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pcl_let (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_class_expr x2]) + | Parsetree.Pcl_constraint (x0,x1) -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_constraint", + [this#lift_Parsetree_class_expr x0; + this#lift_Parsetree_class_type x1]) + | Parsetree.Pcl_extension x0 -> + this#constr "Ast_402.Parsetree.class_expr_desc" + ("Pcl_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_expr_desc -> 'res) + method lift_Parsetree_class_structure : + Parsetree.class_structure -> 'res= + (fun + { Parsetree.pcstr_self = pcstr_self; + Parsetree.pcstr_fields = pcstr_fields } + -> + this#record "Ast_402.Parsetree.class_structure" + [("pcstr_self", (this#lift_Parsetree_pattern pcstr_self)); + ("pcstr_fields", + (this#list + (List.map this#lift_Parsetree_class_field pcstr_fields)))] : + Parsetree.class_structure -> 'res) + method lift_Parsetree_class_field : Parsetree.class_field -> 'res= + (fun + { Parsetree.pcf_desc = pcf_desc; Parsetree.pcf_loc = pcf_loc; + Parsetree.pcf_attributes = pcf_attributes } + -> + this#record "Ast_402.Parsetree.class_field" + [("pcf_desc", (this#lift_Parsetree_class_field_desc pcf_desc)); + ("pcf_loc", (this#lift_Location_t pcf_loc)); + ("pcf_attributes", + (this#lift_Parsetree_attributes pcf_attributes))] : Parsetree.class_field + -> + 'res) + method lift_Parsetree_class_field_desc : + Parsetree.class_field_desc -> 'res= + (function + | Parsetree.Pcf_inherit (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_inherit", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_class_expr x1; + this#lift_option this#string x2]) + | Parsetree.Pcf_val x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_val", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_method x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_method", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_constraint x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pcf_initializer x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_initializer", [this#lift_Parsetree_expression x0]) + | Parsetree.Pcf_attribute x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pcf_extension x0 -> + this#constr "Ast_402.Parsetree.class_field_desc" + ("Pcf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_field_desc -> 'res) + method lift_Parsetree_class_field_kind : + Parsetree.class_field_kind -> 'res= + (function + | Parsetree.Cfk_virtual x0 -> + this#constr "Ast_402.Parsetree.class_field_kind" + ("Cfk_virtual", [this#lift_Parsetree_core_type x0]) + | Parsetree.Cfk_concrete (x0,x1) -> + this#constr "Ast_402.Parsetree.class_field_kind" + ("Cfk_concrete", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_expression x1]) : Parsetree.class_field_kind + -> 'res) + method lift_Parsetree_module_binding : Parsetree.module_binding -> 'res= + (fun + { Parsetree.pmb_name = pmb_name; Parsetree.pmb_expr = pmb_expr; + Parsetree.pmb_attributes = pmb_attributes; + Parsetree.pmb_loc = pmb_loc } + -> + this#record "Ast_402.Parsetree.module_binding" + [("pmb_name", (this#lift_Asttypes_loc this#string pmb_name)); + ("pmb_expr", (this#lift_Parsetree_module_expr pmb_expr)); + ("pmb_attributes", + (this#lift_Parsetree_attributes pmb_attributes)); + ("pmb_loc", (this#lift_Location_t pmb_loc))] : Parsetree.module_binding + -> 'res) + method lift_Parsetree_module_expr : Parsetree.module_expr -> 'res= + (fun + { Parsetree.pmod_desc = pmod_desc; Parsetree.pmod_loc = pmod_loc; + Parsetree.pmod_attributes = pmod_attributes } + -> + this#record "Ast_402.Parsetree.module_expr" + [("pmod_desc", (this#lift_Parsetree_module_expr_desc pmod_desc)); + ("pmod_loc", (this#lift_Location_t pmod_loc)); + ("pmod_attributes", + (this#lift_Parsetree_attributes pmod_attributes))] : Parsetree.module_expr + -> + 'res) + method lift_Parsetree_module_expr_desc : + Parsetree.module_expr_desc -> 'res= + (function + | Parsetree.Pmod_ident x0 -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmod_structure x0 -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_structure", [this#lift_Parsetree_structure x0]) + | Parsetree.Pmod_functor (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_expr x2]) + | Parsetree.Pmod_apply (x0,x1) -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_apply", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_expr x1]) + | Parsetree.Pmod_constraint (x0,x1) -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_constraint", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_type x1]) + | Parsetree.Pmod_unpack x0 -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_unpack", [this#lift_Parsetree_expression x0]) + | Parsetree.Pmod_extension x0 -> + this#constr "Ast_402.Parsetree.module_expr_desc" + ("Pmod_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.module_expr_desc -> 'res) + method lift_Parsetree_module_type : Parsetree.module_type -> 'res= + (fun + { Parsetree.pmty_desc = pmty_desc; Parsetree.pmty_loc = pmty_loc; + Parsetree.pmty_attributes = pmty_attributes } + -> + this#record "Ast_402.Parsetree.module_type" + [("pmty_desc", (this#lift_Parsetree_module_type_desc pmty_desc)); + ("pmty_loc", (this#lift_Location_t pmty_loc)); + ("pmty_attributes", + (this#lift_Parsetree_attributes pmty_attributes))] : Parsetree.module_type + -> + 'res) + method lift_Parsetree_module_type_desc : + Parsetree.module_type_desc -> 'res= + (function + | Parsetree.Pmty_ident x0 -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmty_signature x0 -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_signature", [this#lift_Parsetree_signature x0]) + | Parsetree.Pmty_functor (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_type x2]) + | Parsetree.Pmty_with (x0,x1) -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_with", + [this#lift_Parsetree_module_type x0; + this#list (List.map this#lift_Parsetree_with_constraint x1)]) + | Parsetree.Pmty_typeof x0 -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_typeof", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pmty_extension x0 -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pmty_alias x0 -> + this#constr "Ast_402.Parsetree.module_type_desc" + ("Pmty_alias", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.module_type_desc + -> + 'res) + method lift_Parsetree_with_constraint : + Parsetree.with_constraint -> 'res= + (function + | Parsetree.Pwith_type (x0,x1) -> + this#constr "Ast_402.Parsetree.with_constraint" + ("Pwith_type", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_module (x0,x1) -> + this#constr "Ast_402.Parsetree.with_constraint" + ("Pwith_module", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pwith_typesubst x0 -> + this#constr "Ast_402.Parsetree.with_constraint" + ("Pwith_typesubst", [this#lift_Parsetree_type_declaration x0]) + | Parsetree.Pwith_modsubst (x0,x1) -> + this#constr "Ast_402.Parsetree.with_constraint" + ("Pwith_modsubst", + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) : Parsetree.with_constraint + -> + 'res) + method lift_Parsetree_signature : Parsetree.signature -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_signature_item x) : + Parsetree.signature -> 'res) + method lift_Parsetree_signature_item : Parsetree.signature_item -> 'res= + (fun { Parsetree.psig_desc = psig_desc; Parsetree.psig_loc = psig_loc } + -> + this#record "Ast_402.Parsetree.signature_item" + [("psig_desc", + (this#lift_Parsetree_signature_item_desc psig_desc)); + ("psig_loc", (this#lift_Location_t psig_loc))] : Parsetree.signature_item + -> 'res) + method lift_Parsetree_signature_item_desc : + Parsetree.signature_item_desc -> 'res= + (function + | Parsetree.Psig_value x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_value", [this#lift_Parsetree_value_description x0]) + | Parsetree.Psig_type x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_type", + [this#list (List.map this#lift_Parsetree_type_declaration x0)]) + | Parsetree.Psig_typext x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Psig_exception x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Psig_module x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_module", [this#lift_Parsetree_module_declaration x0]) + | Parsetree.Psig_recmodule x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_recmodule", + [this#list + (List.map this#lift_Parsetree_module_declaration x0)]) + | Parsetree.Psig_modtype x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Psig_open x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Psig_include x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_include", [this#lift_Parsetree_include_description x0]) + | Parsetree.Psig_class x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_class", + [this#list (List.map this#lift_Parsetree_class_description x0)]) + | Parsetree.Psig_class_type x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Psig_attribute x0 -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Psig_extension (x0,x1) -> + this#constr "Ast_402.Parsetree.signature_item_desc" + ("Psig_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.signature_item_desc + -> 'res) + method lift_Parsetree_class_type_declaration : + Parsetree.class_type_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_type_declaration -> 'res) + method lift_Parsetree_class_description : + Parsetree.class_description -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_description -> 'res) + method lift_Parsetree_class_type : Parsetree.class_type -> 'res= + (fun + { Parsetree.pcty_desc = pcty_desc; Parsetree.pcty_loc = pcty_loc; + Parsetree.pcty_attributes = pcty_attributes } + -> + this#record "Ast_402.Parsetree.class_type" + [("pcty_desc", (this#lift_Parsetree_class_type_desc pcty_desc)); + ("pcty_loc", (this#lift_Location_t pcty_loc)); + ("pcty_attributes", + (this#lift_Parsetree_attributes pcty_attributes))] : Parsetree.class_type + -> + 'res) + method lift_Parsetree_class_type_desc : + Parsetree.class_type_desc -> 'res= + (function + | Parsetree.Pcty_constr (x0,x1) -> + this#constr "Ast_402.Parsetree.class_type_desc" + ("Pcty_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcty_signature x0 -> + this#constr "Ast_402.Parsetree.class_type_desc" + ("Pcty_signature", [this#lift_Parsetree_class_signature x0]) + | Parsetree.Pcty_arrow (x0,x1,x2) -> + this#constr "Ast_402.Parsetree.class_type_desc" + ("Pcty_arrow", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_class_type x2]) + | Parsetree.Pcty_extension x0 -> + this#constr "Ast_402.Parsetree.class_type_desc" + ("Pcty_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_desc -> 'res) + method lift_Parsetree_class_signature : + Parsetree.class_signature -> 'res= + (fun + { Parsetree.pcsig_self = pcsig_self; + Parsetree.pcsig_fields = pcsig_fields } + -> + this#record "Ast_402.Parsetree.class_signature" + [("pcsig_self", (this#lift_Parsetree_core_type pcsig_self)); + ("pcsig_fields", + (this#list + (List.map this#lift_Parsetree_class_type_field pcsig_fields)))] : + Parsetree.class_signature -> 'res) + method lift_Parsetree_class_type_field : + Parsetree.class_type_field -> 'res= + (fun + { Parsetree.pctf_desc = pctf_desc; Parsetree.pctf_loc = pctf_loc; + Parsetree.pctf_attributes = pctf_attributes } + -> + this#record "Ast_402.Parsetree.class_type_field" + [("pctf_desc", + (this#lift_Parsetree_class_type_field_desc pctf_desc)); + ("pctf_loc", (this#lift_Location_t pctf_loc)); + ("pctf_attributes", + (this#lift_Parsetree_attributes pctf_attributes))] : Parsetree.class_type_field + -> + 'res) + method lift_Parsetree_class_type_field_desc : + Parsetree.class_type_field_desc -> 'res= + (function + | Parsetree.Pctf_inherit x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_inherit", [this#lift_Parsetree_class_type x0]) + | Parsetree.Pctf_val x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_val", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_method x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_method", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_constraint x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pctf_attribute x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pctf_extension x0 -> + this#constr "Ast_402.Parsetree.class_type_field_desc" + ("Pctf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_field_desc -> 'res) + method lift_Parsetree_extension : Parsetree.extension -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.extension -> 'res) + method lift_Parsetree_class_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.class_infos -> 'res= fun (type f0) + -> + (fun f0 -> + fun + { Parsetree.pci_virt = pci_virt; + Parsetree.pci_params = pci_params; + Parsetree.pci_name = pci_name; Parsetree.pci_expr = pci_expr; + Parsetree.pci_loc = pci_loc; + Parsetree.pci_attributes = pci_attributes } + -> + this#record "Ast_402.Parsetree.class_infos" + [("pci_virt", (this#lift_Asttypes_virtual_flag pci_virt)); + ("pci_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) pci_params))); + ("pci_name", (this#lift_Asttypes_loc this#string pci_name)); + ("pci_expr", (f0 pci_expr)); + ("pci_loc", (this#lift_Location_t pci_loc)); + ("pci_attributes", + (this#lift_Parsetree_attributes pci_attributes))] : (f0 -> + 'res) -> + f0 + Parsetree.class_infos + -> + 'res) + method lift_Asttypes_virtual_flag : Asttypes.virtual_flag -> 'res= + (function + | Asttypes.Virtual -> + this#constr "Ast_402.Asttypes.virtual_flag" ("Virtual", []) + | Asttypes.Concrete -> + this#constr "Ast_402.Asttypes.virtual_flag" ("Concrete", []) : Asttypes.virtual_flag + -> + 'res) + method lift_Parsetree_include_description : + Parsetree.include_description -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_type x : + Parsetree.include_description -> 'res) + method lift_Parsetree_include_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.include_infos -> 'res= fun (type + f0) -> + (fun f0 -> + fun + { Parsetree.pincl_mod = pincl_mod; + Parsetree.pincl_loc = pincl_loc; + Parsetree.pincl_attributes = pincl_attributes } + -> + this#record "Ast_402.Parsetree.include_infos" + [("pincl_mod", (f0 pincl_mod)); + ("pincl_loc", (this#lift_Location_t pincl_loc)); + ("pincl_attributes", + (this#lift_Parsetree_attributes pincl_attributes))] : + (f0 -> 'res) -> f0 Parsetree.include_infos -> 'res) + method lift_Parsetree_open_description : + Parsetree.open_description -> 'res= + (fun + { Parsetree.popen_lid = popen_lid; + Parsetree.popen_override = popen_override; + Parsetree.popen_loc = popen_loc; + Parsetree.popen_attributes = popen_attributes } + -> + this#record "Ast_402.Parsetree.open_description" + [("popen_lid", + (this#lift_Asttypes_loc this#lift_Longident_t popen_lid)); + ("popen_override", + (this#lift_Asttypes_override_flag popen_override)); + ("popen_loc", (this#lift_Location_t popen_loc)); + ("popen_attributes", + (this#lift_Parsetree_attributes popen_attributes))] : Parsetree.open_description + -> + 'res) + method lift_Asttypes_override_flag : Asttypes.override_flag -> 'res= + (function + | Asttypes.Override -> + this#constr "Ast_402.Asttypes.override_flag" ("Override", []) + | Asttypes.Fresh -> + this#constr "Ast_402.Asttypes.override_flag" ("Fresh", []) : Asttypes.override_flag + -> + 'res) + method lift_Parsetree_module_type_declaration : + Parsetree.module_type_declaration -> 'res= + (fun + { Parsetree.pmtd_name = pmtd_name; Parsetree.pmtd_type = pmtd_type; + Parsetree.pmtd_attributes = pmtd_attributes; + Parsetree.pmtd_loc = pmtd_loc } + -> + this#record "Ast_402.Parsetree.module_type_declaration" + [("pmtd_name", (this#lift_Asttypes_loc this#string pmtd_name)); + ("pmtd_type", + (this#lift_option this#lift_Parsetree_module_type pmtd_type)); + ("pmtd_attributes", + (this#lift_Parsetree_attributes pmtd_attributes)); + ("pmtd_loc", (this#lift_Location_t pmtd_loc))] : Parsetree.module_type_declaration + -> 'res) + method lift_Parsetree_module_declaration : + Parsetree.module_declaration -> 'res= + (fun + { Parsetree.pmd_name = pmd_name; Parsetree.pmd_type = pmd_type; + Parsetree.pmd_attributes = pmd_attributes; + Parsetree.pmd_loc = pmd_loc } + -> + this#record "Ast_402.Parsetree.module_declaration" + [("pmd_name", (this#lift_Asttypes_loc this#string pmd_name)); + ("pmd_type", (this#lift_Parsetree_module_type pmd_type)); + ("pmd_attributes", + (this#lift_Parsetree_attributes pmd_attributes)); + ("pmd_loc", (this#lift_Location_t pmd_loc))] : Parsetree.module_declaration + -> 'res) + method lift_Parsetree_type_extension : Parsetree.type_extension -> 'res= + (fun + { Parsetree.ptyext_path = ptyext_path; + Parsetree.ptyext_params = ptyext_params; + Parsetree.ptyext_constructors = ptyext_constructors; + Parsetree.ptyext_private = ptyext_private; + Parsetree.ptyext_attributes = ptyext_attributes } + -> + this#record "Ast_402.Parsetree.type_extension" + [("ptyext_path", + (this#lift_Asttypes_loc this#lift_Longident_t ptyext_path)); + ("ptyext_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptyext_params))); + ("ptyext_constructors", + (this#list + (List.map this#lift_Parsetree_extension_constructor + ptyext_constructors))); + ("ptyext_private", + (this#lift_Asttypes_private_flag ptyext_private)); + ("ptyext_attributes", + (this#lift_Parsetree_attributes ptyext_attributes))] : Parsetree.type_extension + -> + 'res) + method lift_Parsetree_extension_constructor : + Parsetree.extension_constructor -> 'res= + (fun + { Parsetree.pext_name = pext_name; Parsetree.pext_kind = pext_kind; + Parsetree.pext_loc = pext_loc; + Parsetree.pext_attributes = pext_attributes } + -> + this#record "Ast_402.Parsetree.extension_constructor" + [("pext_name", (this#lift_Asttypes_loc this#string pext_name)); + ("pext_kind", + (this#lift_Parsetree_extension_constructor_kind pext_kind)); + ("pext_loc", (this#lift_Location_t pext_loc)); + ("pext_attributes", + (this#lift_Parsetree_attributes pext_attributes))] : Parsetree.extension_constructor + -> + 'res) + method lift_Parsetree_extension_constructor_kind : + Parsetree.extension_constructor_kind -> 'res= + (function + | Parsetree.Pext_decl (x0,x1) -> + this#constr "Ast_402.Parsetree.extension_constructor_kind" + ("Pext_decl", + [this#list (List.map this#lift_Parsetree_core_type x0); + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pext_rebind x0 -> + this#constr "Ast_402.Parsetree.extension_constructor_kind" + ("Pext_rebind", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.extension_constructor_kind + -> + 'res) + method lift_Parsetree_type_declaration : + Parsetree.type_declaration -> 'res= + (fun + { Parsetree.ptype_name = ptype_name; + Parsetree.ptype_params = ptype_params; + Parsetree.ptype_cstrs = ptype_cstrs; + Parsetree.ptype_kind = ptype_kind; + Parsetree.ptype_private = ptype_private; + Parsetree.ptype_manifest = ptype_manifest; + Parsetree.ptype_attributes = ptype_attributes; + Parsetree.ptype_loc = ptype_loc } + -> + this#record "Ast_402.Parsetree.type_declaration" + [("ptype_name", (this#lift_Asttypes_loc this#string ptype_name)); + ("ptype_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptype_params))); + ("ptype_cstrs", + (this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1; + this#lift_Location_t x2]) ptype_cstrs))); + ("ptype_kind", (this#lift_Parsetree_type_kind ptype_kind)); + ("ptype_private", (this#lift_Asttypes_private_flag ptype_private)); + ("ptype_manifest", + (this#lift_option this#lift_Parsetree_core_type ptype_manifest)); + ("ptype_attributes", + (this#lift_Parsetree_attributes ptype_attributes)); + ("ptype_loc", (this#lift_Location_t ptype_loc))] : Parsetree.type_declaration + -> 'res) + method lift_Asttypes_private_flag : Asttypes.private_flag -> 'res= + (function + | Asttypes.Private -> + this#constr "Ast_402.Asttypes.private_flag" ("Private", []) + | Asttypes.Public -> + this#constr "Ast_402.Asttypes.private_flag" ("Public", []) : Asttypes.private_flag + -> + 'res) + method lift_Parsetree_type_kind : Parsetree.type_kind -> 'res= + (function + | Parsetree.Ptype_abstract -> + this#constr "Ast_402.Parsetree.type_kind" ("Ptype_abstract", []) + | Parsetree.Ptype_variant x0 -> + this#constr "Ast_402.Parsetree.type_kind" + ("Ptype_variant", + [this#list + (List.map this#lift_Parsetree_constructor_declaration x0)]) + | Parsetree.Ptype_record x0 -> + this#constr "Ast_402.Parsetree.type_kind" + ("Ptype_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) + | Parsetree.Ptype_open -> + this#constr "Ast_402.Parsetree.type_kind" ("Ptype_open", []) : Parsetree.type_kind + -> + 'res) + method lift_Parsetree_label_declaration : + Parsetree.label_declaration -> 'res= + (fun + { Parsetree.pld_name = pld_name; + Parsetree.pld_mutable = pld_mutable; + Parsetree.pld_type = pld_type; Parsetree.pld_loc = pld_loc; + Parsetree.pld_attributes = pld_attributes } + -> + this#record "Ast_402.Parsetree.label_declaration" + [("pld_name", (this#lift_Asttypes_loc this#string pld_name)); + ("pld_mutable", (this#lift_Asttypes_mutable_flag pld_mutable)); + ("pld_type", (this#lift_Parsetree_core_type pld_type)); + ("pld_loc", (this#lift_Location_t pld_loc)); + ("pld_attributes", + (this#lift_Parsetree_attributes pld_attributes))] : Parsetree.label_declaration + -> + 'res) + method lift_Asttypes_mutable_flag : Asttypes.mutable_flag -> 'res= + (function + | Asttypes.Immutable -> + this#constr "Ast_402.Asttypes.mutable_flag" ("Immutable", []) + | Asttypes.Mutable -> + this#constr "Ast_402.Asttypes.mutable_flag" ("Mutable", []) : Asttypes.mutable_flag + -> + 'res) + method lift_Parsetree_constructor_declaration : + Parsetree.constructor_declaration -> 'res= + (fun + { Parsetree.pcd_name = pcd_name; Parsetree.pcd_args = pcd_args; + Parsetree.pcd_res = pcd_res; Parsetree.pcd_loc = pcd_loc; + Parsetree.pcd_attributes = pcd_attributes } + -> + this#record "Ast_402.Parsetree.constructor_declaration" + [("pcd_name", (this#lift_Asttypes_loc this#string pcd_name)); + ("pcd_args", + (this#list (List.map this#lift_Parsetree_core_type pcd_args))); + ("pcd_res", + (this#lift_option this#lift_Parsetree_core_type pcd_res)); + ("pcd_loc", (this#lift_Location_t pcd_loc)); + ("pcd_attributes", + (this#lift_Parsetree_attributes pcd_attributes))] : Parsetree.constructor_declaration + -> + 'res) + method lift_Asttypes_variance : Asttypes.variance -> 'res= + (function + | Asttypes.Covariant -> + this#constr "Ast_402.Asttypes.variance" ("Covariant", []) + | Asttypes.Contravariant -> + this#constr "Ast_402.Asttypes.variance" ("Contravariant", []) + | Asttypes.Invariant -> + this#constr "Ast_402.Asttypes.variance" ("Invariant", []) : Asttypes.variance + -> 'res) + method lift_Parsetree_value_description : + Parsetree.value_description -> 'res= + (fun + { Parsetree.pval_name = pval_name; Parsetree.pval_type = pval_type; + Parsetree.pval_prim = pval_prim; + Parsetree.pval_attributes = pval_attributes; + Parsetree.pval_loc = pval_loc } + -> + this#record "Ast_402.Parsetree.value_description" + [("pval_name", (this#lift_Asttypes_loc this#string pval_name)); + ("pval_type", (this#lift_Parsetree_core_type pval_type)); + ("pval_prim", (this#list (List.map this#string pval_prim))); + ("pval_attributes", + (this#lift_Parsetree_attributes pval_attributes)); + ("pval_loc", (this#lift_Location_t pval_loc))] : Parsetree.value_description + -> 'res) + method lift_Asttypes_closed_flag : Asttypes.closed_flag -> 'res= + (function + | Asttypes.Closed -> + this#constr "Ast_402.Asttypes.closed_flag" ("Closed", []) + | Asttypes.Open -> this#constr "Ast_402.Asttypes.closed_flag" ("Open", []) : + Asttypes.closed_flag -> 'res) + method lift_Asttypes_label : Asttypes.label -> 'res= + (this#string : Asttypes.label -> 'res) + method lift_Asttypes_rec_flag : Asttypes.rec_flag -> 'res= + (function + | Asttypes.Nonrecursive -> + this#constr "Ast_402.Asttypes.rec_flag" ("Nonrecursive", []) + | Asttypes.Recursive -> + this#constr "Ast_402.Asttypes.rec_flag" ("Recursive", []) : Asttypes.rec_flag + -> 'res) + method lift_Asttypes_constant : Asttypes.constant -> 'res= + (function + | Asttypes.Const_int x0 -> + this#constr "Ast_402.Asttypes.constant" ("Const_int", [this#int x0]) + | Asttypes.Const_char x0 -> + this#constr "Ast_402.Asttypes.constant" ("Const_char", [this#char x0]) + | Asttypes.Const_string (x0,x1) -> + this#constr "Ast_402.Asttypes.constant" + ("Const_string", + [this#string x0; this#lift_option this#string x1]) + | Asttypes.Const_float x0 -> + this#constr "Ast_402.Asttypes.constant" ("Const_float", [this#string x0]) + | Asttypes.Const_int32 x0 -> + this#constr "Ast_402.Asttypes.constant" ("Const_int32", [this#int32 x0]) + | Asttypes.Const_int64 x0 -> + this#constr "Ast_402.Asttypes.constant" ("Const_int64", [this#int64 x0]) + | Asttypes.Const_nativeint x0 -> + this#constr "Ast_402.Asttypes.constant" + ("Const_nativeint", [this#nativeint x0]) : Asttypes.constant -> + 'res) + method lift_option : 'f0 . ('f0 -> 'res) -> 'f0 option -> 'res= fun (type + f0) -> + (fun f0 -> + function + | None -> this#constr "option" ("None", []) + | Some x0 -> this#constr "option" ("Some", [f0 x0]) : (f0 -> 'res) + -> + f0 option -> + 'res) + method lift_Longident_t : Longident.t -> 'res= + (function + | Longident.Lident x0 -> + this#constr "Ast_402.Longident.t" ("Lident", [this#string x0]) + | Longident.Ldot (x0,x1) -> + this#constr "Ast_402.Longident.t" + ("Ldot", [this#lift_Longident_t x0; this#string x1]) + | Longident.Lapply (x0,x1) -> + this#constr "Ast_402.Longident.t" + ("Lapply", [this#lift_Longident_t x0; this#lift_Longident_t x1]) : + Longident.t -> 'res) + method lift_Asttypes_loc : + 'f0 . ('f0 -> 'res) -> 'f0 Asttypes.loc -> 'res= fun (type f0) -> + (fun f0 -> + fun { Asttypes.txt = txt; Asttypes.loc = loc } -> + this#record "Ast_402.Asttypes.loc" + [("txt", (f0 txt)); ("loc", (this#lift_Location_t loc))] : + (f0 -> 'res) -> f0 Asttypes.loc -> 'res) + method lift_Location_t : Location.t -> 'res= + (fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Ast_402.Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] : Location.t -> 'res) + method lift_bool : bool -> 'res= + (function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) : bool -> 'res) + method lift_Lexing_position : Lexing.position -> 'res= + (fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] : Lexing.position -> 'res) + end diff --git a/ast_lifter_403.ml b/ast_lifter_403.ml new file mode 100644 index 0000000..6c20ff9 --- /dev/null +++ b/ast_lifter_403.ml @@ -0,0 +1,1378 @@ +open Ast_403 + +class virtual ['res] lifter = + object (this) + method lift_Parsetree_expression : Parsetree.expression -> 'res= + (fun + { Parsetree.pexp_desc = pexp_desc; Parsetree.pexp_loc = pexp_loc; + Parsetree.pexp_attributes = pexp_attributes } + -> + this#record "Ast_403.Parsetree.expression" + [("pexp_desc", (this#lift_Parsetree_expression_desc pexp_desc)); + ("pexp_loc", (this#lift_Location_t pexp_loc)); + ("pexp_attributes", + (this#lift_Parsetree_attributes pexp_attributes))] : Parsetree.expression + -> + 'res) + method lift_Parsetree_expression_desc : + Parsetree.expression_desc -> 'res= + (function + | Parsetree.Pexp_ident x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_constant x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Pexp_let (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_function x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_function", + [this#list (List.map this#lift_Parsetree_case x0)]) + | Parsetree.Pexp_fun (x0,x1,x2,x3) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_expression x3]) + | Parsetree.Pexp_apply (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_apply", + [this#lift_Parsetree_expression x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pexp_match (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_match", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_try (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_try", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_tuple x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_tuple", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_construct (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_variant (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_record (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_expression x1]) x0); + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_field (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_field", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pexp_setfield (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_setfield", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_array x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_array", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_ifthenelse", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1; + this#lift_option this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_sequence (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_sequence", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_while (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_while", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_for", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_expression x1; + this#lift_Parsetree_expression x2; + this#lift_Asttypes_direction_flag x3; + this#lift_Parsetree_expression x4]) + | Parsetree.Pexp_constraint (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_constraint", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_coerce (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_coerce", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Pexp_send (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_send", + [this#lift_Parsetree_expression x0; this#string x1]) + | Parsetree.Pexp_new x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_new", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_setinstvar (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_setinstvar", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_override x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_override", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) x0)]) + | Parsetree.Pexp_letmodule (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_letmodule", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_module_expr x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_assert x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_assert", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_lazy x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_lazy", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_poly (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_poly", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_object x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_object", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pexp_newtype (x0,x1) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_newtype", + [this#string x0; this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_pack x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_pack", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pexp_open (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_extension x0 -> + this#constr "Ast_403.Parsetree.expression_desc" + ("Pexp_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pexp_unreachable -> + this#constr "Ast_403.Parsetree.expression_desc" ("Pexp_unreachable", []) : + Parsetree.expression_desc -> 'res) + method lift_Asttypes_direction_flag : Asttypes.direction_flag -> 'res= + (function + | Asttypes.Upto -> this#constr "Ast_403.Asttypes.direction_flag" ("Upto", []) + | Asttypes.Downto -> + this#constr "Ast_403.Asttypes.direction_flag" ("Downto", []) : Asttypes.direction_flag + -> + 'res) + method lift_Parsetree_case : Parsetree.case -> 'res= + (fun + { Parsetree.pc_lhs = pc_lhs; Parsetree.pc_guard = pc_guard; + Parsetree.pc_rhs = pc_rhs } + -> + this#record "Ast_403.Parsetree.case" + [("pc_lhs", (this#lift_Parsetree_pattern pc_lhs)); + ("pc_guard", + (this#lift_option this#lift_Parsetree_expression pc_guard)); + ("pc_rhs", (this#lift_Parsetree_expression pc_rhs))] : Parsetree.case + -> + 'res) + method lift_Parsetree_value_binding : Parsetree.value_binding -> 'res= + (fun + { Parsetree.pvb_pat = pvb_pat; Parsetree.pvb_expr = pvb_expr; + Parsetree.pvb_attributes = pvb_attributes; + Parsetree.pvb_loc = pvb_loc } + -> + this#record "Ast_403.Parsetree.value_binding" + [("pvb_pat", (this#lift_Parsetree_pattern pvb_pat)); + ("pvb_expr", (this#lift_Parsetree_expression pvb_expr)); + ("pvb_attributes", + (this#lift_Parsetree_attributes pvb_attributes)); + ("pvb_loc", (this#lift_Location_t pvb_loc))] : Parsetree.value_binding + -> 'res) + method lift_Parsetree_pattern : Parsetree.pattern -> 'res= + (fun + { Parsetree.ppat_desc = ppat_desc; Parsetree.ppat_loc = ppat_loc; + Parsetree.ppat_attributes = ppat_attributes } + -> + this#record "Ast_403.Parsetree.pattern" + [("ppat_desc", (this#lift_Parsetree_pattern_desc ppat_desc)); + ("ppat_loc", (this#lift_Location_t ppat_loc)); + ("ppat_attributes", + (this#lift_Parsetree_attributes ppat_attributes))] : Parsetree.pattern + -> + 'res) + method lift_Parsetree_pattern_desc : Parsetree.pattern_desc -> 'res= + (function + | Parsetree.Ppat_any -> + this#constr "Ast_403.Parsetree.pattern_desc" ("Ppat_any", []) + | Parsetree.Ppat_var x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_var", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_alias (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_alias", + [this#lift_Parsetree_pattern x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Ppat_constant x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Ppat_interval (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_interval", + [this#lift_Parsetree_constant x0; + this#lift_Parsetree_constant x1]) + | Parsetree.Ppat_tuple x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_tuple", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_construct (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_variant (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_record (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ppat_array x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_array", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_or (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_or", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_constraint (x0,x1) -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_constraint", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Ppat_type x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_type", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Ppat_lazy x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_lazy", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_unpack x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_unpack", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_exception x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_exception", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_extension x0 -> + this#constr "Ast_403.Parsetree.pattern_desc" + ("Ppat_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.pattern_desc -> 'res) + method lift_Parsetree_core_type : Parsetree.core_type -> 'res= + (fun + { Parsetree.ptyp_desc = ptyp_desc; Parsetree.ptyp_loc = ptyp_loc; + Parsetree.ptyp_attributes = ptyp_attributes } + -> + this#record "Ast_403.Parsetree.core_type" + [("ptyp_desc", (this#lift_Parsetree_core_type_desc ptyp_desc)); + ("ptyp_loc", (this#lift_Location_t ptyp_loc)); + ("ptyp_attributes", + (this#lift_Parsetree_attributes ptyp_attributes))] : Parsetree.core_type + -> + 'res) + method lift_Parsetree_core_type_desc : Parsetree.core_type_desc -> 'res= + (function + | Parsetree.Ptyp_any -> + this#constr "Ast_403.Parsetree.core_type_desc" ("Ptyp_any", []) + | Parsetree.Ptyp_var x0 -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_var", [this#string x0]) + | Parsetree.Ptyp_arrow (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Ptyp_tuple x0 -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Ptyp_constr (x0,x1) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_object (x0,x1) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_object", + [this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#string x0; + this#lift_Parsetree_attributes x1; + this#lift_Parsetree_core_type x2]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ptyp_class (x0,x1) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_class", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_alias (x0,x1) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_alias", + [this#lift_Parsetree_core_type x0; this#string x1]) + | Parsetree.Ptyp_variant (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_variant", + [this#list (List.map this#lift_Parsetree_row_field x0); + this#lift_Asttypes_closed_flag x1; + this#lift_option + (fun x -> this#list (List.map this#lift_Asttypes_label x)) + x2]) + | Parsetree.Ptyp_poly (x0,x1) -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_poly", + [this#list (List.map this#string x0); + this#lift_Parsetree_core_type x1]) + | Parsetree.Ptyp_package x0 -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_package", [this#lift_Parsetree_package_type x0]) + | Parsetree.Ptyp_extension x0 -> + this#constr "Ast_403.Parsetree.core_type_desc" + ("Ptyp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.core_type_desc -> 'res) + method lift_Parsetree_package_type : Parsetree.package_type -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_core_type x1]) x1)] : Parsetree.package_type + -> 'res) + method lift_Parsetree_row_field : Parsetree.row_field -> 'res= + (function + | Parsetree.Rtag (x0,x1,x2,x3) -> + this#constr "Ast_403.Parsetree.row_field" + ("Rtag", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_bool x2; + this#list (List.map this#lift_Parsetree_core_type x3)]) + | Parsetree.Rinherit x0 -> + this#constr "Ast_403.Parsetree.row_field" + ("Rinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.row_field + -> + 'res) + method lift_Parsetree_attributes : Parsetree.attributes -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_attribute x) : + Parsetree.attributes -> 'res) + method lift_Parsetree_attribute : Parsetree.attribute -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.attribute -> 'res) + method lift_Parsetree_payload : Parsetree.payload -> 'res= + (function + | Parsetree.PStr x0 -> + this#constr "Ast_403.Parsetree.payload" + ("PStr", [this#lift_Parsetree_structure x0]) + | Parsetree.PSig x0 -> + this#constr "Ast_403.Parsetree.payload" + ("PSig", [this#lift_Parsetree_signature x0]) + | Parsetree.PTyp x0 -> + this#constr "Ast_403.Parsetree.payload" + ("PTyp", [this#lift_Parsetree_core_type x0]) + | Parsetree.PPat (x0,x1) -> + this#constr "Ast_403.Parsetree.payload" + ("PPat", + [this#lift_Parsetree_pattern x0; + this#lift_option this#lift_Parsetree_expression x1]) : + Parsetree.payload -> 'res) + method lift_Parsetree_structure : Parsetree.structure -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_structure_item x) : + Parsetree.structure -> 'res) + method lift_Parsetree_structure_item : Parsetree.structure_item -> 'res= + (fun { Parsetree.pstr_desc = pstr_desc; Parsetree.pstr_loc = pstr_loc } + -> + this#record "Ast_403.Parsetree.structure_item" + [("pstr_desc", + (this#lift_Parsetree_structure_item_desc pstr_desc)); + ("pstr_loc", (this#lift_Location_t pstr_loc))] : Parsetree.structure_item + -> 'res) + method lift_Parsetree_structure_item_desc : + Parsetree.structure_item_desc -> 'res= + (function + | Parsetree.Pstr_eval (x0,x1) -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_eval", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_attributes x1]) + | Parsetree.Pstr_value (x0,x1) -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_value", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1)]) + | Parsetree.Pstr_primitive x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_primitive", [this#lift_Parsetree_value_description x0]) + | Parsetree.Pstr_type (x0,x1) -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Pstr_typext x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Pstr_exception x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Pstr_module x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_module", [this#lift_Parsetree_module_binding x0]) + | Parsetree.Pstr_recmodule x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_recmodule", + [this#list (List.map this#lift_Parsetree_module_binding x0)]) + | Parsetree.Pstr_modtype x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Pstr_open x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Pstr_class x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_class", + [this#list (List.map this#lift_Parsetree_class_declaration x0)]) + | Parsetree.Pstr_class_type x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Pstr_include x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_include", [this#lift_Parsetree_include_declaration x0]) + | Parsetree.Pstr_attribute x0 -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pstr_extension (x0,x1) -> + this#constr "Ast_403.Parsetree.structure_item_desc" + ("Pstr_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.structure_item_desc + -> 'res) + method lift_Parsetree_include_declaration : + Parsetree.include_declaration -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_expr x : + Parsetree.include_declaration -> 'res) + method lift_Parsetree_class_declaration : + Parsetree.class_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_expr x : + Parsetree.class_declaration -> 'res) + method lift_Parsetree_class_expr : Parsetree.class_expr -> 'res= + (fun + { Parsetree.pcl_desc = pcl_desc; Parsetree.pcl_loc = pcl_loc; + Parsetree.pcl_attributes = pcl_attributes } + -> + this#record "Ast_403.Parsetree.class_expr" + [("pcl_desc", (this#lift_Parsetree_class_expr_desc pcl_desc)); + ("pcl_loc", (this#lift_Location_t pcl_loc)); + ("pcl_attributes", + (this#lift_Parsetree_attributes pcl_attributes))] : Parsetree.class_expr + -> + 'res) + method lift_Parsetree_class_expr_desc : + Parsetree.class_expr_desc -> 'res= + (function + | Parsetree.Pcl_constr (x0,x1) -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcl_structure x0 -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_structure", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pcl_fun (x0,x1,x2,x3) -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_class_expr x3]) + | Parsetree.Pcl_apply (x0,x1) -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_apply", + [this#lift_Parsetree_class_expr x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pcl_let (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_class_expr x2]) + | Parsetree.Pcl_constraint (x0,x1) -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_constraint", + [this#lift_Parsetree_class_expr x0; + this#lift_Parsetree_class_type x1]) + | Parsetree.Pcl_extension x0 -> + this#constr "Ast_403.Parsetree.class_expr_desc" + ("Pcl_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_expr_desc -> 'res) + method lift_Parsetree_class_structure : + Parsetree.class_structure -> 'res= + (fun + { Parsetree.pcstr_self = pcstr_self; + Parsetree.pcstr_fields = pcstr_fields } + -> + this#record "Ast_403.Parsetree.class_structure" + [("pcstr_self", (this#lift_Parsetree_pattern pcstr_self)); + ("pcstr_fields", + (this#list + (List.map this#lift_Parsetree_class_field pcstr_fields)))] : + Parsetree.class_structure -> 'res) + method lift_Parsetree_class_field : Parsetree.class_field -> 'res= + (fun + { Parsetree.pcf_desc = pcf_desc; Parsetree.pcf_loc = pcf_loc; + Parsetree.pcf_attributes = pcf_attributes } + -> + this#record "Ast_403.Parsetree.class_field" + [("pcf_desc", (this#lift_Parsetree_class_field_desc pcf_desc)); + ("pcf_loc", (this#lift_Location_t pcf_loc)); + ("pcf_attributes", + (this#lift_Parsetree_attributes pcf_attributes))] : Parsetree.class_field + -> + 'res) + method lift_Parsetree_class_field_desc : + Parsetree.class_field_desc -> 'res= + (function + | Parsetree.Pcf_inherit (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_inherit", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_class_expr x1; + this#lift_option this#string x2]) + | Parsetree.Pcf_val x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_val", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_method x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_method", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_constraint x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pcf_initializer x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_initializer", [this#lift_Parsetree_expression x0]) + | Parsetree.Pcf_attribute x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pcf_extension x0 -> + this#constr "Ast_403.Parsetree.class_field_desc" + ("Pcf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_field_desc -> 'res) + method lift_Parsetree_class_field_kind : + Parsetree.class_field_kind -> 'res= + (function + | Parsetree.Cfk_virtual x0 -> + this#constr "Ast_403.Parsetree.class_field_kind" + ("Cfk_virtual", [this#lift_Parsetree_core_type x0]) + | Parsetree.Cfk_concrete (x0,x1) -> + this#constr "Ast_403.Parsetree.class_field_kind" + ("Cfk_concrete", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_expression x1]) : Parsetree.class_field_kind + -> 'res) + method lift_Parsetree_module_binding : Parsetree.module_binding -> 'res= + (fun + { Parsetree.pmb_name = pmb_name; Parsetree.pmb_expr = pmb_expr; + Parsetree.pmb_attributes = pmb_attributes; + Parsetree.pmb_loc = pmb_loc } + -> + this#record "Ast_403.Parsetree.module_binding" + [("pmb_name", (this#lift_Asttypes_loc this#string pmb_name)); + ("pmb_expr", (this#lift_Parsetree_module_expr pmb_expr)); + ("pmb_attributes", + (this#lift_Parsetree_attributes pmb_attributes)); + ("pmb_loc", (this#lift_Location_t pmb_loc))] : Parsetree.module_binding + -> 'res) + method lift_Parsetree_module_expr : Parsetree.module_expr -> 'res= + (fun + { Parsetree.pmod_desc = pmod_desc; Parsetree.pmod_loc = pmod_loc; + Parsetree.pmod_attributes = pmod_attributes } + -> + this#record "Ast_403.Parsetree.module_expr" + [("pmod_desc", (this#lift_Parsetree_module_expr_desc pmod_desc)); + ("pmod_loc", (this#lift_Location_t pmod_loc)); + ("pmod_attributes", + (this#lift_Parsetree_attributes pmod_attributes))] : Parsetree.module_expr + -> + 'res) + method lift_Parsetree_module_expr_desc : + Parsetree.module_expr_desc -> 'res= + (function + | Parsetree.Pmod_ident x0 -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmod_structure x0 -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_structure", [this#lift_Parsetree_structure x0]) + | Parsetree.Pmod_functor (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_expr x2]) + | Parsetree.Pmod_apply (x0,x1) -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_apply", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_expr x1]) + | Parsetree.Pmod_constraint (x0,x1) -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_constraint", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_type x1]) + | Parsetree.Pmod_unpack x0 -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_unpack", [this#lift_Parsetree_expression x0]) + | Parsetree.Pmod_extension x0 -> + this#constr "Ast_403.Parsetree.module_expr_desc" + ("Pmod_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.module_expr_desc -> 'res) + method lift_Parsetree_module_type : Parsetree.module_type -> 'res= + (fun + { Parsetree.pmty_desc = pmty_desc; Parsetree.pmty_loc = pmty_loc; + Parsetree.pmty_attributes = pmty_attributes } + -> + this#record "Ast_403.Parsetree.module_type" + [("pmty_desc", (this#lift_Parsetree_module_type_desc pmty_desc)); + ("pmty_loc", (this#lift_Location_t pmty_loc)); + ("pmty_attributes", + (this#lift_Parsetree_attributes pmty_attributes))] : Parsetree.module_type + -> + 'res) + method lift_Parsetree_module_type_desc : + Parsetree.module_type_desc -> 'res= + (function + | Parsetree.Pmty_ident x0 -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmty_signature x0 -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_signature", [this#lift_Parsetree_signature x0]) + | Parsetree.Pmty_functor (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_type x2]) + | Parsetree.Pmty_with (x0,x1) -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_with", + [this#lift_Parsetree_module_type x0; + this#list (List.map this#lift_Parsetree_with_constraint x1)]) + | Parsetree.Pmty_typeof x0 -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_typeof", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pmty_extension x0 -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pmty_alias x0 -> + this#constr "Ast_403.Parsetree.module_type_desc" + ("Pmty_alias", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.module_type_desc + -> + 'res) + method lift_Parsetree_with_constraint : + Parsetree.with_constraint -> 'res= + (function + | Parsetree.Pwith_type (x0,x1) -> + this#constr "Ast_403.Parsetree.with_constraint" + ("Pwith_type", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_module (x0,x1) -> + this#constr "Ast_403.Parsetree.with_constraint" + ("Pwith_module", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pwith_typesubst x0 -> + this#constr "Ast_403.Parsetree.with_constraint" + ("Pwith_typesubst", [this#lift_Parsetree_type_declaration x0]) + | Parsetree.Pwith_modsubst (x0,x1) -> + this#constr "Ast_403.Parsetree.with_constraint" + ("Pwith_modsubst", + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) : Parsetree.with_constraint + -> + 'res) + method lift_Parsetree_signature : Parsetree.signature -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_signature_item x) : + Parsetree.signature -> 'res) + method lift_Parsetree_signature_item : Parsetree.signature_item -> 'res= + (fun { Parsetree.psig_desc = psig_desc; Parsetree.psig_loc = psig_loc } + -> + this#record "Ast_403.Parsetree.signature_item" + [("psig_desc", + (this#lift_Parsetree_signature_item_desc psig_desc)); + ("psig_loc", (this#lift_Location_t psig_loc))] : Parsetree.signature_item + -> 'res) + method lift_Parsetree_signature_item_desc : + Parsetree.signature_item_desc -> 'res= + (function + | Parsetree.Psig_value x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_value", [this#lift_Parsetree_value_description x0]) + | Parsetree.Psig_type (x0,x1) -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Psig_typext x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Psig_exception x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Psig_module x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_module", [this#lift_Parsetree_module_declaration x0]) + | Parsetree.Psig_recmodule x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_recmodule", + [this#list + (List.map this#lift_Parsetree_module_declaration x0)]) + | Parsetree.Psig_modtype x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Psig_open x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Psig_include x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_include", [this#lift_Parsetree_include_description x0]) + | Parsetree.Psig_class x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_class", + [this#list (List.map this#lift_Parsetree_class_description x0)]) + | Parsetree.Psig_class_type x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Psig_attribute x0 -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Psig_extension (x0,x1) -> + this#constr "Ast_403.Parsetree.signature_item_desc" + ("Psig_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.signature_item_desc + -> 'res) + method lift_Parsetree_class_type_declaration : + Parsetree.class_type_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_type_declaration -> 'res) + method lift_Parsetree_class_description : + Parsetree.class_description -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_description -> 'res) + method lift_Parsetree_class_type : Parsetree.class_type -> 'res= + (fun + { Parsetree.pcty_desc = pcty_desc; Parsetree.pcty_loc = pcty_loc; + Parsetree.pcty_attributes = pcty_attributes } + -> + this#record "Ast_403.Parsetree.class_type" + [("pcty_desc", (this#lift_Parsetree_class_type_desc pcty_desc)); + ("pcty_loc", (this#lift_Location_t pcty_loc)); + ("pcty_attributes", + (this#lift_Parsetree_attributes pcty_attributes))] : Parsetree.class_type + -> + 'res) + method lift_Parsetree_class_type_desc : + Parsetree.class_type_desc -> 'res= + (function + | Parsetree.Pcty_constr (x0,x1) -> + this#constr "Ast_403.Parsetree.class_type_desc" + ("Pcty_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcty_signature x0 -> + this#constr "Ast_403.Parsetree.class_type_desc" + ("Pcty_signature", [this#lift_Parsetree_class_signature x0]) + | Parsetree.Pcty_arrow (x0,x1,x2) -> + this#constr "Ast_403.Parsetree.class_type_desc" + ("Pcty_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_class_type x2]) + | Parsetree.Pcty_extension x0 -> + this#constr "Ast_403.Parsetree.class_type_desc" + ("Pcty_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_desc -> 'res) + method lift_Parsetree_class_signature : + Parsetree.class_signature -> 'res= + (fun + { Parsetree.pcsig_self = pcsig_self; + Parsetree.pcsig_fields = pcsig_fields } + -> + this#record "Ast_403.Parsetree.class_signature" + [("pcsig_self", (this#lift_Parsetree_core_type pcsig_self)); + ("pcsig_fields", + (this#list + (List.map this#lift_Parsetree_class_type_field pcsig_fields)))] : + Parsetree.class_signature -> 'res) + method lift_Parsetree_class_type_field : + Parsetree.class_type_field -> 'res= + (fun + { Parsetree.pctf_desc = pctf_desc; Parsetree.pctf_loc = pctf_loc; + Parsetree.pctf_attributes = pctf_attributes } + -> + this#record "Ast_403.Parsetree.class_type_field" + [("pctf_desc", + (this#lift_Parsetree_class_type_field_desc pctf_desc)); + ("pctf_loc", (this#lift_Location_t pctf_loc)); + ("pctf_attributes", + (this#lift_Parsetree_attributes pctf_attributes))] : Parsetree.class_type_field + -> + 'res) + method lift_Parsetree_class_type_field_desc : + Parsetree.class_type_field_desc -> 'res= + (function + | Parsetree.Pctf_inherit x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_inherit", [this#lift_Parsetree_class_type x0]) + | Parsetree.Pctf_val x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_val", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_method x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_method", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_constraint x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pctf_attribute x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pctf_extension x0 -> + this#constr "Ast_403.Parsetree.class_type_field_desc" + ("Pctf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_field_desc -> 'res) + method lift_Parsetree_extension : Parsetree.extension -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.extension -> 'res) + method lift_Parsetree_class_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.class_infos -> 'res= fun (type f0) + -> + (fun f0 -> + fun + { Parsetree.pci_virt = pci_virt; + Parsetree.pci_params = pci_params; + Parsetree.pci_name = pci_name; Parsetree.pci_expr = pci_expr; + Parsetree.pci_loc = pci_loc; + Parsetree.pci_attributes = pci_attributes } + -> + this#record "Ast_403.Parsetree.class_infos" + [("pci_virt", (this#lift_Asttypes_virtual_flag pci_virt)); + ("pci_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) pci_params))); + ("pci_name", (this#lift_Asttypes_loc this#string pci_name)); + ("pci_expr", (f0 pci_expr)); + ("pci_loc", (this#lift_Location_t pci_loc)); + ("pci_attributes", + (this#lift_Parsetree_attributes pci_attributes))] : (f0 -> + 'res) -> + f0 + Parsetree.class_infos + -> + 'res) + method lift_Asttypes_virtual_flag : Asttypes.virtual_flag -> 'res= + (function + | Asttypes.Virtual -> + this#constr "Ast_403.Asttypes.virtual_flag" ("Virtual", []) + | Asttypes.Concrete -> + this#constr "Ast_403.Asttypes.virtual_flag" ("Concrete", []) : Asttypes.virtual_flag + -> + 'res) + method lift_Parsetree_include_description : + Parsetree.include_description -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_type x : + Parsetree.include_description -> 'res) + method lift_Parsetree_include_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.include_infos -> 'res= fun (type + f0) -> + (fun f0 -> + fun + { Parsetree.pincl_mod = pincl_mod; + Parsetree.pincl_loc = pincl_loc; + Parsetree.pincl_attributes = pincl_attributes } + -> + this#record "Ast_403.Parsetree.include_infos" + [("pincl_mod", (f0 pincl_mod)); + ("pincl_loc", (this#lift_Location_t pincl_loc)); + ("pincl_attributes", + (this#lift_Parsetree_attributes pincl_attributes))] : + (f0 -> 'res) -> f0 Parsetree.include_infos -> 'res) + method lift_Parsetree_open_description : + Parsetree.open_description -> 'res= + (fun + { Parsetree.popen_lid = popen_lid; + Parsetree.popen_override = popen_override; + Parsetree.popen_loc = popen_loc; + Parsetree.popen_attributes = popen_attributes } + -> + this#record "Ast_403.Parsetree.open_description" + [("popen_lid", + (this#lift_Asttypes_loc this#lift_Longident_t popen_lid)); + ("popen_override", + (this#lift_Asttypes_override_flag popen_override)); + ("popen_loc", (this#lift_Location_t popen_loc)); + ("popen_attributes", + (this#lift_Parsetree_attributes popen_attributes))] : Parsetree.open_description + -> + 'res) + method lift_Asttypes_override_flag : Asttypes.override_flag -> 'res= + (function + | Asttypes.Override -> + this#constr "Ast_403.Asttypes.override_flag" ("Override", []) + | Asttypes.Fresh -> + this#constr "Ast_403.Asttypes.override_flag" ("Fresh", []) : Asttypes.override_flag + -> + 'res) + method lift_Parsetree_module_type_declaration : + Parsetree.module_type_declaration -> 'res= + (fun + { Parsetree.pmtd_name = pmtd_name; Parsetree.pmtd_type = pmtd_type; + Parsetree.pmtd_attributes = pmtd_attributes; + Parsetree.pmtd_loc = pmtd_loc } + -> + this#record "Ast_403.Parsetree.module_type_declaration" + [("pmtd_name", (this#lift_Asttypes_loc this#string pmtd_name)); + ("pmtd_type", + (this#lift_option this#lift_Parsetree_module_type pmtd_type)); + ("pmtd_attributes", + (this#lift_Parsetree_attributes pmtd_attributes)); + ("pmtd_loc", (this#lift_Location_t pmtd_loc))] : Parsetree.module_type_declaration + -> 'res) + method lift_Parsetree_module_declaration : + Parsetree.module_declaration -> 'res= + (fun + { Parsetree.pmd_name = pmd_name; Parsetree.pmd_type = pmd_type; + Parsetree.pmd_attributes = pmd_attributes; + Parsetree.pmd_loc = pmd_loc } + -> + this#record "Ast_403.Parsetree.module_declaration" + [("pmd_name", (this#lift_Asttypes_loc this#string pmd_name)); + ("pmd_type", (this#lift_Parsetree_module_type pmd_type)); + ("pmd_attributes", + (this#lift_Parsetree_attributes pmd_attributes)); + ("pmd_loc", (this#lift_Location_t pmd_loc))] : Parsetree.module_declaration + -> 'res) + method lift_Parsetree_type_extension : Parsetree.type_extension -> 'res= + (fun + { Parsetree.ptyext_path = ptyext_path; + Parsetree.ptyext_params = ptyext_params; + Parsetree.ptyext_constructors = ptyext_constructors; + Parsetree.ptyext_private = ptyext_private; + Parsetree.ptyext_attributes = ptyext_attributes } + -> + this#record "Ast_403.Parsetree.type_extension" + [("ptyext_path", + (this#lift_Asttypes_loc this#lift_Longident_t ptyext_path)); + ("ptyext_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptyext_params))); + ("ptyext_constructors", + (this#list + (List.map this#lift_Parsetree_extension_constructor + ptyext_constructors))); + ("ptyext_private", + (this#lift_Asttypes_private_flag ptyext_private)); + ("ptyext_attributes", + (this#lift_Parsetree_attributes ptyext_attributes))] : Parsetree.type_extension + -> + 'res) + method lift_Parsetree_extension_constructor : + Parsetree.extension_constructor -> 'res= + (fun + { Parsetree.pext_name = pext_name; Parsetree.pext_kind = pext_kind; + Parsetree.pext_loc = pext_loc; + Parsetree.pext_attributes = pext_attributes } + -> + this#record "Ast_403.Parsetree.extension_constructor" + [("pext_name", (this#lift_Asttypes_loc this#string pext_name)); + ("pext_kind", + (this#lift_Parsetree_extension_constructor_kind pext_kind)); + ("pext_loc", (this#lift_Location_t pext_loc)); + ("pext_attributes", + (this#lift_Parsetree_attributes pext_attributes))] : Parsetree.extension_constructor + -> + 'res) + method lift_Parsetree_extension_constructor_kind : + Parsetree.extension_constructor_kind -> 'res= + (function + | Parsetree.Pext_decl (x0,x1) -> + this#constr "Ast_403.Parsetree.extension_constructor_kind" + ("Pext_decl", + [this#lift_Parsetree_constructor_arguments x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pext_rebind x0 -> + this#constr "Ast_403.Parsetree.extension_constructor_kind" + ("Pext_rebind", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.extension_constructor_kind + -> + 'res) + method lift_Parsetree_type_declaration : + Parsetree.type_declaration -> 'res= + (fun + { Parsetree.ptype_name = ptype_name; + Parsetree.ptype_params = ptype_params; + Parsetree.ptype_cstrs = ptype_cstrs; + Parsetree.ptype_kind = ptype_kind; + Parsetree.ptype_private = ptype_private; + Parsetree.ptype_manifest = ptype_manifest; + Parsetree.ptype_attributes = ptype_attributes; + Parsetree.ptype_loc = ptype_loc } + -> + this#record "Ast_403.Parsetree.type_declaration" + [("ptype_name", (this#lift_Asttypes_loc this#string ptype_name)); + ("ptype_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptype_params))); + ("ptype_cstrs", + (this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1; + this#lift_Location_t x2]) ptype_cstrs))); + ("ptype_kind", (this#lift_Parsetree_type_kind ptype_kind)); + ("ptype_private", (this#lift_Asttypes_private_flag ptype_private)); + ("ptype_manifest", + (this#lift_option this#lift_Parsetree_core_type ptype_manifest)); + ("ptype_attributes", + (this#lift_Parsetree_attributes ptype_attributes)); + ("ptype_loc", (this#lift_Location_t ptype_loc))] : Parsetree.type_declaration + -> 'res) + method lift_Asttypes_private_flag : Asttypes.private_flag -> 'res= + (function + | Asttypes.Private -> + this#constr "Ast_403.Asttypes.private_flag" ("Private", []) + | Asttypes.Public -> + this#constr "Ast_403.Asttypes.private_flag" ("Public", []) : Asttypes.private_flag + -> + 'res) + method lift_Parsetree_type_kind : Parsetree.type_kind -> 'res= + (function + | Parsetree.Ptype_abstract -> + this#constr "Ast_403.Parsetree.type_kind" ("Ptype_abstract", []) + | Parsetree.Ptype_variant x0 -> + this#constr "Ast_403.Parsetree.type_kind" + ("Ptype_variant", + [this#list + (List.map this#lift_Parsetree_constructor_declaration x0)]) + | Parsetree.Ptype_record x0 -> + this#constr "Ast_403.Parsetree.type_kind" + ("Ptype_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) + | Parsetree.Ptype_open -> + this#constr "Ast_403.Parsetree.type_kind" ("Ptype_open", []) : Parsetree.type_kind + -> + 'res) + method lift_Parsetree_constructor_declaration : + Parsetree.constructor_declaration -> 'res= + (fun + { Parsetree.pcd_name = pcd_name; Parsetree.pcd_args = pcd_args; + Parsetree.pcd_res = pcd_res; Parsetree.pcd_loc = pcd_loc; + Parsetree.pcd_attributes = pcd_attributes } + -> + this#record "Ast_403.Parsetree.constructor_declaration" + [("pcd_name", (this#lift_Asttypes_loc this#string pcd_name)); + ("pcd_args", (this#lift_Parsetree_constructor_arguments pcd_args)); + ("pcd_res", + (this#lift_option this#lift_Parsetree_core_type pcd_res)); + ("pcd_loc", (this#lift_Location_t pcd_loc)); + ("pcd_attributes", + (this#lift_Parsetree_attributes pcd_attributes))] : Parsetree.constructor_declaration + -> + 'res) + method lift_Parsetree_constructor_arguments : + Parsetree.constructor_arguments -> 'res= + (function + | Parsetree.Pcstr_tuple x0 -> + this#constr "Ast_403.Parsetree.constructor_arguments" + ("Pcstr_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Pcstr_record x0 -> + this#constr "Ast_403.Parsetree.constructor_arguments" + ("Pcstr_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) : + Parsetree.constructor_arguments -> 'res) + method lift_Parsetree_label_declaration : + Parsetree.label_declaration -> 'res= + (fun + { Parsetree.pld_name = pld_name; + Parsetree.pld_mutable = pld_mutable; + Parsetree.pld_type = pld_type; Parsetree.pld_loc = pld_loc; + Parsetree.pld_attributes = pld_attributes } + -> + this#record "Ast_403.Parsetree.label_declaration" + [("pld_name", (this#lift_Asttypes_loc this#string pld_name)); + ("pld_mutable", (this#lift_Asttypes_mutable_flag pld_mutable)); + ("pld_type", (this#lift_Parsetree_core_type pld_type)); + ("pld_loc", (this#lift_Location_t pld_loc)); + ("pld_attributes", + (this#lift_Parsetree_attributes pld_attributes))] : Parsetree.label_declaration + -> + 'res) + method lift_Asttypes_mutable_flag : Asttypes.mutable_flag -> 'res= + (function + | Asttypes.Immutable -> + this#constr "Ast_403.Asttypes.mutable_flag" ("Immutable", []) + | Asttypes.Mutable -> + this#constr "Ast_403.Asttypes.mutable_flag" ("Mutable", []) : Asttypes.mutable_flag + -> + 'res) + method lift_Asttypes_variance : Asttypes.variance -> 'res= + (function + | Asttypes.Covariant -> + this#constr "Ast_403.Asttypes.variance" ("Covariant", []) + | Asttypes.Contravariant -> + this#constr "Ast_403.Asttypes.variance" ("Contravariant", []) + | Asttypes.Invariant -> + this#constr "Ast_403.Asttypes.variance" ("Invariant", []) : Asttypes.variance + -> 'res) + method lift_Parsetree_value_description : + Parsetree.value_description -> 'res= + (fun + { Parsetree.pval_name = pval_name; Parsetree.pval_type = pval_type; + Parsetree.pval_prim = pval_prim; + Parsetree.pval_attributes = pval_attributes; + Parsetree.pval_loc = pval_loc } + -> + this#record "Ast_403.Parsetree.value_description" + [("pval_name", (this#lift_Asttypes_loc this#string pval_name)); + ("pval_type", (this#lift_Parsetree_core_type pval_type)); + ("pval_prim", (this#list (List.map this#string pval_prim))); + ("pval_attributes", + (this#lift_Parsetree_attributes pval_attributes)); + ("pval_loc", (this#lift_Location_t pval_loc))] : Parsetree.value_description + -> 'res) + method lift_Asttypes_arg_label : Asttypes.arg_label -> 'res= + (function + | Asttypes.Nolabel -> + this#constr "Ast_403.Asttypes.arg_label" ("Nolabel", []) + | Asttypes.Labelled x0 -> + this#constr "Ast_403.Asttypes.arg_label" ("Labelled", [this#string x0]) + | Asttypes.Optional x0 -> + this#constr "Ast_403.Asttypes.arg_label" ("Optional", [this#string x0]) : + Asttypes.arg_label -> 'res) + method lift_Asttypes_closed_flag : Asttypes.closed_flag -> 'res= + (function + | Asttypes.Closed -> + this#constr "Ast_403.Asttypes.closed_flag" ("Closed", []) + | Asttypes.Open -> this#constr "Ast_403.Asttypes.closed_flag" ("Open", []) : + Asttypes.closed_flag -> 'res) + method lift_Asttypes_label : Asttypes.label -> 'res= + (this#string : Asttypes.label -> 'res) + method lift_Asttypes_rec_flag : Asttypes.rec_flag -> 'res= + (function + | Asttypes.Nonrecursive -> + this#constr "Ast_403.Asttypes.rec_flag" ("Nonrecursive", []) + | Asttypes.Recursive -> + this#constr "Ast_403.Asttypes.rec_flag" ("Recursive", []) : Asttypes.rec_flag + -> 'res) + method lift_Parsetree_constant : Parsetree.constant -> 'res= + (function + | Parsetree.Pconst_integer (x0,x1) -> + this#constr "Ast_403.Parsetree.constant" + ("Pconst_integer", + [this#string x0; this#lift_option this#char x1]) + | Parsetree.Pconst_char x0 -> + this#constr "Ast_403.Parsetree.constant" ("Pconst_char", [this#char x0]) + | Parsetree.Pconst_string (x0,x1) -> + this#constr "Ast_403.Parsetree.constant" + ("Pconst_string", + [this#string x0; this#lift_option this#string x1]) + | Parsetree.Pconst_float (x0,x1) -> + this#constr "Ast_403.Parsetree.constant" + ("Pconst_float", + [this#string x0; this#lift_option this#char x1]) : Parsetree.constant + -> + 'res) + method lift_option : 'f0 . ('f0 -> 'res) -> 'f0 option -> 'res= fun (type + f0) -> + (fun f0 -> + function + | None -> this#constr "option" ("None", []) + | Some x0 -> this#constr "option" ("Some", [f0 x0]) : (f0 -> 'res) + -> + f0 option -> + 'res) + method lift_Longident_t : Longident.t -> 'res= + (function + | Longident.Lident x0 -> + this#constr "Ast_403.Longident.t" ("Lident", [this#string x0]) + | Longident.Ldot (x0,x1) -> + this#constr "Ast_403.Longident.t" + ("Ldot", [this#lift_Longident_t x0; this#string x1]) + | Longident.Lapply (x0,x1) -> + this#constr "Ast_403.Longident.t" + ("Lapply", [this#lift_Longident_t x0; this#lift_Longident_t x1]) : + Longident.t -> 'res) + method lift_Asttypes_loc : + 'f0 . ('f0 -> 'res) -> 'f0 Asttypes.loc -> 'res= fun (type f0) -> + (fun f0 -> + fun { Asttypes.txt = txt; Asttypes.loc = loc } -> + this#record "Ast_403.Asttypes.loc" + [("txt", (f0 txt)); ("loc", (this#lift_Location_t loc))] : + (f0 -> 'res) -> f0 Asttypes.loc -> 'res) + method lift_Location_t : Location.t -> 'res= + (fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Ast_403.Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] : Location.t -> 'res) + method lift_bool : bool -> 'res= + (function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) : bool -> 'res) + method lift_Lexing_position : Lexing.position -> 'res= + (fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] : Lexing.position -> 'res) + end diff --git a/ast_lifter_404.ml b/ast_lifter_404.ml new file mode 100644 index 0000000..3442d8a --- /dev/null +++ b/ast_lifter_404.ml @@ -0,0 +1,1388 @@ +open Ast_404 + +class virtual ['res] lifter = + object (this) + method lift_Parsetree_expression : Parsetree.expression -> 'res= + (fun + { Parsetree.pexp_desc = pexp_desc; Parsetree.pexp_loc = pexp_loc; + Parsetree.pexp_attributes = pexp_attributes } + -> + this#record "Ast_404.Parsetree.expression" + [("pexp_desc", (this#lift_Parsetree_expression_desc pexp_desc)); + ("pexp_loc", (this#lift_Location_t pexp_loc)); + ("pexp_attributes", + (this#lift_Parsetree_attributes pexp_attributes))] : Parsetree.expression + -> + 'res) + method lift_Parsetree_expression_desc : + Parsetree.expression_desc -> 'res= + (function + | Parsetree.Pexp_ident x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_constant x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Pexp_let (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_function x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_function", + [this#list (List.map this#lift_Parsetree_case x0)]) + | Parsetree.Pexp_fun (x0,x1,x2,x3) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_expression x3]) + | Parsetree.Pexp_apply (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_apply", + [this#lift_Parsetree_expression x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pexp_match (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_match", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_try (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_try", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_tuple x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_tuple", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_construct (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_variant (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_record (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_expression x1]) x0); + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_field (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_field", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pexp_setfield (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_setfield", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_array x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_array", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_ifthenelse", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1; + this#lift_option this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_sequence (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_sequence", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_while (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_while", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_for", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_expression x1; + this#lift_Parsetree_expression x2; + this#lift_Asttypes_direction_flag x3; + this#lift_Parsetree_expression x4]) + | Parsetree.Pexp_constraint (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_constraint", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_coerce (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_coerce", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Pexp_send (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_send", + [this#lift_Parsetree_expression x0; this#string x1]) + | Parsetree.Pexp_new x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_new", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_setinstvar (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_setinstvar", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_override x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_override", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) x0)]) + | Parsetree.Pexp_letmodule (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_letmodule", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_module_expr x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_letexception (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_letexception", + [this#lift_Parsetree_extension_constructor x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_assert x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_assert", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_lazy x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_lazy", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_poly (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_poly", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_object x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_object", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pexp_newtype (x0,x1) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_newtype", + [this#string x0; this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_pack x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_pack", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pexp_open (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_extension x0 -> + this#constr "Ast_404.Parsetree.expression_desc" + ("Pexp_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pexp_unreachable -> + this#constr "Ast_404.Parsetree.expression_desc" ("Pexp_unreachable", []) : + Parsetree.expression_desc -> 'res) + method lift_Asttypes_direction_flag : Asttypes.direction_flag -> 'res= + (function + | Asttypes.Upto -> this#constr "Ast_404.Asttypes.direction_flag" ("Upto", []) + | Asttypes.Downto -> + this#constr "Ast_404.Asttypes.direction_flag" ("Downto", []) : Asttypes.direction_flag + -> + 'res) + method lift_Parsetree_case : Parsetree.case -> 'res= + (fun + { Parsetree.pc_lhs = pc_lhs; Parsetree.pc_guard = pc_guard; + Parsetree.pc_rhs = pc_rhs } + -> + this#record "Ast_404.Parsetree.case" + [("pc_lhs", (this#lift_Parsetree_pattern pc_lhs)); + ("pc_guard", + (this#lift_option this#lift_Parsetree_expression pc_guard)); + ("pc_rhs", (this#lift_Parsetree_expression pc_rhs))] : Parsetree.case + -> + 'res) + method lift_Parsetree_value_binding : Parsetree.value_binding -> 'res= + (fun + { Parsetree.pvb_pat = pvb_pat; Parsetree.pvb_expr = pvb_expr; + Parsetree.pvb_attributes = pvb_attributes; + Parsetree.pvb_loc = pvb_loc } + -> + this#record "Ast_404.Parsetree.value_binding" + [("pvb_pat", (this#lift_Parsetree_pattern pvb_pat)); + ("pvb_expr", (this#lift_Parsetree_expression pvb_expr)); + ("pvb_attributes", + (this#lift_Parsetree_attributes pvb_attributes)); + ("pvb_loc", (this#lift_Location_t pvb_loc))] : Parsetree.value_binding + -> 'res) + method lift_Parsetree_pattern : Parsetree.pattern -> 'res= + (fun + { Parsetree.ppat_desc = ppat_desc; Parsetree.ppat_loc = ppat_loc; + Parsetree.ppat_attributes = ppat_attributes } + -> + this#record "Ast_404.Parsetree.pattern" + [("ppat_desc", (this#lift_Parsetree_pattern_desc ppat_desc)); + ("ppat_loc", (this#lift_Location_t ppat_loc)); + ("ppat_attributes", + (this#lift_Parsetree_attributes ppat_attributes))] : Parsetree.pattern + -> + 'res) + method lift_Parsetree_pattern_desc : Parsetree.pattern_desc -> 'res= + (function + | Parsetree.Ppat_any -> + this#constr "Ast_404.Parsetree.pattern_desc" ("Ppat_any", []) + | Parsetree.Ppat_var x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_var", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_alias (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_alias", + [this#lift_Parsetree_pattern x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Ppat_constant x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Ppat_interval (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_interval", + [this#lift_Parsetree_constant x0; + this#lift_Parsetree_constant x1]) + | Parsetree.Ppat_tuple x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_tuple", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_construct (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_variant (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_record (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ppat_array x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_array", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_or (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_or", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_constraint (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_constraint", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Ppat_type x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_type", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Ppat_lazy x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_lazy", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_unpack x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_unpack", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_exception x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_exception", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_extension x0 -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Ppat_open (x0,x1) -> + this#constr "Ast_404.Parsetree.pattern_desc" + ("Ppat_open", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) : Parsetree.pattern_desc -> + 'res) + method lift_Parsetree_core_type : Parsetree.core_type -> 'res= + (fun + { Parsetree.ptyp_desc = ptyp_desc; Parsetree.ptyp_loc = ptyp_loc; + Parsetree.ptyp_attributes = ptyp_attributes } + -> + this#record "Ast_404.Parsetree.core_type" + [("ptyp_desc", (this#lift_Parsetree_core_type_desc ptyp_desc)); + ("ptyp_loc", (this#lift_Location_t ptyp_loc)); + ("ptyp_attributes", + (this#lift_Parsetree_attributes ptyp_attributes))] : Parsetree.core_type + -> + 'res) + method lift_Parsetree_core_type_desc : Parsetree.core_type_desc -> 'res= + (function + | Parsetree.Ptyp_any -> + this#constr "Ast_404.Parsetree.core_type_desc" ("Ptyp_any", []) + | Parsetree.Ptyp_var x0 -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_var", [this#string x0]) + | Parsetree.Ptyp_arrow (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Ptyp_tuple x0 -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Ptyp_constr (x0,x1) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_object (x0,x1) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_object", + [this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#string x0; + this#lift_Parsetree_attributes x1; + this#lift_Parsetree_core_type x2]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ptyp_class (x0,x1) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_class", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_alias (x0,x1) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_alias", + [this#lift_Parsetree_core_type x0; this#string x1]) + | Parsetree.Ptyp_variant (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_variant", + [this#list (List.map this#lift_Parsetree_row_field x0); + this#lift_Asttypes_closed_flag x1; + this#lift_option + (fun x -> this#list (List.map this#lift_Asttypes_label x)) + x2]) + | Parsetree.Ptyp_poly (x0,x1) -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_poly", + [this#list (List.map this#string x0); + this#lift_Parsetree_core_type x1]) + | Parsetree.Ptyp_package x0 -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_package", [this#lift_Parsetree_package_type x0]) + | Parsetree.Ptyp_extension x0 -> + this#constr "Ast_404.Parsetree.core_type_desc" + ("Ptyp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.core_type_desc -> 'res) + method lift_Parsetree_package_type : Parsetree.package_type -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_core_type x1]) x1)] : Parsetree.package_type + -> 'res) + method lift_Parsetree_row_field : Parsetree.row_field -> 'res= + (function + | Parsetree.Rtag (x0,x1,x2,x3) -> + this#constr "Ast_404.Parsetree.row_field" + ("Rtag", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_bool x2; + this#list (List.map this#lift_Parsetree_core_type x3)]) + | Parsetree.Rinherit x0 -> + this#constr "Ast_404.Parsetree.row_field" + ("Rinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.row_field + -> + 'res) + method lift_Parsetree_attributes : Parsetree.attributes -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_attribute x) : + Parsetree.attributes -> 'res) + method lift_Parsetree_attribute : Parsetree.attribute -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.attribute -> 'res) + method lift_Parsetree_payload : Parsetree.payload -> 'res= + (function + | Parsetree.PStr x0 -> + this#constr "Ast_404.Parsetree.payload" + ("PStr", [this#lift_Parsetree_structure x0]) + | Parsetree.PSig x0 -> + this#constr "Ast_404.Parsetree.payload" + ("PSig", [this#lift_Parsetree_signature x0]) + | Parsetree.PTyp x0 -> + this#constr "Ast_404.Parsetree.payload" + ("PTyp", [this#lift_Parsetree_core_type x0]) + | Parsetree.PPat (x0,x1) -> + this#constr "Ast_404.Parsetree.payload" + ("PPat", + [this#lift_Parsetree_pattern x0; + this#lift_option this#lift_Parsetree_expression x1]) : + Parsetree.payload -> 'res) + method lift_Parsetree_structure : Parsetree.structure -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_structure_item x) : + Parsetree.structure -> 'res) + method lift_Parsetree_structure_item : Parsetree.structure_item -> 'res= + (fun { Parsetree.pstr_desc = pstr_desc; Parsetree.pstr_loc = pstr_loc } + -> + this#record "Ast_404.Parsetree.structure_item" + [("pstr_desc", + (this#lift_Parsetree_structure_item_desc pstr_desc)); + ("pstr_loc", (this#lift_Location_t pstr_loc))] : Parsetree.structure_item + -> 'res) + method lift_Parsetree_structure_item_desc : + Parsetree.structure_item_desc -> 'res= + (function + | Parsetree.Pstr_eval (x0,x1) -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_eval", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_attributes x1]) + | Parsetree.Pstr_value (x0,x1) -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_value", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1)]) + | Parsetree.Pstr_primitive x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_primitive", [this#lift_Parsetree_value_description x0]) + | Parsetree.Pstr_type (x0,x1) -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Pstr_typext x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Pstr_exception x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Pstr_module x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_module", [this#lift_Parsetree_module_binding x0]) + | Parsetree.Pstr_recmodule x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_recmodule", + [this#list (List.map this#lift_Parsetree_module_binding x0)]) + | Parsetree.Pstr_modtype x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Pstr_open x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Pstr_class x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_class", + [this#list (List.map this#lift_Parsetree_class_declaration x0)]) + | Parsetree.Pstr_class_type x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Pstr_include x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_include", [this#lift_Parsetree_include_declaration x0]) + | Parsetree.Pstr_attribute x0 -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pstr_extension (x0,x1) -> + this#constr "Ast_404.Parsetree.structure_item_desc" + ("Pstr_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.structure_item_desc + -> 'res) + method lift_Parsetree_include_declaration : + Parsetree.include_declaration -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_expr x : + Parsetree.include_declaration -> 'res) + method lift_Parsetree_class_declaration : + Parsetree.class_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_expr x : + Parsetree.class_declaration -> 'res) + method lift_Parsetree_class_expr : Parsetree.class_expr -> 'res= + (fun + { Parsetree.pcl_desc = pcl_desc; Parsetree.pcl_loc = pcl_loc; + Parsetree.pcl_attributes = pcl_attributes } + -> + this#record "Ast_404.Parsetree.class_expr" + [("pcl_desc", (this#lift_Parsetree_class_expr_desc pcl_desc)); + ("pcl_loc", (this#lift_Location_t pcl_loc)); + ("pcl_attributes", + (this#lift_Parsetree_attributes pcl_attributes))] : Parsetree.class_expr + -> + 'res) + method lift_Parsetree_class_expr_desc : + Parsetree.class_expr_desc -> 'res= + (function + | Parsetree.Pcl_constr (x0,x1) -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcl_structure x0 -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_structure", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pcl_fun (x0,x1,x2,x3) -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_class_expr x3]) + | Parsetree.Pcl_apply (x0,x1) -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_apply", + [this#lift_Parsetree_class_expr x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pcl_let (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_class_expr x2]) + | Parsetree.Pcl_constraint (x0,x1) -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_constraint", + [this#lift_Parsetree_class_expr x0; + this#lift_Parsetree_class_type x1]) + | Parsetree.Pcl_extension x0 -> + this#constr "Ast_404.Parsetree.class_expr_desc" + ("Pcl_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_expr_desc -> 'res) + method lift_Parsetree_class_structure : + Parsetree.class_structure -> 'res= + (fun + { Parsetree.pcstr_self = pcstr_self; + Parsetree.pcstr_fields = pcstr_fields } + -> + this#record "Ast_404.Parsetree.class_structure" + [("pcstr_self", (this#lift_Parsetree_pattern pcstr_self)); + ("pcstr_fields", + (this#list + (List.map this#lift_Parsetree_class_field pcstr_fields)))] : + Parsetree.class_structure -> 'res) + method lift_Parsetree_class_field : Parsetree.class_field -> 'res= + (fun + { Parsetree.pcf_desc = pcf_desc; Parsetree.pcf_loc = pcf_loc; + Parsetree.pcf_attributes = pcf_attributes } + -> + this#record "Ast_404.Parsetree.class_field" + [("pcf_desc", (this#lift_Parsetree_class_field_desc pcf_desc)); + ("pcf_loc", (this#lift_Location_t pcf_loc)); + ("pcf_attributes", + (this#lift_Parsetree_attributes pcf_attributes))] : Parsetree.class_field + -> + 'res) + method lift_Parsetree_class_field_desc : + Parsetree.class_field_desc -> 'res= + (function + | Parsetree.Pcf_inherit (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_inherit", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_class_expr x1; + this#lift_option this#string x2]) + | Parsetree.Pcf_val x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_val", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_method x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_method", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_constraint x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pcf_initializer x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_initializer", [this#lift_Parsetree_expression x0]) + | Parsetree.Pcf_attribute x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pcf_extension x0 -> + this#constr "Ast_404.Parsetree.class_field_desc" + ("Pcf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_field_desc -> 'res) + method lift_Parsetree_class_field_kind : + Parsetree.class_field_kind -> 'res= + (function + | Parsetree.Cfk_virtual x0 -> + this#constr "Ast_404.Parsetree.class_field_kind" + ("Cfk_virtual", [this#lift_Parsetree_core_type x0]) + | Parsetree.Cfk_concrete (x0,x1) -> + this#constr "Ast_404.Parsetree.class_field_kind" + ("Cfk_concrete", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_expression x1]) : Parsetree.class_field_kind + -> 'res) + method lift_Parsetree_module_binding : Parsetree.module_binding -> 'res= + (fun + { Parsetree.pmb_name = pmb_name; Parsetree.pmb_expr = pmb_expr; + Parsetree.pmb_attributes = pmb_attributes; + Parsetree.pmb_loc = pmb_loc } + -> + this#record "Ast_404.Parsetree.module_binding" + [("pmb_name", (this#lift_Asttypes_loc this#string pmb_name)); + ("pmb_expr", (this#lift_Parsetree_module_expr pmb_expr)); + ("pmb_attributes", + (this#lift_Parsetree_attributes pmb_attributes)); + ("pmb_loc", (this#lift_Location_t pmb_loc))] : Parsetree.module_binding + -> 'res) + method lift_Parsetree_module_expr : Parsetree.module_expr -> 'res= + (fun + { Parsetree.pmod_desc = pmod_desc; Parsetree.pmod_loc = pmod_loc; + Parsetree.pmod_attributes = pmod_attributes } + -> + this#record "Ast_404.Parsetree.module_expr" + [("pmod_desc", (this#lift_Parsetree_module_expr_desc pmod_desc)); + ("pmod_loc", (this#lift_Location_t pmod_loc)); + ("pmod_attributes", + (this#lift_Parsetree_attributes pmod_attributes))] : Parsetree.module_expr + -> + 'res) + method lift_Parsetree_module_expr_desc : + Parsetree.module_expr_desc -> 'res= + (function + | Parsetree.Pmod_ident x0 -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmod_structure x0 -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_structure", [this#lift_Parsetree_structure x0]) + | Parsetree.Pmod_functor (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_expr x2]) + | Parsetree.Pmod_apply (x0,x1) -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_apply", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_expr x1]) + | Parsetree.Pmod_constraint (x0,x1) -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_constraint", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_type x1]) + | Parsetree.Pmod_unpack x0 -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_unpack", [this#lift_Parsetree_expression x0]) + | Parsetree.Pmod_extension x0 -> + this#constr "Ast_404.Parsetree.module_expr_desc" + ("Pmod_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.module_expr_desc -> 'res) + method lift_Parsetree_module_type : Parsetree.module_type -> 'res= + (fun + { Parsetree.pmty_desc = pmty_desc; Parsetree.pmty_loc = pmty_loc; + Parsetree.pmty_attributes = pmty_attributes } + -> + this#record "Ast_404.Parsetree.module_type" + [("pmty_desc", (this#lift_Parsetree_module_type_desc pmty_desc)); + ("pmty_loc", (this#lift_Location_t pmty_loc)); + ("pmty_attributes", + (this#lift_Parsetree_attributes pmty_attributes))] : Parsetree.module_type + -> + 'res) + method lift_Parsetree_module_type_desc : + Parsetree.module_type_desc -> 'res= + (function + | Parsetree.Pmty_ident x0 -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmty_signature x0 -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_signature", [this#lift_Parsetree_signature x0]) + | Parsetree.Pmty_functor (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_type x2]) + | Parsetree.Pmty_with (x0,x1) -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_with", + [this#lift_Parsetree_module_type x0; + this#list (List.map this#lift_Parsetree_with_constraint x1)]) + | Parsetree.Pmty_typeof x0 -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_typeof", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pmty_extension x0 -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pmty_alias x0 -> + this#constr "Ast_404.Parsetree.module_type_desc" + ("Pmty_alias", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.module_type_desc + -> + 'res) + method lift_Parsetree_with_constraint : + Parsetree.with_constraint -> 'res= + (function + | Parsetree.Pwith_type (x0,x1) -> + this#constr "Ast_404.Parsetree.with_constraint" + ("Pwith_type", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_module (x0,x1) -> + this#constr "Ast_404.Parsetree.with_constraint" + ("Pwith_module", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pwith_typesubst x0 -> + this#constr "Ast_404.Parsetree.with_constraint" + ("Pwith_typesubst", [this#lift_Parsetree_type_declaration x0]) + | Parsetree.Pwith_modsubst (x0,x1) -> + this#constr "Ast_404.Parsetree.with_constraint" + ("Pwith_modsubst", + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) : Parsetree.with_constraint + -> + 'res) + method lift_Parsetree_signature : Parsetree.signature -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_signature_item x) : + Parsetree.signature -> 'res) + method lift_Parsetree_signature_item : Parsetree.signature_item -> 'res= + (fun { Parsetree.psig_desc = psig_desc; Parsetree.psig_loc = psig_loc } + -> + this#record "Ast_404.Parsetree.signature_item" + [("psig_desc", + (this#lift_Parsetree_signature_item_desc psig_desc)); + ("psig_loc", (this#lift_Location_t psig_loc))] : Parsetree.signature_item + -> 'res) + method lift_Parsetree_signature_item_desc : + Parsetree.signature_item_desc -> 'res= + (function + | Parsetree.Psig_value x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_value", [this#lift_Parsetree_value_description x0]) + | Parsetree.Psig_type (x0,x1) -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Psig_typext x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Psig_exception x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Psig_module x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_module", [this#lift_Parsetree_module_declaration x0]) + | Parsetree.Psig_recmodule x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_recmodule", + [this#list + (List.map this#lift_Parsetree_module_declaration x0)]) + | Parsetree.Psig_modtype x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Psig_open x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Psig_include x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_include", [this#lift_Parsetree_include_description x0]) + | Parsetree.Psig_class x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_class", + [this#list (List.map this#lift_Parsetree_class_description x0)]) + | Parsetree.Psig_class_type x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Psig_attribute x0 -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Psig_extension (x0,x1) -> + this#constr "Ast_404.Parsetree.signature_item_desc" + ("Psig_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.signature_item_desc + -> 'res) + method lift_Parsetree_class_type_declaration : + Parsetree.class_type_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_type_declaration -> 'res) + method lift_Parsetree_class_description : + Parsetree.class_description -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_description -> 'res) + method lift_Parsetree_class_type : Parsetree.class_type -> 'res= + (fun + { Parsetree.pcty_desc = pcty_desc; Parsetree.pcty_loc = pcty_loc; + Parsetree.pcty_attributes = pcty_attributes } + -> + this#record "Ast_404.Parsetree.class_type" + [("pcty_desc", (this#lift_Parsetree_class_type_desc pcty_desc)); + ("pcty_loc", (this#lift_Location_t pcty_loc)); + ("pcty_attributes", + (this#lift_Parsetree_attributes pcty_attributes))] : Parsetree.class_type + -> + 'res) + method lift_Parsetree_class_type_desc : + Parsetree.class_type_desc -> 'res= + (function + | Parsetree.Pcty_constr (x0,x1) -> + this#constr "Ast_404.Parsetree.class_type_desc" + ("Pcty_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcty_signature x0 -> + this#constr "Ast_404.Parsetree.class_type_desc" + ("Pcty_signature", [this#lift_Parsetree_class_signature x0]) + | Parsetree.Pcty_arrow (x0,x1,x2) -> + this#constr "Ast_404.Parsetree.class_type_desc" + ("Pcty_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_class_type x2]) + | Parsetree.Pcty_extension x0 -> + this#constr "Ast_404.Parsetree.class_type_desc" + ("Pcty_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_desc -> 'res) + method lift_Parsetree_class_signature : + Parsetree.class_signature -> 'res= + (fun + { Parsetree.pcsig_self = pcsig_self; + Parsetree.pcsig_fields = pcsig_fields } + -> + this#record "Ast_404.Parsetree.class_signature" + [("pcsig_self", (this#lift_Parsetree_core_type pcsig_self)); + ("pcsig_fields", + (this#list + (List.map this#lift_Parsetree_class_type_field pcsig_fields)))] : + Parsetree.class_signature -> 'res) + method lift_Parsetree_class_type_field : + Parsetree.class_type_field -> 'res= + (fun + { Parsetree.pctf_desc = pctf_desc; Parsetree.pctf_loc = pctf_loc; + Parsetree.pctf_attributes = pctf_attributes } + -> + this#record "Ast_404.Parsetree.class_type_field" + [("pctf_desc", + (this#lift_Parsetree_class_type_field_desc pctf_desc)); + ("pctf_loc", (this#lift_Location_t pctf_loc)); + ("pctf_attributes", + (this#lift_Parsetree_attributes pctf_attributes))] : Parsetree.class_type_field + -> + 'res) + method lift_Parsetree_class_type_field_desc : + Parsetree.class_type_field_desc -> 'res= + (function + | Parsetree.Pctf_inherit x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_inherit", [this#lift_Parsetree_class_type x0]) + | Parsetree.Pctf_val x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_val", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_method x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_method", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_constraint x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pctf_attribute x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pctf_extension x0 -> + this#constr "Ast_404.Parsetree.class_type_field_desc" + ("Pctf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_field_desc -> 'res) + method lift_Parsetree_extension : Parsetree.extension -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.extension -> 'res) + method lift_Parsetree_class_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.class_infos -> 'res= fun (type f0) + -> + (fun f0 -> + fun + { Parsetree.pci_virt = pci_virt; + Parsetree.pci_params = pci_params; + Parsetree.pci_name = pci_name; Parsetree.pci_expr = pci_expr; + Parsetree.pci_loc = pci_loc; + Parsetree.pci_attributes = pci_attributes } + -> + this#record "Ast_404.Parsetree.class_infos" + [("pci_virt", (this#lift_Asttypes_virtual_flag pci_virt)); + ("pci_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) pci_params))); + ("pci_name", (this#lift_Asttypes_loc this#string pci_name)); + ("pci_expr", (f0 pci_expr)); + ("pci_loc", (this#lift_Location_t pci_loc)); + ("pci_attributes", + (this#lift_Parsetree_attributes pci_attributes))] : (f0 -> + 'res) -> + f0 + Parsetree.class_infos + -> + 'res) + method lift_Asttypes_virtual_flag : Asttypes.virtual_flag -> 'res= + (function + | Asttypes.Virtual -> + this#constr "Ast_404.Asttypes.virtual_flag" ("Virtual", []) + | Asttypes.Concrete -> + this#constr "Ast_404.Asttypes.virtual_flag" ("Concrete", []) : Asttypes.virtual_flag + -> + 'res) + method lift_Parsetree_include_description : + Parsetree.include_description -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_type x : + Parsetree.include_description -> 'res) + method lift_Parsetree_include_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.include_infos -> 'res= fun (type + f0) -> + (fun f0 -> + fun + { Parsetree.pincl_mod = pincl_mod; + Parsetree.pincl_loc = pincl_loc; + Parsetree.pincl_attributes = pincl_attributes } + -> + this#record "Ast_404.Parsetree.include_infos" + [("pincl_mod", (f0 pincl_mod)); + ("pincl_loc", (this#lift_Location_t pincl_loc)); + ("pincl_attributes", + (this#lift_Parsetree_attributes pincl_attributes))] : + (f0 -> 'res) -> f0 Parsetree.include_infos -> 'res) + method lift_Parsetree_open_description : + Parsetree.open_description -> 'res= + (fun + { Parsetree.popen_lid = popen_lid; + Parsetree.popen_override = popen_override; + Parsetree.popen_loc = popen_loc; + Parsetree.popen_attributes = popen_attributes } + -> + this#record "Ast_404.Parsetree.open_description" + [("popen_lid", + (this#lift_Asttypes_loc this#lift_Longident_t popen_lid)); + ("popen_override", + (this#lift_Asttypes_override_flag popen_override)); + ("popen_loc", (this#lift_Location_t popen_loc)); + ("popen_attributes", + (this#lift_Parsetree_attributes popen_attributes))] : Parsetree.open_description + -> + 'res) + method lift_Asttypes_override_flag : Asttypes.override_flag -> 'res= + (function + | Asttypes.Override -> + this#constr "Ast_404.Asttypes.override_flag" ("Override", []) + | Asttypes.Fresh -> + this#constr "Ast_404.Asttypes.override_flag" ("Fresh", []) : Asttypes.override_flag + -> + 'res) + method lift_Parsetree_module_type_declaration : + Parsetree.module_type_declaration -> 'res= + (fun + { Parsetree.pmtd_name = pmtd_name; Parsetree.pmtd_type = pmtd_type; + Parsetree.pmtd_attributes = pmtd_attributes; + Parsetree.pmtd_loc = pmtd_loc } + -> + this#record "Ast_404.Parsetree.module_type_declaration" + [("pmtd_name", (this#lift_Asttypes_loc this#string pmtd_name)); + ("pmtd_type", + (this#lift_option this#lift_Parsetree_module_type pmtd_type)); + ("pmtd_attributes", + (this#lift_Parsetree_attributes pmtd_attributes)); + ("pmtd_loc", (this#lift_Location_t pmtd_loc))] : Parsetree.module_type_declaration + -> 'res) + method lift_Parsetree_module_declaration : + Parsetree.module_declaration -> 'res= + (fun + { Parsetree.pmd_name = pmd_name; Parsetree.pmd_type = pmd_type; + Parsetree.pmd_attributes = pmd_attributes; + Parsetree.pmd_loc = pmd_loc } + -> + this#record "Ast_404.Parsetree.module_declaration" + [("pmd_name", (this#lift_Asttypes_loc this#string pmd_name)); + ("pmd_type", (this#lift_Parsetree_module_type pmd_type)); + ("pmd_attributes", + (this#lift_Parsetree_attributes pmd_attributes)); + ("pmd_loc", (this#lift_Location_t pmd_loc))] : Parsetree.module_declaration + -> 'res) + method lift_Parsetree_type_extension : Parsetree.type_extension -> 'res= + (fun + { Parsetree.ptyext_path = ptyext_path; + Parsetree.ptyext_params = ptyext_params; + Parsetree.ptyext_constructors = ptyext_constructors; + Parsetree.ptyext_private = ptyext_private; + Parsetree.ptyext_attributes = ptyext_attributes } + -> + this#record "Ast_404.Parsetree.type_extension" + [("ptyext_path", + (this#lift_Asttypes_loc this#lift_Longident_t ptyext_path)); + ("ptyext_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptyext_params))); + ("ptyext_constructors", + (this#list + (List.map this#lift_Parsetree_extension_constructor + ptyext_constructors))); + ("ptyext_private", + (this#lift_Asttypes_private_flag ptyext_private)); + ("ptyext_attributes", + (this#lift_Parsetree_attributes ptyext_attributes))] : Parsetree.type_extension + -> + 'res) + method lift_Parsetree_extension_constructor : + Parsetree.extension_constructor -> 'res= + (fun + { Parsetree.pext_name = pext_name; Parsetree.pext_kind = pext_kind; + Parsetree.pext_loc = pext_loc; + Parsetree.pext_attributes = pext_attributes } + -> + this#record "Ast_404.Parsetree.extension_constructor" + [("pext_name", (this#lift_Asttypes_loc this#string pext_name)); + ("pext_kind", + (this#lift_Parsetree_extension_constructor_kind pext_kind)); + ("pext_loc", (this#lift_Location_t pext_loc)); + ("pext_attributes", + (this#lift_Parsetree_attributes pext_attributes))] : Parsetree.extension_constructor + -> + 'res) + method lift_Parsetree_extension_constructor_kind : + Parsetree.extension_constructor_kind -> 'res= + (function + | Parsetree.Pext_decl (x0,x1) -> + this#constr "Ast_404.Parsetree.extension_constructor_kind" + ("Pext_decl", + [this#lift_Parsetree_constructor_arguments x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pext_rebind x0 -> + this#constr "Ast_404.Parsetree.extension_constructor_kind" + ("Pext_rebind", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.extension_constructor_kind + -> + 'res) + method lift_Parsetree_type_declaration : + Parsetree.type_declaration -> 'res= + (fun + { Parsetree.ptype_name = ptype_name; + Parsetree.ptype_params = ptype_params; + Parsetree.ptype_cstrs = ptype_cstrs; + Parsetree.ptype_kind = ptype_kind; + Parsetree.ptype_private = ptype_private; + Parsetree.ptype_manifest = ptype_manifest; + Parsetree.ptype_attributes = ptype_attributes; + Parsetree.ptype_loc = ptype_loc } + -> + this#record "Ast_404.Parsetree.type_declaration" + [("ptype_name", (this#lift_Asttypes_loc this#string ptype_name)); + ("ptype_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptype_params))); + ("ptype_cstrs", + (this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1; + this#lift_Location_t x2]) ptype_cstrs))); + ("ptype_kind", (this#lift_Parsetree_type_kind ptype_kind)); + ("ptype_private", (this#lift_Asttypes_private_flag ptype_private)); + ("ptype_manifest", + (this#lift_option this#lift_Parsetree_core_type ptype_manifest)); + ("ptype_attributes", + (this#lift_Parsetree_attributes ptype_attributes)); + ("ptype_loc", (this#lift_Location_t ptype_loc))] : Parsetree.type_declaration + -> 'res) + method lift_Asttypes_private_flag : Asttypes.private_flag -> 'res= + (function + | Asttypes.Private -> + this#constr "Ast_404.Asttypes.private_flag" ("Private", []) + | Asttypes.Public -> + this#constr "Ast_404.Asttypes.private_flag" ("Public", []) : Asttypes.private_flag + -> + 'res) + method lift_Parsetree_type_kind : Parsetree.type_kind -> 'res= + (function + | Parsetree.Ptype_abstract -> + this#constr "Ast_404.Parsetree.type_kind" ("Ptype_abstract", []) + | Parsetree.Ptype_variant x0 -> + this#constr "Ast_404.Parsetree.type_kind" + ("Ptype_variant", + [this#list + (List.map this#lift_Parsetree_constructor_declaration x0)]) + | Parsetree.Ptype_record x0 -> + this#constr "Ast_404.Parsetree.type_kind" + ("Ptype_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) + | Parsetree.Ptype_open -> + this#constr "Ast_404.Parsetree.type_kind" ("Ptype_open", []) : Parsetree.type_kind + -> + 'res) + method lift_Parsetree_constructor_declaration : + Parsetree.constructor_declaration -> 'res= + (fun + { Parsetree.pcd_name = pcd_name; Parsetree.pcd_args = pcd_args; + Parsetree.pcd_res = pcd_res; Parsetree.pcd_loc = pcd_loc; + Parsetree.pcd_attributes = pcd_attributes } + -> + this#record "Ast_404.Parsetree.constructor_declaration" + [("pcd_name", (this#lift_Asttypes_loc this#string pcd_name)); + ("pcd_args", (this#lift_Parsetree_constructor_arguments pcd_args)); + ("pcd_res", + (this#lift_option this#lift_Parsetree_core_type pcd_res)); + ("pcd_loc", (this#lift_Location_t pcd_loc)); + ("pcd_attributes", + (this#lift_Parsetree_attributes pcd_attributes))] : Parsetree.constructor_declaration + -> + 'res) + method lift_Parsetree_constructor_arguments : + Parsetree.constructor_arguments -> 'res= + (function + | Parsetree.Pcstr_tuple x0 -> + this#constr "Ast_404.Parsetree.constructor_arguments" + ("Pcstr_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Pcstr_record x0 -> + this#constr "Ast_404.Parsetree.constructor_arguments" + ("Pcstr_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) : + Parsetree.constructor_arguments -> 'res) + method lift_Parsetree_label_declaration : + Parsetree.label_declaration -> 'res= + (fun + { Parsetree.pld_name = pld_name; + Parsetree.pld_mutable = pld_mutable; + Parsetree.pld_type = pld_type; Parsetree.pld_loc = pld_loc; + Parsetree.pld_attributes = pld_attributes } + -> + this#record "Ast_404.Parsetree.label_declaration" + [("pld_name", (this#lift_Asttypes_loc this#string pld_name)); + ("pld_mutable", (this#lift_Asttypes_mutable_flag pld_mutable)); + ("pld_type", (this#lift_Parsetree_core_type pld_type)); + ("pld_loc", (this#lift_Location_t pld_loc)); + ("pld_attributes", + (this#lift_Parsetree_attributes pld_attributes))] : Parsetree.label_declaration + -> + 'res) + method lift_Asttypes_mutable_flag : Asttypes.mutable_flag -> 'res= + (function + | Asttypes.Immutable -> + this#constr "Ast_404.Asttypes.mutable_flag" ("Immutable", []) + | Asttypes.Mutable -> + this#constr "Ast_404.Asttypes.mutable_flag" ("Mutable", []) : Asttypes.mutable_flag + -> + 'res) + method lift_Asttypes_variance : Asttypes.variance -> 'res= + (function + | Asttypes.Covariant -> + this#constr "Ast_404.Asttypes.variance" ("Covariant", []) + | Asttypes.Contravariant -> + this#constr "Ast_404.Asttypes.variance" ("Contravariant", []) + | Asttypes.Invariant -> + this#constr "Ast_404.Asttypes.variance" ("Invariant", []) : Asttypes.variance + -> 'res) + method lift_Parsetree_value_description : + Parsetree.value_description -> 'res= + (fun + { Parsetree.pval_name = pval_name; Parsetree.pval_type = pval_type; + Parsetree.pval_prim = pval_prim; + Parsetree.pval_attributes = pval_attributes; + Parsetree.pval_loc = pval_loc } + -> + this#record "Ast_404.Parsetree.value_description" + [("pval_name", (this#lift_Asttypes_loc this#string pval_name)); + ("pval_type", (this#lift_Parsetree_core_type pval_type)); + ("pval_prim", (this#list (List.map this#string pval_prim))); + ("pval_attributes", + (this#lift_Parsetree_attributes pval_attributes)); + ("pval_loc", (this#lift_Location_t pval_loc))] : Parsetree.value_description + -> 'res) + method lift_Asttypes_arg_label : Asttypes.arg_label -> 'res= + (function + | Asttypes.Nolabel -> + this#constr "Ast_404.Asttypes.arg_label" ("Nolabel", []) + | Asttypes.Labelled x0 -> + this#constr "Ast_404.Asttypes.arg_label" ("Labelled", [this#string x0]) + | Asttypes.Optional x0 -> + this#constr "Ast_404.Asttypes.arg_label" ("Optional", [this#string x0]) : + Asttypes.arg_label -> 'res) + method lift_Asttypes_closed_flag : Asttypes.closed_flag -> 'res= + (function + | Asttypes.Closed -> + this#constr "Ast_404.Asttypes.closed_flag" ("Closed", []) + | Asttypes.Open -> this#constr "Ast_404.Asttypes.closed_flag" ("Open", []) : + Asttypes.closed_flag -> 'res) + method lift_Asttypes_label : Asttypes.label -> 'res= + (this#string : Asttypes.label -> 'res) + method lift_Asttypes_rec_flag : Asttypes.rec_flag -> 'res= + (function + | Asttypes.Nonrecursive -> + this#constr "Ast_404.Asttypes.rec_flag" ("Nonrecursive", []) + | Asttypes.Recursive -> + this#constr "Ast_404.Asttypes.rec_flag" ("Recursive", []) : Asttypes.rec_flag + -> 'res) + method lift_Parsetree_constant : Parsetree.constant -> 'res= + (function + | Parsetree.Pconst_integer (x0,x1) -> + this#constr "Ast_404.Parsetree.constant" + ("Pconst_integer", + [this#string x0; this#lift_option this#char x1]) + | Parsetree.Pconst_char x0 -> + this#constr "Ast_404.Parsetree.constant" ("Pconst_char", [this#char x0]) + | Parsetree.Pconst_string (x0,x1) -> + this#constr "Ast_404.Parsetree.constant" + ("Pconst_string", + [this#string x0; this#lift_option this#string x1]) + | Parsetree.Pconst_float (x0,x1) -> + this#constr "Ast_404.Parsetree.constant" + ("Pconst_float", + [this#string x0; this#lift_option this#char x1]) : Parsetree.constant + -> + 'res) + method lift_option : 'f0 . ('f0 -> 'res) -> 'f0 option -> 'res= fun (type + f0) -> + (fun f0 -> + function + | None -> this#constr "option" ("None", []) + | Some x0 -> this#constr "option" ("Some", [f0 x0]) : (f0 -> 'res) + -> + f0 option -> + 'res) + method lift_Longident_t : Longident.t -> 'res= + (function + | Longident.Lident x0 -> + this#constr "Ast_404.Longident.t" ("Lident", [this#string x0]) + | Longident.Ldot (x0,x1) -> + this#constr "Ast_404.Longident.t" + ("Ldot", [this#lift_Longident_t x0; this#string x1]) + | Longident.Lapply (x0,x1) -> + this#constr "Ast_404.Longident.t" + ("Lapply", [this#lift_Longident_t x0; this#lift_Longident_t x1]) : + Longident.t -> 'res) + method lift_Asttypes_loc : + 'f0 . ('f0 -> 'res) -> 'f0 Asttypes.loc -> 'res= fun (type f0) -> + (fun f0 -> + fun { Asttypes.txt = txt; Asttypes.loc = loc } -> + this#record "Ast_404.Asttypes.loc" + [("txt", (f0 txt)); ("loc", (this#lift_Location_t loc))] : + (f0 -> 'res) -> f0 Asttypes.loc -> 'res) + method lift_Location_t : Location.t -> 'res= + (fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Ast_404.Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] : Location.t -> 'res) + method lift_bool : bool -> 'res= + (function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) : bool -> 'res) + method lift_Lexing_position : Lexing.position -> 'res= + (fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] : Lexing.position -> 'res) + end diff --git a/ast_lifter_405.ml b/ast_lifter_405.ml new file mode 100644 index 0000000..ad49f91 --- /dev/null +++ b/ast_lifter_405.ml @@ -0,0 +1,1393 @@ +open Ast_405 + +class virtual ['res] lifter = + object (this) + method lift_Parsetree_expression : Parsetree.expression -> 'res= + (fun + { Parsetree.pexp_desc = pexp_desc; Parsetree.pexp_loc = pexp_loc; + Parsetree.pexp_attributes = pexp_attributes } + -> + this#record "Ast_405.Parsetree.expression" + [("pexp_desc", (this#lift_Parsetree_expression_desc pexp_desc)); + ("pexp_loc", (this#lift_Location_t pexp_loc)); + ("pexp_attributes", + (this#lift_Parsetree_attributes pexp_attributes))] : Parsetree.expression + -> + 'res) + method lift_Parsetree_expression_desc : + Parsetree.expression_desc -> 'res= + (function + | Parsetree.Pexp_ident x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_constant x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Pexp_let (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_function x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_function", + [this#list (List.map this#lift_Parsetree_case x0)]) + | Parsetree.Pexp_fun (x0,x1,x2,x3) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_expression x3]) + | Parsetree.Pexp_apply (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_apply", + [this#lift_Parsetree_expression x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pexp_match (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_match", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_try (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_try", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_tuple x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_tuple", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_construct (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_variant (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_record (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_expression x1]) x0); + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_field (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_field", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pexp_setfield (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_setfield", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_array x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_array", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_ifthenelse (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_ifthenelse", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1; + this#lift_option this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_sequence (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_sequence", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_while (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_while", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_for", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_expression x1; + this#lift_Parsetree_expression x2; + this#lift_Asttypes_direction_flag x3; + this#lift_Parsetree_expression x4]) + | Parsetree.Pexp_constraint (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_constraint", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_coerce (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_coerce", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Pexp_send (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_send", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Pexp_new x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_new", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_setinstvar (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_setinstvar", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_override x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_override", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) x0)]) + | Parsetree.Pexp_letmodule (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_letmodule", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_module_expr x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_letexception (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_letexception", + [this#lift_Parsetree_extension_constructor x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_assert x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_assert", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_lazy x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_lazy", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_poly (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_poly", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_object x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_object", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pexp_newtype (x0,x1) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_newtype", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_pack x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_pack", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pexp_open (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_extension x0 -> + this#constr "Ast_405.Parsetree.expression_desc" + ("Pexp_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pexp_unreachable -> + this#constr "Ast_405.Parsetree.expression_desc" ("Pexp_unreachable", []) : + Parsetree.expression_desc -> 'res) + method lift_Asttypes_direction_flag : Asttypes.direction_flag -> 'res= + (function + | Asttypes.Upto -> this#constr "Ast_405.Asttypes.direction_flag" ("Upto", []) + | Asttypes.Downto -> + this#constr "Ast_405.Asttypes.direction_flag" ("Downto", []) : Asttypes.direction_flag + -> + 'res) + method lift_Parsetree_case : Parsetree.case -> 'res= + (fun + { Parsetree.pc_lhs = pc_lhs; Parsetree.pc_guard = pc_guard; + Parsetree.pc_rhs = pc_rhs } + -> + this#record "Ast_405.Parsetree.case" + [("pc_lhs", (this#lift_Parsetree_pattern pc_lhs)); + ("pc_guard", + (this#lift_option this#lift_Parsetree_expression pc_guard)); + ("pc_rhs", (this#lift_Parsetree_expression pc_rhs))] : Parsetree.case + -> + 'res) + method lift_Parsetree_value_binding : Parsetree.value_binding -> 'res= + (fun + { Parsetree.pvb_pat = pvb_pat; Parsetree.pvb_expr = pvb_expr; + Parsetree.pvb_attributes = pvb_attributes; + Parsetree.pvb_loc = pvb_loc } + -> + this#record "Ast_405.Parsetree.value_binding" + [("pvb_pat", (this#lift_Parsetree_pattern pvb_pat)); + ("pvb_expr", (this#lift_Parsetree_expression pvb_expr)); + ("pvb_attributes", + (this#lift_Parsetree_attributes pvb_attributes)); + ("pvb_loc", (this#lift_Location_t pvb_loc))] : Parsetree.value_binding + -> 'res) + method lift_Parsetree_pattern : Parsetree.pattern -> 'res= + (fun + { Parsetree.ppat_desc = ppat_desc; Parsetree.ppat_loc = ppat_loc; + Parsetree.ppat_attributes = ppat_attributes } + -> + this#record "Ast_405.Parsetree.pattern" + [("ppat_desc", (this#lift_Parsetree_pattern_desc ppat_desc)); + ("ppat_loc", (this#lift_Location_t ppat_loc)); + ("ppat_attributes", + (this#lift_Parsetree_attributes ppat_attributes))] : Parsetree.pattern + -> + 'res) + method lift_Parsetree_pattern_desc : Parsetree.pattern_desc -> 'res= + (function + | Parsetree.Ppat_any -> + this#constr "Ast_405.Parsetree.pattern_desc" ("Ppat_any", []) + | Parsetree.Ppat_var x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_var", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_alias (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_alias", + [this#lift_Parsetree_pattern x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Ppat_constant x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Ppat_interval (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_interval", + [this#lift_Parsetree_constant x0; + this#lift_Parsetree_constant x1]) + | Parsetree.Ppat_tuple x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_tuple", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_construct (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_variant (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_record (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_record", + [this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ppat_array x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_array", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_or (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_or", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_constraint (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_constraint", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Ppat_type x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_type", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Ppat_lazy x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_lazy", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_unpack x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_unpack", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_exception x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_exception", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_extension x0 -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Ppat_open (x0,x1) -> + this#constr "Ast_405.Parsetree.pattern_desc" + ("Ppat_open", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) : Parsetree.pattern_desc -> + 'res) + method lift_Parsetree_core_type : Parsetree.core_type -> 'res= + (fun + { Parsetree.ptyp_desc = ptyp_desc; Parsetree.ptyp_loc = ptyp_loc; + Parsetree.ptyp_attributes = ptyp_attributes } + -> + this#record "Ast_405.Parsetree.core_type" + [("ptyp_desc", (this#lift_Parsetree_core_type_desc ptyp_desc)); + ("ptyp_loc", (this#lift_Location_t ptyp_loc)); + ("ptyp_attributes", + (this#lift_Parsetree_attributes ptyp_attributes))] : Parsetree.core_type + -> + 'res) + method lift_Parsetree_core_type_desc : Parsetree.core_type_desc -> 'res= + (function + | Parsetree.Ptyp_any -> + this#constr "Ast_405.Parsetree.core_type_desc" ("Ptyp_any", []) + | Parsetree.Ptyp_var x0 -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_var", [this#string x0]) + | Parsetree.Ptyp_arrow (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Ptyp_tuple x0 -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Ptyp_constr (x0,x1) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_object (x0,x1) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_object", + [this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_attributes x1; + this#lift_Parsetree_core_type x2]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ptyp_class (x0,x1) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_class", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_alias (x0,x1) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_alias", + [this#lift_Parsetree_core_type x0; this#string x1]) + | Parsetree.Ptyp_variant (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_variant", + [this#list (List.map this#lift_Parsetree_row_field x0); + this#lift_Asttypes_closed_flag x1; + this#lift_option + (fun x -> this#list (List.map this#lift_Asttypes_label x)) + x2]) + | Parsetree.Ptyp_poly (x0,x1) -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_poly", + [this#list + (List.map (fun x -> this#lift_Asttypes_loc this#string x) + x0); + this#lift_Parsetree_core_type x1]) + | Parsetree.Ptyp_package x0 -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_package", [this#lift_Parsetree_package_type x0]) + | Parsetree.Ptyp_extension x0 -> + this#constr "Ast_405.Parsetree.core_type_desc" + ("Ptyp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.core_type_desc -> 'res) + method lift_Parsetree_package_type : Parsetree.package_type -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_core_type x1]) x1)] : Parsetree.package_type + -> 'res) + method lift_Parsetree_row_field : Parsetree.row_field -> 'res= + (function + | Parsetree.Rtag (x0,x1,x2,x3) -> + this#constr "Ast_405.Parsetree.row_field" + ("Rtag", + [this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_bool x2; + this#list (List.map this#lift_Parsetree_core_type x3)]) + | Parsetree.Rinherit x0 -> + this#constr "Ast_405.Parsetree.row_field" + ("Rinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.row_field + -> + 'res) + method lift_Parsetree_attributes : Parsetree.attributes -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_attribute x) : + Parsetree.attributes -> 'res) + method lift_Parsetree_attribute : Parsetree.attribute -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.attribute -> 'res) + method lift_Parsetree_payload : Parsetree.payload -> 'res= + (function + | Parsetree.PStr x0 -> + this#constr "Ast_405.Parsetree.payload" + ("PStr", [this#lift_Parsetree_structure x0]) + | Parsetree.PSig x0 -> + this#constr "Ast_405.Parsetree.payload" + ("PSig", [this#lift_Parsetree_signature x0]) + | Parsetree.PTyp x0 -> + this#constr "Ast_405.Parsetree.payload" + ("PTyp", [this#lift_Parsetree_core_type x0]) + | Parsetree.PPat (x0,x1) -> + this#constr "Ast_405.Parsetree.payload" + ("PPat", + [this#lift_Parsetree_pattern x0; + this#lift_option this#lift_Parsetree_expression x1]) : + Parsetree.payload -> 'res) + method lift_Parsetree_structure : Parsetree.structure -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_structure_item x) : + Parsetree.structure -> 'res) + method lift_Parsetree_structure_item : Parsetree.structure_item -> 'res= + (fun { Parsetree.pstr_desc = pstr_desc; Parsetree.pstr_loc = pstr_loc } + -> + this#record "Ast_405.Parsetree.structure_item" + [("pstr_desc", + (this#lift_Parsetree_structure_item_desc pstr_desc)); + ("pstr_loc", (this#lift_Location_t pstr_loc))] : Parsetree.structure_item + -> 'res) + method lift_Parsetree_structure_item_desc : + Parsetree.structure_item_desc -> 'res= + (function + | Parsetree.Pstr_eval (x0,x1) -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_eval", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_attributes x1]) + | Parsetree.Pstr_value (x0,x1) -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_value", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1)]) + | Parsetree.Pstr_primitive x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_primitive", [this#lift_Parsetree_value_description x0]) + | Parsetree.Pstr_type (x0,x1) -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Pstr_typext x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Pstr_exception x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Pstr_module x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_module", [this#lift_Parsetree_module_binding x0]) + | Parsetree.Pstr_recmodule x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_recmodule", + [this#list (List.map this#lift_Parsetree_module_binding x0)]) + | Parsetree.Pstr_modtype x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Pstr_open x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Pstr_class x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_class", + [this#list (List.map this#lift_Parsetree_class_declaration x0)]) + | Parsetree.Pstr_class_type x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Pstr_include x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_include", [this#lift_Parsetree_include_declaration x0]) + | Parsetree.Pstr_attribute x0 -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pstr_extension (x0,x1) -> + this#constr "Ast_405.Parsetree.structure_item_desc" + ("Pstr_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.structure_item_desc + -> 'res) + method lift_Parsetree_include_declaration : + Parsetree.include_declaration -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_expr x : + Parsetree.include_declaration -> 'res) + method lift_Parsetree_class_declaration : + Parsetree.class_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_expr x : + Parsetree.class_declaration -> 'res) + method lift_Parsetree_class_expr : Parsetree.class_expr -> 'res= + (fun + { Parsetree.pcl_desc = pcl_desc; Parsetree.pcl_loc = pcl_loc; + Parsetree.pcl_attributes = pcl_attributes } + -> + this#record "Ast_405.Parsetree.class_expr" + [("pcl_desc", (this#lift_Parsetree_class_expr_desc pcl_desc)); + ("pcl_loc", (this#lift_Location_t pcl_loc)); + ("pcl_attributes", + (this#lift_Parsetree_attributes pcl_attributes))] : Parsetree.class_expr + -> + 'res) + method lift_Parsetree_class_expr_desc : + Parsetree.class_expr_desc -> 'res= + (function + | Parsetree.Pcl_constr (x0,x1) -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcl_structure x0 -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_structure", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pcl_fun (x0,x1,x2,x3) -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_class_expr x3]) + | Parsetree.Pcl_apply (x0,x1) -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_apply", + [this#lift_Parsetree_class_expr x0; + this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pcl_let (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_class_expr x2]) + | Parsetree.Pcl_constraint (x0,x1) -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_constraint", + [this#lift_Parsetree_class_expr x0; + this#lift_Parsetree_class_type x1]) + | Parsetree.Pcl_extension x0 -> + this#constr "Ast_405.Parsetree.class_expr_desc" + ("Pcl_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_expr_desc -> 'res) + method lift_Parsetree_class_structure : + Parsetree.class_structure -> 'res= + (fun + { Parsetree.pcstr_self = pcstr_self; + Parsetree.pcstr_fields = pcstr_fields } + -> + this#record "Ast_405.Parsetree.class_structure" + [("pcstr_self", (this#lift_Parsetree_pattern pcstr_self)); + ("pcstr_fields", + (this#list + (List.map this#lift_Parsetree_class_field pcstr_fields)))] : + Parsetree.class_structure -> 'res) + method lift_Parsetree_class_field : Parsetree.class_field -> 'res= + (fun + { Parsetree.pcf_desc = pcf_desc; Parsetree.pcf_loc = pcf_loc; + Parsetree.pcf_attributes = pcf_attributes } + -> + this#record "Ast_405.Parsetree.class_field" + [("pcf_desc", (this#lift_Parsetree_class_field_desc pcf_desc)); + ("pcf_loc", (this#lift_Location_t pcf_loc)); + ("pcf_attributes", + (this#lift_Parsetree_attributes pcf_attributes))] : Parsetree.class_field + -> + 'res) + method lift_Parsetree_class_field_desc : + Parsetree.class_field_desc -> 'res= + (function + | Parsetree.Pcf_inherit (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_inherit", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_class_expr x1; + this#lift_option + (fun x -> this#lift_Asttypes_loc this#string x) x2]) + | Parsetree.Pcf_val x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_val", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_method x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_method", + [(let (x0,x1,x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_constraint x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pcf_initializer x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_initializer", [this#lift_Parsetree_expression x0]) + | Parsetree.Pcf_attribute x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pcf_extension x0 -> + this#constr "Ast_405.Parsetree.class_field_desc" + ("Pcf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_field_desc -> 'res) + method lift_Parsetree_class_field_kind : + Parsetree.class_field_kind -> 'res= + (function + | Parsetree.Cfk_virtual x0 -> + this#constr "Ast_405.Parsetree.class_field_kind" + ("Cfk_virtual", [this#lift_Parsetree_core_type x0]) + | Parsetree.Cfk_concrete (x0,x1) -> + this#constr "Ast_405.Parsetree.class_field_kind" + ("Cfk_concrete", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_expression x1]) : Parsetree.class_field_kind + -> 'res) + method lift_Parsetree_module_binding : Parsetree.module_binding -> 'res= + (fun + { Parsetree.pmb_name = pmb_name; Parsetree.pmb_expr = pmb_expr; + Parsetree.pmb_attributes = pmb_attributes; + Parsetree.pmb_loc = pmb_loc } + -> + this#record "Ast_405.Parsetree.module_binding" + [("pmb_name", (this#lift_Asttypes_loc this#string pmb_name)); + ("pmb_expr", (this#lift_Parsetree_module_expr pmb_expr)); + ("pmb_attributes", + (this#lift_Parsetree_attributes pmb_attributes)); + ("pmb_loc", (this#lift_Location_t pmb_loc))] : Parsetree.module_binding + -> 'res) + method lift_Parsetree_module_expr : Parsetree.module_expr -> 'res= + (fun + { Parsetree.pmod_desc = pmod_desc; Parsetree.pmod_loc = pmod_loc; + Parsetree.pmod_attributes = pmod_attributes } + -> + this#record "Ast_405.Parsetree.module_expr" + [("pmod_desc", (this#lift_Parsetree_module_expr_desc pmod_desc)); + ("pmod_loc", (this#lift_Location_t pmod_loc)); + ("pmod_attributes", + (this#lift_Parsetree_attributes pmod_attributes))] : Parsetree.module_expr + -> + 'res) + method lift_Parsetree_module_expr_desc : + Parsetree.module_expr_desc -> 'res= + (function + | Parsetree.Pmod_ident x0 -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmod_structure x0 -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_structure", [this#lift_Parsetree_structure x0]) + | Parsetree.Pmod_functor (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_expr x2]) + | Parsetree.Pmod_apply (x0,x1) -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_apply", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_expr x1]) + | Parsetree.Pmod_constraint (x0,x1) -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_constraint", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_type x1]) + | Parsetree.Pmod_unpack x0 -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_unpack", [this#lift_Parsetree_expression x0]) + | Parsetree.Pmod_extension x0 -> + this#constr "Ast_405.Parsetree.module_expr_desc" + ("Pmod_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.module_expr_desc -> 'res) + method lift_Parsetree_module_type : Parsetree.module_type -> 'res= + (fun + { Parsetree.pmty_desc = pmty_desc; Parsetree.pmty_loc = pmty_loc; + Parsetree.pmty_attributes = pmty_attributes } + -> + this#record "Ast_405.Parsetree.module_type" + [("pmty_desc", (this#lift_Parsetree_module_type_desc pmty_desc)); + ("pmty_loc", (this#lift_Location_t pmty_loc)); + ("pmty_attributes", + (this#lift_Parsetree_attributes pmty_attributes))] : Parsetree.module_type + -> + 'res) + method lift_Parsetree_module_type_desc : + Parsetree.module_type_desc -> 'res= + (function + | Parsetree.Pmty_ident x0 -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmty_signature x0 -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_signature", [this#lift_Parsetree_signature x0]) + | Parsetree.Pmty_functor (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_type x2]) + | Parsetree.Pmty_with (x0,x1) -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_with", + [this#lift_Parsetree_module_type x0; + this#list (List.map this#lift_Parsetree_with_constraint x1)]) + | Parsetree.Pmty_typeof x0 -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_typeof", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pmty_extension x0 -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pmty_alias x0 -> + this#constr "Ast_405.Parsetree.module_type_desc" + ("Pmty_alias", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.module_type_desc + -> + 'res) + method lift_Parsetree_with_constraint : + Parsetree.with_constraint -> 'res= + (function + | Parsetree.Pwith_type (x0,x1) -> + this#constr "Ast_405.Parsetree.with_constraint" + ("Pwith_type", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_module (x0,x1) -> + this#constr "Ast_405.Parsetree.with_constraint" + ("Pwith_module", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pwith_typesubst x0 -> + this#constr "Ast_405.Parsetree.with_constraint" + ("Pwith_typesubst", [this#lift_Parsetree_type_declaration x0]) + | Parsetree.Pwith_modsubst (x0,x1) -> + this#constr "Ast_405.Parsetree.with_constraint" + ("Pwith_modsubst", + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) : Parsetree.with_constraint + -> + 'res) + method lift_Parsetree_signature : Parsetree.signature -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_signature_item x) : + Parsetree.signature -> 'res) + method lift_Parsetree_signature_item : Parsetree.signature_item -> 'res= + (fun { Parsetree.psig_desc = psig_desc; Parsetree.psig_loc = psig_loc } + -> + this#record "Ast_405.Parsetree.signature_item" + [("psig_desc", + (this#lift_Parsetree_signature_item_desc psig_desc)); + ("psig_loc", (this#lift_Location_t psig_loc))] : Parsetree.signature_item + -> 'res) + method lift_Parsetree_signature_item_desc : + Parsetree.signature_item_desc -> 'res= + (function + | Parsetree.Psig_value x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_value", [this#lift_Parsetree_value_description x0]) + | Parsetree.Psig_type (x0,x1) -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Psig_typext x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Psig_exception x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Psig_module x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_module", [this#lift_Parsetree_module_declaration x0]) + | Parsetree.Psig_recmodule x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_recmodule", + [this#list + (List.map this#lift_Parsetree_module_declaration x0)]) + | Parsetree.Psig_modtype x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Psig_open x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Psig_include x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_include", [this#lift_Parsetree_include_description x0]) + | Parsetree.Psig_class x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_class", + [this#list (List.map this#lift_Parsetree_class_description x0)]) + | Parsetree.Psig_class_type x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Psig_attribute x0 -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Psig_extension (x0,x1) -> + this#constr "Ast_405.Parsetree.signature_item_desc" + ("Psig_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.signature_item_desc + -> 'res) + method lift_Parsetree_class_type_declaration : + Parsetree.class_type_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_type_declaration -> 'res) + method lift_Parsetree_class_description : + Parsetree.class_description -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_description -> 'res) + method lift_Parsetree_class_type : Parsetree.class_type -> 'res= + (fun + { Parsetree.pcty_desc = pcty_desc; Parsetree.pcty_loc = pcty_loc; + Parsetree.pcty_attributes = pcty_attributes } + -> + this#record "Ast_405.Parsetree.class_type" + [("pcty_desc", (this#lift_Parsetree_class_type_desc pcty_desc)); + ("pcty_loc", (this#lift_Location_t pcty_loc)); + ("pcty_attributes", + (this#lift_Parsetree_attributes pcty_attributes))] : Parsetree.class_type + -> + 'res) + method lift_Parsetree_class_type_desc : + Parsetree.class_type_desc -> 'res= + (function + | Parsetree.Pcty_constr (x0,x1) -> + this#constr "Ast_405.Parsetree.class_type_desc" + ("Pcty_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcty_signature x0 -> + this#constr "Ast_405.Parsetree.class_type_desc" + ("Pcty_signature", [this#lift_Parsetree_class_signature x0]) + | Parsetree.Pcty_arrow (x0,x1,x2) -> + this#constr "Ast_405.Parsetree.class_type_desc" + ("Pcty_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_class_type x2]) + | Parsetree.Pcty_extension x0 -> + this#constr "Ast_405.Parsetree.class_type_desc" + ("Pcty_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_desc -> 'res) + method lift_Parsetree_class_signature : + Parsetree.class_signature -> 'res= + (fun + { Parsetree.pcsig_self = pcsig_self; + Parsetree.pcsig_fields = pcsig_fields } + -> + this#record "Ast_405.Parsetree.class_signature" + [("pcsig_self", (this#lift_Parsetree_core_type pcsig_self)); + ("pcsig_fields", + (this#list + (List.map this#lift_Parsetree_class_type_field pcsig_fields)))] : + Parsetree.class_signature -> 'res) + method lift_Parsetree_class_type_field : + Parsetree.class_type_field -> 'res= + (fun + { Parsetree.pctf_desc = pctf_desc; Parsetree.pctf_loc = pctf_loc; + Parsetree.pctf_attributes = pctf_attributes } + -> + this#record "Ast_405.Parsetree.class_type_field" + [("pctf_desc", + (this#lift_Parsetree_class_type_field_desc pctf_desc)); + ("pctf_loc", (this#lift_Location_t pctf_loc)); + ("pctf_attributes", + (this#lift_Parsetree_attributes pctf_attributes))] : Parsetree.class_type_field + -> + 'res) + method lift_Parsetree_class_type_field_desc : + Parsetree.class_type_field_desc -> 'res= + (function + | Parsetree.Pctf_inherit x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_inherit", [this#lift_Parsetree_class_type x0]) + | Parsetree.Pctf_val x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_val", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_method x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_method", + [(let (x0,x1,x2,x3) = x0 in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Asttypes_private_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_constraint x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_constraint", + [(let (x0,x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pctf_attribute x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pctf_extension x0 -> + this#constr "Ast_405.Parsetree.class_type_field_desc" + ("Pctf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_field_desc -> 'res) + method lift_Parsetree_extension : Parsetree.extension -> 'res= + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.extension -> 'res) + method lift_Parsetree_class_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.class_infos -> 'res= fun (type f0) + -> + (fun f0 -> + fun + { Parsetree.pci_virt = pci_virt; + Parsetree.pci_params = pci_params; + Parsetree.pci_name = pci_name; Parsetree.pci_expr = pci_expr; + Parsetree.pci_loc = pci_loc; + Parsetree.pci_attributes = pci_attributes } + -> + this#record "Ast_405.Parsetree.class_infos" + [("pci_virt", (this#lift_Asttypes_virtual_flag pci_virt)); + ("pci_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) pci_params))); + ("pci_name", (this#lift_Asttypes_loc this#string pci_name)); + ("pci_expr", (f0 pci_expr)); + ("pci_loc", (this#lift_Location_t pci_loc)); + ("pci_attributes", + (this#lift_Parsetree_attributes pci_attributes))] : (f0 -> + 'res) -> + f0 + Parsetree.class_infos + -> + 'res) + method lift_Asttypes_virtual_flag : Asttypes.virtual_flag -> 'res= + (function + | Asttypes.Virtual -> + this#constr "Ast_405.Asttypes.virtual_flag" ("Virtual", []) + | Asttypes.Concrete -> + this#constr "Ast_405.Asttypes.virtual_flag" ("Concrete", []) : Asttypes.virtual_flag + -> + 'res) + method lift_Parsetree_include_description : + Parsetree.include_description -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_type x : + Parsetree.include_description -> 'res) + method lift_Parsetree_include_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.include_infos -> 'res= fun (type + f0) -> + (fun f0 -> + fun + { Parsetree.pincl_mod = pincl_mod; + Parsetree.pincl_loc = pincl_loc; + Parsetree.pincl_attributes = pincl_attributes } + -> + this#record "Ast_405.Parsetree.include_infos" + [("pincl_mod", (f0 pincl_mod)); + ("pincl_loc", (this#lift_Location_t pincl_loc)); + ("pincl_attributes", + (this#lift_Parsetree_attributes pincl_attributes))] : + (f0 -> 'res) -> f0 Parsetree.include_infos -> 'res) + method lift_Parsetree_open_description : + Parsetree.open_description -> 'res= + (fun + { Parsetree.popen_lid = popen_lid; + Parsetree.popen_override = popen_override; + Parsetree.popen_loc = popen_loc; + Parsetree.popen_attributes = popen_attributes } + -> + this#record "Ast_405.Parsetree.open_description" + [("popen_lid", + (this#lift_Asttypes_loc this#lift_Longident_t popen_lid)); + ("popen_override", + (this#lift_Asttypes_override_flag popen_override)); + ("popen_loc", (this#lift_Location_t popen_loc)); + ("popen_attributes", + (this#lift_Parsetree_attributes popen_attributes))] : Parsetree.open_description + -> + 'res) + method lift_Asttypes_override_flag : Asttypes.override_flag -> 'res= + (function + | Asttypes.Override -> + this#constr "Ast_405.Asttypes.override_flag" ("Override", []) + | Asttypes.Fresh -> + this#constr "Ast_405.Asttypes.override_flag" ("Fresh", []) : Asttypes.override_flag + -> + 'res) + method lift_Parsetree_module_type_declaration : + Parsetree.module_type_declaration -> 'res= + (fun + { Parsetree.pmtd_name = pmtd_name; Parsetree.pmtd_type = pmtd_type; + Parsetree.pmtd_attributes = pmtd_attributes; + Parsetree.pmtd_loc = pmtd_loc } + -> + this#record "Ast_405.Parsetree.module_type_declaration" + [("pmtd_name", (this#lift_Asttypes_loc this#string pmtd_name)); + ("pmtd_type", + (this#lift_option this#lift_Parsetree_module_type pmtd_type)); + ("pmtd_attributes", + (this#lift_Parsetree_attributes pmtd_attributes)); + ("pmtd_loc", (this#lift_Location_t pmtd_loc))] : Parsetree.module_type_declaration + -> 'res) + method lift_Parsetree_module_declaration : + Parsetree.module_declaration -> 'res= + (fun + { Parsetree.pmd_name = pmd_name; Parsetree.pmd_type = pmd_type; + Parsetree.pmd_attributes = pmd_attributes; + Parsetree.pmd_loc = pmd_loc } + -> + this#record "Ast_405.Parsetree.module_declaration" + [("pmd_name", (this#lift_Asttypes_loc this#string pmd_name)); + ("pmd_type", (this#lift_Parsetree_module_type pmd_type)); + ("pmd_attributes", + (this#lift_Parsetree_attributes pmd_attributes)); + ("pmd_loc", (this#lift_Location_t pmd_loc))] : Parsetree.module_declaration + -> 'res) + method lift_Parsetree_type_extension : Parsetree.type_extension -> 'res= + (fun + { Parsetree.ptyext_path = ptyext_path; + Parsetree.ptyext_params = ptyext_params; + Parsetree.ptyext_constructors = ptyext_constructors; + Parsetree.ptyext_private = ptyext_private; + Parsetree.ptyext_attributes = ptyext_attributes } + -> + this#record "Ast_405.Parsetree.type_extension" + [("ptyext_path", + (this#lift_Asttypes_loc this#lift_Longident_t ptyext_path)); + ("ptyext_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptyext_params))); + ("ptyext_constructors", + (this#list + (List.map this#lift_Parsetree_extension_constructor + ptyext_constructors))); + ("ptyext_private", + (this#lift_Asttypes_private_flag ptyext_private)); + ("ptyext_attributes", + (this#lift_Parsetree_attributes ptyext_attributes))] : Parsetree.type_extension + -> + 'res) + method lift_Parsetree_extension_constructor : + Parsetree.extension_constructor -> 'res= + (fun + { Parsetree.pext_name = pext_name; Parsetree.pext_kind = pext_kind; + Parsetree.pext_loc = pext_loc; + Parsetree.pext_attributes = pext_attributes } + -> + this#record "Ast_405.Parsetree.extension_constructor" + [("pext_name", (this#lift_Asttypes_loc this#string pext_name)); + ("pext_kind", + (this#lift_Parsetree_extension_constructor_kind pext_kind)); + ("pext_loc", (this#lift_Location_t pext_loc)); + ("pext_attributes", + (this#lift_Parsetree_attributes pext_attributes))] : Parsetree.extension_constructor + -> + 'res) + method lift_Parsetree_extension_constructor_kind : + Parsetree.extension_constructor_kind -> 'res= + (function + | Parsetree.Pext_decl (x0,x1) -> + this#constr "Ast_405.Parsetree.extension_constructor_kind" + ("Pext_decl", + [this#lift_Parsetree_constructor_arguments x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pext_rebind x0 -> + this#constr "Ast_405.Parsetree.extension_constructor_kind" + ("Pext_rebind", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.extension_constructor_kind + -> + 'res) + method lift_Parsetree_type_declaration : + Parsetree.type_declaration -> 'res= + (fun + { Parsetree.ptype_name = ptype_name; + Parsetree.ptype_params = ptype_params; + Parsetree.ptype_cstrs = ptype_cstrs; + Parsetree.ptype_kind = ptype_kind; + Parsetree.ptype_private = ptype_private; + Parsetree.ptype_manifest = ptype_manifest; + Parsetree.ptype_attributes = ptype_attributes; + Parsetree.ptype_loc = ptype_loc } + -> + this#record "Ast_405.Parsetree.type_declaration" + [("ptype_name", (this#lift_Asttypes_loc this#string ptype_name)); + ("ptype_params", + (this#list + (List.map + (fun x -> + let (x0,x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptype_params))); + ("ptype_cstrs", + (this#list + (List.map + (fun x -> + let (x0,x1,x2) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1; + this#lift_Location_t x2]) ptype_cstrs))); + ("ptype_kind", (this#lift_Parsetree_type_kind ptype_kind)); + ("ptype_private", (this#lift_Asttypes_private_flag ptype_private)); + ("ptype_manifest", + (this#lift_option this#lift_Parsetree_core_type ptype_manifest)); + ("ptype_attributes", + (this#lift_Parsetree_attributes ptype_attributes)); + ("ptype_loc", (this#lift_Location_t ptype_loc))] : Parsetree.type_declaration + -> 'res) + method lift_Asttypes_private_flag : Asttypes.private_flag -> 'res= + (function + | Asttypes.Private -> + this#constr "Ast_405.Asttypes.private_flag" ("Private", []) + | Asttypes.Public -> + this#constr "Ast_405.Asttypes.private_flag" ("Public", []) : Asttypes.private_flag + -> + 'res) + method lift_Parsetree_type_kind : Parsetree.type_kind -> 'res= + (function + | Parsetree.Ptype_abstract -> + this#constr "Ast_405.Parsetree.type_kind" ("Ptype_abstract", []) + | Parsetree.Ptype_variant x0 -> + this#constr "Ast_405.Parsetree.type_kind" + ("Ptype_variant", + [this#list + (List.map this#lift_Parsetree_constructor_declaration x0)]) + | Parsetree.Ptype_record x0 -> + this#constr "Ast_405.Parsetree.type_kind" + ("Ptype_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) + | Parsetree.Ptype_open -> + this#constr "Ast_405.Parsetree.type_kind" ("Ptype_open", []) : Parsetree.type_kind + -> + 'res) + method lift_Parsetree_constructor_declaration : + Parsetree.constructor_declaration -> 'res= + (fun + { Parsetree.pcd_name = pcd_name; Parsetree.pcd_args = pcd_args; + Parsetree.pcd_res = pcd_res; Parsetree.pcd_loc = pcd_loc; + Parsetree.pcd_attributes = pcd_attributes } + -> + this#record "Ast_405.Parsetree.constructor_declaration" + [("pcd_name", (this#lift_Asttypes_loc this#string pcd_name)); + ("pcd_args", (this#lift_Parsetree_constructor_arguments pcd_args)); + ("pcd_res", + (this#lift_option this#lift_Parsetree_core_type pcd_res)); + ("pcd_loc", (this#lift_Location_t pcd_loc)); + ("pcd_attributes", + (this#lift_Parsetree_attributes pcd_attributes))] : Parsetree.constructor_declaration + -> + 'res) + method lift_Parsetree_constructor_arguments : + Parsetree.constructor_arguments -> 'res= + (function + | Parsetree.Pcstr_tuple x0 -> + this#constr "Ast_405.Parsetree.constructor_arguments" + ("Pcstr_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Pcstr_record x0 -> + this#constr "Ast_405.Parsetree.constructor_arguments" + ("Pcstr_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) : + Parsetree.constructor_arguments -> 'res) + method lift_Parsetree_label_declaration : + Parsetree.label_declaration -> 'res= + (fun + { Parsetree.pld_name = pld_name; + Parsetree.pld_mutable = pld_mutable; + Parsetree.pld_type = pld_type; Parsetree.pld_loc = pld_loc; + Parsetree.pld_attributes = pld_attributes } + -> + this#record "Ast_405.Parsetree.label_declaration" + [("pld_name", (this#lift_Asttypes_loc this#string pld_name)); + ("pld_mutable", (this#lift_Asttypes_mutable_flag pld_mutable)); + ("pld_type", (this#lift_Parsetree_core_type pld_type)); + ("pld_loc", (this#lift_Location_t pld_loc)); + ("pld_attributes", + (this#lift_Parsetree_attributes pld_attributes))] : Parsetree.label_declaration + -> + 'res) + method lift_Asttypes_mutable_flag : Asttypes.mutable_flag -> 'res= + (function + | Asttypes.Immutable -> + this#constr "Ast_405.Asttypes.mutable_flag" ("Immutable", []) + | Asttypes.Mutable -> + this#constr "Ast_405.Asttypes.mutable_flag" ("Mutable", []) : Asttypes.mutable_flag + -> + 'res) + method lift_Asttypes_variance : Asttypes.variance -> 'res= + (function + | Asttypes.Covariant -> + this#constr "Ast_405.Asttypes.variance" ("Covariant", []) + | Asttypes.Contravariant -> + this#constr "Ast_405.Asttypes.variance" ("Contravariant", []) + | Asttypes.Invariant -> + this#constr "Ast_405.Asttypes.variance" ("Invariant", []) : Asttypes.variance + -> 'res) + method lift_Parsetree_value_description : + Parsetree.value_description -> 'res= + (fun + { Parsetree.pval_name = pval_name; Parsetree.pval_type = pval_type; + Parsetree.pval_prim = pval_prim; + Parsetree.pval_attributes = pval_attributes; + Parsetree.pval_loc = pval_loc } + -> + this#record "Ast_405.Parsetree.value_description" + [("pval_name", (this#lift_Asttypes_loc this#string pval_name)); + ("pval_type", (this#lift_Parsetree_core_type pval_type)); + ("pval_prim", (this#list (List.map this#string pval_prim))); + ("pval_attributes", + (this#lift_Parsetree_attributes pval_attributes)); + ("pval_loc", (this#lift_Location_t pval_loc))] : Parsetree.value_description + -> 'res) + method lift_Asttypes_arg_label : Asttypes.arg_label -> 'res= + (function + | Asttypes.Nolabel -> + this#constr "Ast_405.Asttypes.arg_label" ("Nolabel", []) + | Asttypes.Labelled x0 -> + this#constr "Ast_405.Asttypes.arg_label" ("Labelled", [this#string x0]) + | Asttypes.Optional x0 -> + this#constr "Ast_405.Asttypes.arg_label" ("Optional", [this#string x0]) : + Asttypes.arg_label -> 'res) + method lift_Asttypes_closed_flag : Asttypes.closed_flag -> 'res= + (function + | Asttypes.Closed -> + this#constr "Ast_405.Asttypes.closed_flag" ("Closed", []) + | Asttypes.Open -> this#constr "Ast_405.Asttypes.closed_flag" ("Open", []) : + Asttypes.closed_flag -> 'res) + method lift_Asttypes_label : Asttypes.label -> 'res= + (this#string : Asttypes.label -> 'res) + method lift_Asttypes_rec_flag : Asttypes.rec_flag -> 'res= + (function + | Asttypes.Nonrecursive -> + this#constr "Ast_405.Asttypes.rec_flag" ("Nonrecursive", []) + | Asttypes.Recursive -> + this#constr "Ast_405.Asttypes.rec_flag" ("Recursive", []) : Asttypes.rec_flag + -> 'res) + method lift_Parsetree_constant : Parsetree.constant -> 'res= + (function + | Parsetree.Pconst_integer (x0,x1) -> + this#constr "Ast_405.Parsetree.constant" + ("Pconst_integer", + [this#string x0; this#lift_option this#char x1]) + | Parsetree.Pconst_char x0 -> + this#constr "Ast_405.Parsetree.constant" ("Pconst_char", [this#char x0]) + | Parsetree.Pconst_string (x0,x1) -> + this#constr "Ast_405.Parsetree.constant" + ("Pconst_string", + [this#string x0; this#lift_option this#string x1]) + | Parsetree.Pconst_float (x0,x1) -> + this#constr "Ast_405.Parsetree.constant" + ("Pconst_float", + [this#string x0; this#lift_option this#char x1]) : Parsetree.constant + -> + 'res) + method lift_option : 'f0 . ('f0 -> 'res) -> 'f0 option -> 'res= fun (type + f0) -> + (fun f0 -> + function + | None -> this#constr "option" ("None", []) + | Some x0 -> this#constr "option" ("Some", [f0 x0]) : (f0 -> 'res) + -> + f0 option -> + 'res) + method lift_Longident_t : Longident.t -> 'res= + (function + | Longident.Lident x0 -> + this#constr "Ast_405.Longident.t" ("Lident", [this#string x0]) + | Longident.Ldot (x0,x1) -> + this#constr "Ast_405.Longident.t" + ("Ldot", [this#lift_Longident_t x0; this#string x1]) + | Longident.Lapply (x0,x1) -> + this#constr "Ast_405.Longident.t" + ("Lapply", [this#lift_Longident_t x0; this#lift_Longident_t x1]) : + Longident.t -> 'res) + method lift_Asttypes_loc : + 'f0 . ('f0 -> 'res) -> 'f0 Asttypes.loc -> 'res= fun (type f0) -> + (fun f0 -> + fun { Asttypes.txt = txt; Asttypes.loc = loc } -> + this#record "Ast_405.Asttypes.loc" + [("txt", (f0 txt)); ("loc", (this#lift_Location_t loc))] : + (f0 -> 'res) -> f0 Asttypes.loc -> 'res) + method lift_Location_t : Location.t -> 'res= + (fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Ast_405.Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] : Location.t -> 'res) + method lift_bool : bool -> 'res= + (function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) : bool -> 'res) + method lift_Lexing_position : Lexing.position -> 'res= + (fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] : Lexing.position -> 'res) + end diff --git a/ast_lifter_406.ml b/ast_lifter_406.ml new file mode 100644 index 0000000..37e5502 --- /dev/null +++ b/ast_lifter_406.ml @@ -0,0 +1,1409 @@ +open Ast_406 + +class virtual ['res] lifter = + object (this) + method lift_Parsetree_expression : Parsetree.expression -> 'res= + (fun + { Parsetree.pexp_desc = pexp_desc; Parsetree.pexp_loc = pexp_loc; + Parsetree.pexp_attributes = pexp_attributes } + -> + this#record "Ast_406.Parsetree.expression" + [("pexp_desc", (this#lift_Parsetree_expression_desc pexp_desc)); + ("pexp_loc", (this#lift_Location_t pexp_loc)); + ("pexp_attributes", + (this#lift_Parsetree_attributes pexp_attributes))] : Parsetree.expression + -> + 'res) + method lift_Parsetree_expression_desc : + Parsetree.expression_desc -> 'res= + (function + | Parsetree.Pexp_ident x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_constant x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Pexp_let (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_function x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_function", + [this#list (List.map this#lift_Parsetree_case x0)]) + | Parsetree.Pexp_fun (x0, x1, x2, x3) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_expression x3]) + | Parsetree.Pexp_apply (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_apply", + [this#lift_Parsetree_expression x0; + this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pexp_match (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_match", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_try (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_try", + [this#lift_Parsetree_expression x0; + this#list (List.map this#lift_Parsetree_case x1)]) + | Parsetree.Pexp_tuple x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_tuple", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_construct (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_variant (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_record (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_record", + [this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_expression x1]) x0); + this#lift_option this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_field (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_field", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pexp_setfield (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_setfield", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_array x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_array", + [this#list (List.map this#lift_Parsetree_expression x0)]) + | Parsetree.Pexp_ifthenelse (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_ifthenelse", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1; + this#lift_option this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_sequence (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_sequence", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_while (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_while", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_for", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_expression x1; + this#lift_Parsetree_expression x2; + this#lift_Asttypes_direction_flag x3; + this#lift_Parsetree_expression x4]) + | Parsetree.Pexp_constraint (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_constraint", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_coerce (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_coerce", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Pexp_send (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_send", + [this#lift_Parsetree_expression x0; + this#lift_Asttypes_loc this#lift_Asttypes_label x1]) + | Parsetree.Pexp_new x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_new", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pexp_setinstvar (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_setinstvar", + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_override x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_override", + [this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Parsetree_expression x1]) x0)]) + | Parsetree.Pexp_letmodule (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_letmodule", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_module_expr x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_letexception (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_letexception", + [this#lift_Parsetree_extension_constructor x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_assert x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_assert", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_lazy x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_lazy", [this#lift_Parsetree_expression x0]) + | Parsetree.Pexp_poly (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_poly", + [this#lift_Parsetree_expression x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pexp_object x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_object", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pexp_newtype (x0, x1) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_newtype", + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_expression x1]) + | Parsetree.Pexp_pack x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_pack", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pexp_open (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_expression x2]) + | Parsetree.Pexp_extension x0 -> + this#constr "Ast_406.Parsetree.expression_desc" + ("Pexp_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pexp_unreachable -> + this#constr "Ast_406.Parsetree.expression_desc" ("Pexp_unreachable", []) : + Parsetree.expression_desc -> 'res) + method lift_Asttypes_direction_flag : Asttypes.direction_flag -> 'res= + (function + | Asttypes.Upto -> this#constr "Ast_406.Asttypes.direction_flag" ("Upto", []) + | Asttypes.Downto -> + this#constr "Ast_406.Asttypes.direction_flag" ("Downto", []) : Asttypes.direction_flag + -> + 'res) + method lift_Parsetree_case : Parsetree.case -> 'res= + (fun + { Parsetree.pc_lhs = pc_lhs; Parsetree.pc_guard = pc_guard; + Parsetree.pc_rhs = pc_rhs } + -> + this#record "Ast_406.Parsetree.case" + [("pc_lhs", (this#lift_Parsetree_pattern pc_lhs)); + ("pc_guard", + (this#lift_option this#lift_Parsetree_expression pc_guard)); + ("pc_rhs", (this#lift_Parsetree_expression pc_rhs))] : Parsetree.case + -> + 'res) + method lift_Parsetree_value_binding : Parsetree.value_binding -> 'res= + (fun + { Parsetree.pvb_pat = pvb_pat; Parsetree.pvb_expr = pvb_expr; + Parsetree.pvb_attributes = pvb_attributes; + Parsetree.pvb_loc = pvb_loc } + -> + this#record "Ast_406.Parsetree.value_binding" + [("pvb_pat", (this#lift_Parsetree_pattern pvb_pat)); + ("pvb_expr", (this#lift_Parsetree_expression pvb_expr)); + ("pvb_attributes", + (this#lift_Parsetree_attributes pvb_attributes)); + ("pvb_loc", (this#lift_Location_t pvb_loc))] : Parsetree.value_binding + -> 'res) + method lift_Parsetree_pattern : Parsetree.pattern -> 'res= + (fun + { Parsetree.ppat_desc = ppat_desc; Parsetree.ppat_loc = ppat_loc; + Parsetree.ppat_attributes = ppat_attributes } + -> + this#record "Ast_406.Parsetree.pattern" + [("ppat_desc", (this#lift_Parsetree_pattern_desc ppat_desc)); + ("ppat_loc", (this#lift_Location_t ppat_loc)); + ("ppat_attributes", + (this#lift_Parsetree_attributes ppat_attributes))] : Parsetree.pattern + -> + 'res) + method lift_Parsetree_pattern_desc : Parsetree.pattern_desc -> 'res= + (function + | Parsetree.Ppat_any -> + this#constr "Ast_406.Parsetree.pattern_desc" ("Ppat_any", []) + | Parsetree.Ppat_var x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_var", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_alias (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_alias", + [this#lift_Parsetree_pattern x0; + this#lift_Asttypes_loc this#string x1]) + | Parsetree.Ppat_constant x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_constant", [this#lift_Parsetree_constant x0]) + | Parsetree.Ppat_interval (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_interval", + [this#lift_Parsetree_constant x0; + this#lift_Parsetree_constant x1]) + | Parsetree.Ppat_tuple x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_tuple", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_construct (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_construct", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_variant (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_variant", + [this#lift_Asttypes_label x0; + this#lift_option this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_record (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_record", + [this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ppat_array x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_array", + [this#list (List.map this#lift_Parsetree_pattern x0)]) + | Parsetree.Ppat_or (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_or", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_pattern x1]) + | Parsetree.Ppat_constraint (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_constraint", + [this#lift_Parsetree_pattern x0; + this#lift_Parsetree_core_type x1]) + | Parsetree.Ppat_type x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_type", [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Ppat_lazy x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_lazy", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_unpack x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_unpack", [this#lift_Asttypes_loc this#string x0]) + | Parsetree.Ppat_exception x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_exception", [this#lift_Parsetree_pattern x0]) + | Parsetree.Ppat_extension x0 -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Ppat_open (x0, x1) -> + this#constr "Ast_406.Parsetree.pattern_desc" + ("Ppat_open", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_pattern x1]) : Parsetree.pattern_desc -> + 'res) + method lift_Parsetree_core_type : Parsetree.core_type -> 'res= + (fun + { Parsetree.ptyp_desc = ptyp_desc; Parsetree.ptyp_loc = ptyp_loc; + Parsetree.ptyp_attributes = ptyp_attributes } + -> + this#record "Ast_406.Parsetree.core_type" + [("ptyp_desc", (this#lift_Parsetree_core_type_desc ptyp_desc)); + ("ptyp_loc", (this#lift_Location_t ptyp_loc)); + ("ptyp_attributes", + (this#lift_Parsetree_attributes ptyp_attributes))] : Parsetree.core_type + -> + 'res) + method lift_Parsetree_core_type_desc : Parsetree.core_type_desc -> 'res= + (function + | Parsetree.Ptyp_any -> + this#constr "Ast_406.Parsetree.core_type_desc" ("Ptyp_any", []) + | Parsetree.Ptyp_var x0 -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_var", [this#string x0]) + | Parsetree.Ptyp_arrow (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Ptyp_tuple x0 -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Ptyp_constr (x0, x1) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_object (x0, x1) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_object", + [this#list (List.map this#lift_Parsetree_object_field x0); + this#lift_Asttypes_closed_flag x1]) + | Parsetree.Ptyp_class (x0, x1) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_class", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Ptyp_alias (x0, x1) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_alias", + [this#lift_Parsetree_core_type x0; this#string x1]) + | Parsetree.Ptyp_variant (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_variant", + [this#list (List.map this#lift_Parsetree_row_field x0); + this#lift_Asttypes_closed_flag x1; + this#lift_option + (fun x -> this#list (List.map this#lift_Asttypes_label x)) + x2]) + | Parsetree.Ptyp_poly (x0, x1) -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_poly", + [this#list + (List.map (fun x -> this#lift_Asttypes_loc this#string x) + x0); + this#lift_Parsetree_core_type x1]) + | Parsetree.Ptyp_package x0 -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_package", [this#lift_Parsetree_package_type x0]) + | Parsetree.Ptyp_extension x0 -> + this#constr "Ast_406.Parsetree.core_type_desc" + ("Ptyp_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.core_type_desc -> 'res) + method lift_Parsetree_package_type : Parsetree.package_type -> 'res= + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_core_type x1]) x1)] : Parsetree.package_type + -> 'res) + method lift_Parsetree_row_field : Parsetree.row_field -> 'res= + (function + | Parsetree.Rtag (x0, x1, x2, x3) -> + this#constr "Ast_406.Parsetree.row_field" + ("Rtag", + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_bool x2; + this#list (List.map this#lift_Parsetree_core_type x3)]) + | Parsetree.Rinherit x0 -> + this#constr "Ast_406.Parsetree.row_field" + ("Rinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.row_field + -> + 'res) + method lift_Parsetree_object_field : Parsetree.object_field -> 'res= + (function + | Parsetree.Otag (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.object_field" + ("Otag", + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Parsetree_attributes x1; + this#lift_Parsetree_core_type x2]) + | Parsetree.Oinherit x0 -> + this#constr "Ast_406.Parsetree.object_field" + ("Oinherit", [this#lift_Parsetree_core_type x0]) : Parsetree.object_field + -> + 'res) + method lift_Parsetree_attributes : Parsetree.attributes -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_attribute x) : + Parsetree.attributes -> 'res) + method lift_Parsetree_attribute : Parsetree.attribute -> 'res= + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.attribute -> 'res) + method lift_Parsetree_payload : Parsetree.payload -> 'res= + (function + | Parsetree.PStr x0 -> + this#constr "Ast_406.Parsetree.payload" + ("PStr", [this#lift_Parsetree_structure x0]) + | Parsetree.PSig x0 -> + this#constr "Ast_406.Parsetree.payload" + ("PSig", [this#lift_Parsetree_signature x0]) + | Parsetree.PTyp x0 -> + this#constr "Ast_406.Parsetree.payload" + ("PTyp", [this#lift_Parsetree_core_type x0]) + | Parsetree.PPat (x0, x1) -> + this#constr "Ast_406.Parsetree.payload" + ("PPat", + [this#lift_Parsetree_pattern x0; + this#lift_option this#lift_Parsetree_expression x1]) : + Parsetree.payload -> 'res) + method lift_Parsetree_structure : Parsetree.structure -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_structure_item x) : + Parsetree.structure -> 'res) + method lift_Parsetree_structure_item : Parsetree.structure_item -> 'res= + (fun { Parsetree.pstr_desc = pstr_desc; Parsetree.pstr_loc = pstr_loc } + -> + this#record "Ast_406.Parsetree.structure_item" + [("pstr_desc", + (this#lift_Parsetree_structure_item_desc pstr_desc)); + ("pstr_loc", (this#lift_Location_t pstr_loc))] : Parsetree.structure_item + -> 'res) + method lift_Parsetree_structure_item_desc : + Parsetree.structure_item_desc -> 'res= + (function + | Parsetree.Pstr_eval (x0, x1) -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_eval", + [this#lift_Parsetree_expression x0; + this#lift_Parsetree_attributes x1]) + | Parsetree.Pstr_value (x0, x1) -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_value", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1)]) + | Parsetree.Pstr_primitive x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_primitive", [this#lift_Parsetree_value_description x0]) + | Parsetree.Pstr_type (x0, x1) -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Pstr_typext x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Pstr_exception x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Pstr_module x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_module", [this#lift_Parsetree_module_binding x0]) + | Parsetree.Pstr_recmodule x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_recmodule", + [this#list (List.map this#lift_Parsetree_module_binding x0)]) + | Parsetree.Pstr_modtype x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Pstr_open x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Pstr_class x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_class", + [this#list (List.map this#lift_Parsetree_class_declaration x0)]) + | Parsetree.Pstr_class_type x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Pstr_include x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_include", [this#lift_Parsetree_include_declaration x0]) + | Parsetree.Pstr_attribute x0 -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pstr_extension (x0, x1) -> + this#constr "Ast_406.Parsetree.structure_item_desc" + ("Pstr_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.structure_item_desc + -> 'res) + method lift_Parsetree_include_declaration : + Parsetree.include_declaration -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_expr x : + Parsetree.include_declaration -> 'res) + method lift_Parsetree_class_declaration : + Parsetree.class_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_expr x : + Parsetree.class_declaration -> 'res) + method lift_Parsetree_class_expr : Parsetree.class_expr -> 'res= + (fun + { Parsetree.pcl_desc = pcl_desc; Parsetree.pcl_loc = pcl_loc; + Parsetree.pcl_attributes = pcl_attributes } + -> + this#record "Ast_406.Parsetree.class_expr" + [("pcl_desc", (this#lift_Parsetree_class_expr_desc pcl_desc)); + ("pcl_loc", (this#lift_Location_t pcl_loc)); + ("pcl_attributes", + (this#lift_Parsetree_attributes pcl_attributes))] : Parsetree.class_expr + -> + 'res) + method lift_Parsetree_class_expr_desc : + Parsetree.class_expr_desc -> 'res= + (function + | Parsetree.Pcl_constr (x0, x1) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcl_structure x0 -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_structure", [this#lift_Parsetree_class_structure x0]) + | Parsetree.Pcl_fun (x0, x1, x2, x3) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_fun", + [this#lift_Asttypes_arg_label x0; + this#lift_option this#lift_Parsetree_expression x1; + this#lift_Parsetree_pattern x2; + this#lift_Parsetree_class_expr x3]) + | Parsetree.Pcl_apply (x0, x1) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_apply", + [this#lift_Parsetree_class_expr x0; + this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_expression x1]) x1)]) + | Parsetree.Pcl_let (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_let", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_value_binding x1); + this#lift_Parsetree_class_expr x2]) + | Parsetree.Pcl_constraint (x0, x1) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_constraint", + [this#lift_Parsetree_class_expr x0; + this#lift_Parsetree_class_type x1]) + | Parsetree.Pcl_extension x0 -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pcl_open (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.class_expr_desc" + ("Pcl_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_class_expr x2]) : Parsetree.class_expr_desc + -> 'res) + method lift_Parsetree_class_structure : + Parsetree.class_structure -> 'res= + (fun + { Parsetree.pcstr_self = pcstr_self; + Parsetree.pcstr_fields = pcstr_fields } + -> + this#record "Ast_406.Parsetree.class_structure" + [("pcstr_self", (this#lift_Parsetree_pattern pcstr_self)); + ("pcstr_fields", + (this#list + (List.map this#lift_Parsetree_class_field pcstr_fields)))] : + Parsetree.class_structure -> 'res) + method lift_Parsetree_class_field : Parsetree.class_field -> 'res= + (fun + { Parsetree.pcf_desc = pcf_desc; Parsetree.pcf_loc = pcf_loc; + Parsetree.pcf_attributes = pcf_attributes } + -> + this#record "Ast_406.Parsetree.class_field" + [("pcf_desc", (this#lift_Parsetree_class_field_desc pcf_desc)); + ("pcf_loc", (this#lift_Location_t pcf_loc)); + ("pcf_attributes", + (this#lift_Parsetree_attributes pcf_attributes))] : Parsetree.class_field + -> + 'res) + method lift_Parsetree_class_field_desc : + Parsetree.class_field_desc -> 'res= + (function + | Parsetree.Pcf_inherit (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_inherit", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_class_expr x1; + this#lift_option + (fun x -> this#lift_Asttypes_loc this#string x) x2]) + | Parsetree.Pcf_val x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_val", + [(let (x0, x1, x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_method x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_method", + [(let (x0, x1, x2) = x0 in + this#tuple + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Asttypes_private_flag x1; + this#lift_Parsetree_class_field_kind x2])]) + | Parsetree.Pcf_constraint x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_constraint", + [(let (x0, x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pcf_initializer x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_initializer", [this#lift_Parsetree_expression x0]) + | Parsetree.Pcf_attribute x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pcf_extension x0 -> + this#constr "Ast_406.Parsetree.class_field_desc" + ("Pcf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_field_desc -> 'res) + method lift_Parsetree_class_field_kind : + Parsetree.class_field_kind -> 'res= + (function + | Parsetree.Cfk_virtual x0 -> + this#constr "Ast_406.Parsetree.class_field_kind" + ("Cfk_virtual", [this#lift_Parsetree_core_type x0]) + | Parsetree.Cfk_concrete (x0, x1) -> + this#constr "Ast_406.Parsetree.class_field_kind" + ("Cfk_concrete", + [this#lift_Asttypes_override_flag x0; + this#lift_Parsetree_expression x1]) : Parsetree.class_field_kind + -> 'res) + method lift_Parsetree_module_binding : Parsetree.module_binding -> 'res= + (fun + { Parsetree.pmb_name = pmb_name; Parsetree.pmb_expr = pmb_expr; + Parsetree.pmb_attributes = pmb_attributes; + Parsetree.pmb_loc = pmb_loc } + -> + this#record "Ast_406.Parsetree.module_binding" + [("pmb_name", (this#lift_Asttypes_loc this#string pmb_name)); + ("pmb_expr", (this#lift_Parsetree_module_expr pmb_expr)); + ("pmb_attributes", + (this#lift_Parsetree_attributes pmb_attributes)); + ("pmb_loc", (this#lift_Location_t pmb_loc))] : Parsetree.module_binding + -> 'res) + method lift_Parsetree_module_expr : Parsetree.module_expr -> 'res= + (fun + { Parsetree.pmod_desc = pmod_desc; Parsetree.pmod_loc = pmod_loc; + Parsetree.pmod_attributes = pmod_attributes } + -> + this#record "Ast_406.Parsetree.module_expr" + [("pmod_desc", (this#lift_Parsetree_module_expr_desc pmod_desc)); + ("pmod_loc", (this#lift_Location_t pmod_loc)); + ("pmod_attributes", + (this#lift_Parsetree_attributes pmod_attributes))] : Parsetree.module_expr + -> + 'res) + method lift_Parsetree_module_expr_desc : + Parsetree.module_expr_desc -> 'res= + (function + | Parsetree.Pmod_ident x0 -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmod_structure x0 -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_structure", [this#lift_Parsetree_structure x0]) + | Parsetree.Pmod_functor (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_expr x2]) + | Parsetree.Pmod_apply (x0, x1) -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_apply", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_expr x1]) + | Parsetree.Pmod_constraint (x0, x1) -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_constraint", + [this#lift_Parsetree_module_expr x0; + this#lift_Parsetree_module_type x1]) + | Parsetree.Pmod_unpack x0 -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_unpack", [this#lift_Parsetree_expression x0]) + | Parsetree.Pmod_extension x0 -> + this#constr "Ast_406.Parsetree.module_expr_desc" + ("Pmod_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.module_expr_desc -> 'res) + method lift_Parsetree_module_type : Parsetree.module_type -> 'res= + (fun + { Parsetree.pmty_desc = pmty_desc; Parsetree.pmty_loc = pmty_loc; + Parsetree.pmty_attributes = pmty_attributes } + -> + this#record "Ast_406.Parsetree.module_type" + [("pmty_desc", (this#lift_Parsetree_module_type_desc pmty_desc)); + ("pmty_loc", (this#lift_Location_t pmty_loc)); + ("pmty_attributes", + (this#lift_Parsetree_attributes pmty_attributes))] : Parsetree.module_type + -> + 'res) + method lift_Parsetree_module_type_desc : + Parsetree.module_type_desc -> 'res= + (function + | Parsetree.Pmty_ident x0 -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_ident", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) + | Parsetree.Pmty_signature x0 -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_signature", [this#lift_Parsetree_signature x0]) + | Parsetree.Pmty_functor (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_functor", + [this#lift_Asttypes_loc this#string x0; + this#lift_option this#lift_Parsetree_module_type x1; + this#lift_Parsetree_module_type x2]) + | Parsetree.Pmty_with (x0, x1) -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_with", + [this#lift_Parsetree_module_type x0; + this#list (List.map this#lift_Parsetree_with_constraint x1)]) + | Parsetree.Pmty_typeof x0 -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_typeof", [this#lift_Parsetree_module_expr x0]) + | Parsetree.Pmty_extension x0 -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pmty_alias x0 -> + this#constr "Ast_406.Parsetree.module_type_desc" + ("Pmty_alias", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.module_type_desc + -> + 'res) + method lift_Parsetree_with_constraint : + Parsetree.with_constraint -> 'res= + (function + | Parsetree.Pwith_type (x0, x1) -> + this#constr "Ast_406.Parsetree.with_constraint" + ("Pwith_type", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_module (x0, x1) -> + this#constr "Ast_406.Parsetree.with_constraint" + ("Pwith_module", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) + | Parsetree.Pwith_typesubst (x0, x1) -> + this#constr "Ast_406.Parsetree.with_constraint" + ("Pwith_typesubst", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Parsetree_type_declaration x1]) + | Parsetree.Pwith_modsubst (x0, x1) -> + this#constr "Ast_406.Parsetree.with_constraint" + ("Pwith_modsubst", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#lift_Asttypes_loc this#lift_Longident_t x1]) : Parsetree.with_constraint + -> + 'res) + method lift_Parsetree_signature : Parsetree.signature -> 'res= + (fun x -> this#list (List.map this#lift_Parsetree_signature_item x) : + Parsetree.signature -> 'res) + method lift_Parsetree_signature_item : Parsetree.signature_item -> 'res= + (fun { Parsetree.psig_desc = psig_desc; Parsetree.psig_loc = psig_loc } + -> + this#record "Ast_406.Parsetree.signature_item" + [("psig_desc", + (this#lift_Parsetree_signature_item_desc psig_desc)); + ("psig_loc", (this#lift_Location_t psig_loc))] : Parsetree.signature_item + -> 'res) + method lift_Parsetree_signature_item_desc : + Parsetree.signature_item_desc -> 'res= + (function + | Parsetree.Psig_value x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_value", [this#lift_Parsetree_value_description x0]) + | Parsetree.Psig_type (x0, x1) -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_type", + [this#lift_Asttypes_rec_flag x0; + this#list (List.map this#lift_Parsetree_type_declaration x1)]) + | Parsetree.Psig_typext x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_typext", [this#lift_Parsetree_type_extension x0]) + | Parsetree.Psig_exception x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_exception", + [this#lift_Parsetree_extension_constructor x0]) + | Parsetree.Psig_module x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_module", [this#lift_Parsetree_module_declaration x0]) + | Parsetree.Psig_recmodule x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_recmodule", + [this#list + (List.map this#lift_Parsetree_module_declaration x0)]) + | Parsetree.Psig_modtype x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_modtype", + [this#lift_Parsetree_module_type_declaration x0]) + | Parsetree.Psig_open x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_open", [this#lift_Parsetree_open_description x0]) + | Parsetree.Psig_include x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_include", [this#lift_Parsetree_include_description x0]) + | Parsetree.Psig_class x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_class", + [this#list (List.map this#lift_Parsetree_class_description x0)]) + | Parsetree.Psig_class_type x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_class_type", + [this#list + (List.map this#lift_Parsetree_class_type_declaration x0)]) + | Parsetree.Psig_attribute x0 -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Psig_extension (x0, x1) -> + this#constr "Ast_406.Parsetree.signature_item_desc" + ("Psig_extension", + [this#lift_Parsetree_extension x0; + this#lift_Parsetree_attributes x1]) : Parsetree.signature_item_desc + -> 'res) + method lift_Parsetree_class_type_declaration : + Parsetree.class_type_declaration -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_type_declaration -> 'res) + method lift_Parsetree_class_description : + Parsetree.class_description -> 'res= + (fun x -> + this#lift_Parsetree_class_infos this#lift_Parsetree_class_type x : + Parsetree.class_description -> 'res) + method lift_Parsetree_class_type : Parsetree.class_type -> 'res= + (fun + { Parsetree.pcty_desc = pcty_desc; Parsetree.pcty_loc = pcty_loc; + Parsetree.pcty_attributes = pcty_attributes } + -> + this#record "Ast_406.Parsetree.class_type" + [("pcty_desc", (this#lift_Parsetree_class_type_desc pcty_desc)); + ("pcty_loc", (this#lift_Location_t pcty_loc)); + ("pcty_attributes", + (this#lift_Parsetree_attributes pcty_attributes))] : Parsetree.class_type + -> + 'res) + method lift_Parsetree_class_type_desc : + Parsetree.class_type_desc -> 'res= + (function + | Parsetree.Pcty_constr (x0, x1) -> + this#constr "Ast_406.Parsetree.class_type_desc" + ("Pcty_constr", + [this#lift_Asttypes_loc this#lift_Longident_t x0; + this#list (List.map this#lift_Parsetree_core_type x1)]) + | Parsetree.Pcty_signature x0 -> + this#constr "Ast_406.Parsetree.class_type_desc" + ("Pcty_signature", [this#lift_Parsetree_class_signature x0]) + | Parsetree.Pcty_arrow (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.class_type_desc" + ("Pcty_arrow", + [this#lift_Asttypes_arg_label x0; + this#lift_Parsetree_core_type x1; + this#lift_Parsetree_class_type x2]) + | Parsetree.Pcty_extension x0 -> + this#constr "Ast_406.Parsetree.class_type_desc" + ("Pcty_extension", [this#lift_Parsetree_extension x0]) + | Parsetree.Pcty_open (x0, x1, x2) -> + this#constr "Ast_406.Parsetree.class_type_desc" + ("Pcty_open", + [this#lift_Asttypes_override_flag x0; + this#lift_Asttypes_loc this#lift_Longident_t x1; + this#lift_Parsetree_class_type x2]) : Parsetree.class_type_desc + -> 'res) + method lift_Parsetree_class_signature : + Parsetree.class_signature -> 'res= + (fun + { Parsetree.pcsig_self = pcsig_self; + Parsetree.pcsig_fields = pcsig_fields } + -> + this#record "Ast_406.Parsetree.class_signature" + [("pcsig_self", (this#lift_Parsetree_core_type pcsig_self)); + ("pcsig_fields", + (this#list + (List.map this#lift_Parsetree_class_type_field pcsig_fields)))] : + Parsetree.class_signature -> 'res) + method lift_Parsetree_class_type_field : + Parsetree.class_type_field -> 'res= + (fun + { Parsetree.pctf_desc = pctf_desc; Parsetree.pctf_loc = pctf_loc; + Parsetree.pctf_attributes = pctf_attributes } + -> + this#record "Ast_406.Parsetree.class_type_field" + [("pctf_desc", + (this#lift_Parsetree_class_type_field_desc pctf_desc)); + ("pctf_loc", (this#lift_Location_t pctf_loc)); + ("pctf_attributes", + (this#lift_Parsetree_attributes pctf_attributes))] : Parsetree.class_type_field + -> + 'res) + method lift_Parsetree_class_type_field_desc : + Parsetree.class_type_field_desc -> 'res= + (function + | Parsetree.Pctf_inherit x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_inherit", [this#lift_Parsetree_class_type x0]) + | Parsetree.Pctf_val x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_val", + [(let (x0, x1, x2, x3) = x0 in + this#tuple + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Asttypes_mutable_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_method x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_method", + [(let (x0, x1, x2, x3) = x0 in + this#tuple + [this#lift_Asttypes_loc this#lift_Asttypes_label x0; + this#lift_Asttypes_private_flag x1; + this#lift_Asttypes_virtual_flag x2; + this#lift_Parsetree_core_type x3])]) + | Parsetree.Pctf_constraint x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_constraint", + [(let (x0, x1) = x0 in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1])]) + | Parsetree.Pctf_attribute x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_attribute", [this#lift_Parsetree_attribute x0]) + | Parsetree.Pctf_extension x0 -> + this#constr "Ast_406.Parsetree.class_type_field_desc" + ("Pctf_extension", [this#lift_Parsetree_extension x0]) : + Parsetree.class_type_field_desc -> 'res) + method lift_Parsetree_extension : Parsetree.extension -> 'res= + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Asttypes_loc this#string x0; + this#lift_Parsetree_payload x1] : Parsetree.extension -> 'res) + method lift_Parsetree_class_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.class_infos -> 'res= fun (type f0) + -> + (fun f0 -> + fun + { Parsetree.pci_virt = pci_virt; + Parsetree.pci_params = pci_params; + Parsetree.pci_name = pci_name; Parsetree.pci_expr = pci_expr; + Parsetree.pci_loc = pci_loc; + Parsetree.pci_attributes = pci_attributes } + -> + this#record "Ast_406.Parsetree.class_infos" + [("pci_virt", (this#lift_Asttypes_virtual_flag pci_virt)); + ("pci_params", + (this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) pci_params))); + ("pci_name", (this#lift_Asttypes_loc this#string pci_name)); + ("pci_expr", (f0 pci_expr)); + ("pci_loc", (this#lift_Location_t pci_loc)); + ("pci_attributes", + (this#lift_Parsetree_attributes pci_attributes))] : (f0 -> + 'res) -> + f0 + Parsetree.class_infos + -> + 'res) + method lift_Asttypes_virtual_flag : Asttypes.virtual_flag -> 'res= + (function + | Asttypes.Virtual -> + this#constr "Ast_406.Asttypes.virtual_flag" ("Virtual", []) + | Asttypes.Concrete -> + this#constr "Ast_406.Asttypes.virtual_flag" ("Concrete", []) : Asttypes.virtual_flag + -> + 'res) + method lift_Parsetree_include_description : + Parsetree.include_description -> 'res= + (fun x -> + this#lift_Parsetree_include_infos this#lift_Parsetree_module_type x : + Parsetree.include_description -> 'res) + method lift_Parsetree_include_infos : + 'f0 . ('f0 -> 'res) -> 'f0 Parsetree.include_infos -> 'res= fun (type + f0) -> + (fun f0 -> + fun + { Parsetree.pincl_mod = pincl_mod; + Parsetree.pincl_loc = pincl_loc; + Parsetree.pincl_attributes = pincl_attributes } + -> + this#record "Ast_406.Parsetree.include_infos" + [("pincl_mod", (f0 pincl_mod)); + ("pincl_loc", (this#lift_Location_t pincl_loc)); + ("pincl_attributes", + (this#lift_Parsetree_attributes pincl_attributes))] : + (f0 -> 'res) -> f0 Parsetree.include_infos -> 'res) + method lift_Parsetree_open_description : + Parsetree.open_description -> 'res= + (fun + { Parsetree.popen_lid = popen_lid; + Parsetree.popen_override = popen_override; + Parsetree.popen_loc = popen_loc; + Parsetree.popen_attributes = popen_attributes } + -> + this#record "Ast_406.Parsetree.open_description" + [("popen_lid", + (this#lift_Asttypes_loc this#lift_Longident_t popen_lid)); + ("popen_override", + (this#lift_Asttypes_override_flag popen_override)); + ("popen_loc", (this#lift_Location_t popen_loc)); + ("popen_attributes", + (this#lift_Parsetree_attributes popen_attributes))] : Parsetree.open_description + -> + 'res) + method lift_Asttypes_override_flag : Asttypes.override_flag -> 'res= + (function + | Asttypes.Override -> + this#constr "Ast_406.Asttypes.override_flag" ("Override", []) + | Asttypes.Fresh -> this#constr "Ast_406.Asttypes.override_flag" ("Fresh", []) : + Asttypes.override_flag -> 'res) + method lift_Parsetree_module_type_declaration : + Parsetree.module_type_declaration -> 'res= + (fun + { Parsetree.pmtd_name = pmtd_name; Parsetree.pmtd_type = pmtd_type; + Parsetree.pmtd_attributes = pmtd_attributes; + Parsetree.pmtd_loc = pmtd_loc } + -> + this#record "Ast_406.Parsetree.module_type_declaration" + [("pmtd_name", (this#lift_Asttypes_loc this#string pmtd_name)); + ("pmtd_type", + (this#lift_option this#lift_Parsetree_module_type pmtd_type)); + ("pmtd_attributes", + (this#lift_Parsetree_attributes pmtd_attributes)); + ("pmtd_loc", (this#lift_Location_t pmtd_loc))] : Parsetree.module_type_declaration + -> 'res) + method lift_Parsetree_module_declaration : + Parsetree.module_declaration -> 'res= + (fun + { Parsetree.pmd_name = pmd_name; Parsetree.pmd_type = pmd_type; + Parsetree.pmd_attributes = pmd_attributes; + Parsetree.pmd_loc = pmd_loc } + -> + this#record "Ast_406.Parsetree.module_declaration" + [("pmd_name", (this#lift_Asttypes_loc this#string pmd_name)); + ("pmd_type", (this#lift_Parsetree_module_type pmd_type)); + ("pmd_attributes", + (this#lift_Parsetree_attributes pmd_attributes)); + ("pmd_loc", (this#lift_Location_t pmd_loc))] : Parsetree.module_declaration + -> 'res) + method lift_Parsetree_type_extension : Parsetree.type_extension -> 'res= + (fun + { Parsetree.ptyext_path = ptyext_path; + Parsetree.ptyext_params = ptyext_params; + Parsetree.ptyext_constructors = ptyext_constructors; + Parsetree.ptyext_private = ptyext_private; + Parsetree.ptyext_attributes = ptyext_attributes } + -> + this#record "Ast_406.Parsetree.type_extension" + [("ptyext_path", + (this#lift_Asttypes_loc this#lift_Longident_t ptyext_path)); + ("ptyext_params", + (this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptyext_params))); + ("ptyext_constructors", + (this#list + (List.map this#lift_Parsetree_extension_constructor + ptyext_constructors))); + ("ptyext_private", + (this#lift_Asttypes_private_flag ptyext_private)); + ("ptyext_attributes", + (this#lift_Parsetree_attributes ptyext_attributes))] : Parsetree.type_extension + -> + 'res) + method lift_Parsetree_extension_constructor : + Parsetree.extension_constructor -> 'res= + (fun + { Parsetree.pext_name = pext_name; Parsetree.pext_kind = pext_kind; + Parsetree.pext_loc = pext_loc; + Parsetree.pext_attributes = pext_attributes } + -> + this#record "Ast_406.Parsetree.extension_constructor" + [("pext_name", (this#lift_Asttypes_loc this#string pext_name)); + ("pext_kind", + (this#lift_Parsetree_extension_constructor_kind pext_kind)); + ("pext_loc", (this#lift_Location_t pext_loc)); + ("pext_attributes", + (this#lift_Parsetree_attributes pext_attributes))] : Parsetree.extension_constructor + -> + 'res) + method lift_Parsetree_extension_constructor_kind : + Parsetree.extension_constructor_kind -> 'res= + (function + | Parsetree.Pext_decl (x0, x1) -> + this#constr "Ast_406.Parsetree.extension_constructor_kind" + ("Pext_decl", + [this#lift_Parsetree_constructor_arguments x0; + this#lift_option this#lift_Parsetree_core_type x1]) + | Parsetree.Pext_rebind x0 -> + this#constr "Ast_406.Parsetree.extension_constructor_kind" + ("Pext_rebind", + [this#lift_Asttypes_loc this#lift_Longident_t x0]) : Parsetree.extension_constructor_kind + -> + 'res) + method lift_Parsetree_type_declaration : + Parsetree.type_declaration -> 'res= + (fun + { Parsetree.ptype_name = ptype_name; + Parsetree.ptype_params = ptype_params; + Parsetree.ptype_cstrs = ptype_cstrs; + Parsetree.ptype_kind = ptype_kind; + Parsetree.ptype_private = ptype_private; + Parsetree.ptype_manifest = ptype_manifest; + Parsetree.ptype_attributes = ptype_attributes; + Parsetree.ptype_loc = ptype_loc } + -> + this#record "Ast_406.Parsetree.type_declaration" + [("ptype_name", (this#lift_Asttypes_loc this#string ptype_name)); + ("ptype_params", + (this#list + (List.map + (fun x -> + let (x0, x1) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Asttypes_variance x1]) ptype_params))); + ("ptype_cstrs", + (this#list + (List.map + (fun x -> + let (x0, x1, x2) = x in + this#tuple + [this#lift_Parsetree_core_type x0; + this#lift_Parsetree_core_type x1; + this#lift_Location_t x2]) ptype_cstrs))); + ("ptype_kind", (this#lift_Parsetree_type_kind ptype_kind)); + ("ptype_private", (this#lift_Asttypes_private_flag ptype_private)); + ("ptype_manifest", + (this#lift_option this#lift_Parsetree_core_type ptype_manifest)); + ("ptype_attributes", + (this#lift_Parsetree_attributes ptype_attributes)); + ("ptype_loc", (this#lift_Location_t ptype_loc))] : Parsetree.type_declaration + -> 'res) + method lift_Asttypes_private_flag : Asttypes.private_flag -> 'res= + (function + | Asttypes.Private -> + this#constr "Ast_406.Asttypes.private_flag" ("Private", []) + | Asttypes.Public -> + this#constr "Ast_406.Asttypes.private_flag" ("Public", []) : Asttypes.private_flag + -> + 'res) + method lift_Parsetree_type_kind : Parsetree.type_kind -> 'res= + (function + | Parsetree.Ptype_abstract -> + this#constr "Ast_406.Parsetree.type_kind" ("Ptype_abstract", []) + | Parsetree.Ptype_variant x0 -> + this#constr "Ast_406.Parsetree.type_kind" + ("Ptype_variant", + [this#list + (List.map this#lift_Parsetree_constructor_declaration x0)]) + | Parsetree.Ptype_record x0 -> + this#constr "Ast_406.Parsetree.type_kind" + ("Ptype_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) + | Parsetree.Ptype_open -> + this#constr "Ast_406.Parsetree.type_kind" ("Ptype_open", []) : Parsetree.type_kind + -> + 'res) + method lift_Parsetree_constructor_declaration : + Parsetree.constructor_declaration -> 'res= + (fun + { Parsetree.pcd_name = pcd_name; Parsetree.pcd_args = pcd_args; + Parsetree.pcd_res = pcd_res; Parsetree.pcd_loc = pcd_loc; + Parsetree.pcd_attributes = pcd_attributes } + -> + this#record "Ast_406.Parsetree.constructor_declaration" + [("pcd_name", (this#lift_Asttypes_loc this#string pcd_name)); + ("pcd_args", (this#lift_Parsetree_constructor_arguments pcd_args)); + ("pcd_res", + (this#lift_option this#lift_Parsetree_core_type pcd_res)); + ("pcd_loc", (this#lift_Location_t pcd_loc)); + ("pcd_attributes", + (this#lift_Parsetree_attributes pcd_attributes))] : Parsetree.constructor_declaration + -> + 'res) + method lift_Parsetree_constructor_arguments : + Parsetree.constructor_arguments -> 'res= + (function + | Parsetree.Pcstr_tuple x0 -> + this#constr "Ast_406.Parsetree.constructor_arguments" + ("Pcstr_tuple", + [this#list (List.map this#lift_Parsetree_core_type x0)]) + | Parsetree.Pcstr_record x0 -> + this#constr "Ast_406.Parsetree.constructor_arguments" + ("Pcstr_record", + [this#list (List.map this#lift_Parsetree_label_declaration x0)]) : + Parsetree.constructor_arguments -> 'res) + method lift_Parsetree_label_declaration : + Parsetree.label_declaration -> 'res= + (fun + { Parsetree.pld_name = pld_name; + Parsetree.pld_mutable = pld_mutable; + Parsetree.pld_type = pld_type; Parsetree.pld_loc = pld_loc; + Parsetree.pld_attributes = pld_attributes } + -> + this#record "Ast_406.Parsetree.label_declaration" + [("pld_name", (this#lift_Asttypes_loc this#string pld_name)); + ("pld_mutable", (this#lift_Asttypes_mutable_flag pld_mutable)); + ("pld_type", (this#lift_Parsetree_core_type pld_type)); + ("pld_loc", (this#lift_Location_t pld_loc)); + ("pld_attributes", + (this#lift_Parsetree_attributes pld_attributes))] : Parsetree.label_declaration + -> + 'res) + method lift_Asttypes_mutable_flag : Asttypes.mutable_flag -> 'res= + (function + | Asttypes.Immutable -> + this#constr "Ast_406.Asttypes.mutable_flag" ("Immutable", []) + | Asttypes.Mutable -> + this#constr "Ast_406.Asttypes.mutable_flag" ("Mutable", []) : Asttypes.mutable_flag + -> + 'res) + method lift_Asttypes_variance : Asttypes.variance -> 'res= + (function + | Asttypes.Covariant -> + this#constr "Ast_406.Asttypes.variance" ("Covariant", []) + | Asttypes.Contravariant -> + this#constr "Ast_406.Asttypes.variance" ("Contravariant", []) + | Asttypes.Invariant -> + this#constr "Ast_406.Asttypes.variance" ("Invariant", []) : Asttypes.variance + -> 'res) + method lift_Parsetree_value_description : + Parsetree.value_description -> 'res= + (fun + { Parsetree.pval_name = pval_name; Parsetree.pval_type = pval_type; + Parsetree.pval_prim = pval_prim; + Parsetree.pval_attributes = pval_attributes; + Parsetree.pval_loc = pval_loc } + -> + this#record "Ast_406.Parsetree.value_description" + [("pval_name", (this#lift_Asttypes_loc this#string pval_name)); + ("pval_type", (this#lift_Parsetree_core_type pval_type)); + ("pval_prim", (this#list (List.map this#string pval_prim))); + ("pval_attributes", + (this#lift_Parsetree_attributes pval_attributes)); + ("pval_loc", (this#lift_Location_t pval_loc))] : Parsetree.value_description + -> 'res) + method lift_Asttypes_arg_label : Asttypes.arg_label -> 'res= + (function + | Asttypes.Nolabel -> this#constr "Ast_406.Asttypes.arg_label" ("Nolabel", []) + | Asttypes.Labelled x0 -> + this#constr "Ast_406.Asttypes.arg_label" ("Labelled", [this#string x0]) + | Asttypes.Optional x0 -> + this#constr "Ast_406.Asttypes.arg_label" ("Optional", [this#string x0]) : + Asttypes.arg_label -> 'res) + method lift_Asttypes_closed_flag : Asttypes.closed_flag -> 'res= + (function + | Asttypes.Closed -> this#constr "Ast_406.Asttypes.closed_flag" ("Closed", []) + | Asttypes.Open -> this#constr "Ast_406.Asttypes.closed_flag" ("Open", []) : + Asttypes.closed_flag -> 'res) + method lift_Asttypes_label : Asttypes.label -> 'res= + (this#string : Asttypes.label -> 'res) + method lift_Asttypes_rec_flag : Asttypes.rec_flag -> 'res= + (function + | Asttypes.Nonrecursive -> + this#constr "Ast_406.Asttypes.rec_flag" ("Nonrecursive", []) + | Asttypes.Recursive -> + this#constr "Ast_406.Asttypes.rec_flag" ("Recursive", []) : Asttypes.rec_flag + -> 'res) + method lift_Parsetree_constant : Parsetree.constant -> 'res= + (function + | Parsetree.Pconst_integer (x0, x1) -> + this#constr "Ast_406.Parsetree.constant" + ("Pconst_integer", + [this#string x0; this#lift_option this#char x1]) + | Parsetree.Pconst_char x0 -> + this#constr "Ast_406.Parsetree.constant" ("Pconst_char", [this#char x0]) + | Parsetree.Pconst_string (x0, x1) -> + this#constr "Ast_406.Parsetree.constant" + ("Pconst_string", + [this#string x0; this#lift_option this#string x1]) + | Parsetree.Pconst_float (x0, x1) -> + this#constr "Ast_406.Parsetree.constant" + ("Pconst_float", + [this#string x0; this#lift_option this#char x1]) : Parsetree.constant + -> + 'res) + method lift_option : 'f0 . ('f0 -> 'res) -> 'f0 option -> 'res= fun (type + f0) -> + (fun f0 -> + function + | None -> this#constr "option" ("None", []) + | Some x0 -> this#constr "option" ("Some", [f0 x0]) : (f0 -> 'res) + -> + f0 option -> + 'res) + method lift_Longident_t : Longident.t -> 'res= + (function + | Longident.Lident x0 -> + this#constr "Ast_406.Longident.t" ("Lident", [this#string x0]) + | Longident.Ldot (x0, x1) -> + this#constr "Ast_406.Longident.t" + ("Ldot", [this#lift_Longident_t x0; this#string x1]) + | Longident.Lapply (x0, x1) -> + this#constr "Ast_406.Longident.t" + ("Lapply", [this#lift_Longident_t x0; this#lift_Longident_t x1]) : + Longident.t -> 'res) + method lift_Asttypes_loc : + 'f0 . ('f0 -> 'res) -> 'f0 Asttypes.loc -> 'res= fun (type f0) -> + (fun f0 -> + fun { Asttypes.txt = txt; Asttypes.loc = loc } -> + this#record "Ast_406.Asttypes.loc" + [("txt", (f0 txt)); ("loc", (this#lift_Location_t loc))] : + (f0 -> 'res) -> f0 Asttypes.loc -> 'res) + method lift_Location_t : Location.t -> 'res= + (fun + { Location.loc_start = loc_start; Location.loc_end = loc_end; + Location.loc_ghost = loc_ghost } + -> + this#record "Ast_406.Location.t" + [("loc_start", (this#lift_Lexing_position loc_start)); + ("loc_end", (this#lift_Lexing_position loc_end)); + ("loc_ghost", (this#lift_bool loc_ghost))] : Location.t -> 'res) + method lift_bool : bool -> 'res= + (function + | false -> this#constr "bool" ("false", []) + | true -> this#constr "bool" ("true", []) : bool -> 'res) + method lift_Lexing_position : Lexing.position -> 'res= + (fun + { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; + Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } + -> + this#record "Lexing.position" + [("pos_fname", (this#string pos_fname)); + ("pos_lnum", (this#int pos_lnum)); + ("pos_bol", (this#int pos_bol)); + ("pos_cnum", (this#int pos_cnum))] : Lexing.position -> 'res) + end diff --git a/ast_mapper_class_402.ml b/ast_mapper_class_402.ml new file mode 100644 index 0000000..4c8dda0 --- /dev/null +++ b/ast_mapper_class_402.ml @@ -0,0 +1,576 @@ +open Ast_402 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree +open Asttypes +open Ast_helper + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub # location loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub # attributes attrs, b, List.map (sub # typ) tl) + | Rinherit t -> Rinherit (sub # typ t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub # attributes a, sub # typ t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub # typ)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub # typ)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) + ptype_cstrs) + ~kind:(sub # type_kind ptype_kind) + ?manifest:(map_opt (sub # typ) ptype_manifest) + ~loc:(sub # location ptype_loc) + ~attrs:(sub # attributes ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub # constructor_declaration) l) + | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub # extension_constructor) ptyext_constructors) + ~params:(List.map (map_fst (sub # typ)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub # attributes ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(List.map (sub # typ) ctl, map_opt (sub # typ) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub # location pext_loc) + ~attrs:(sub # attributes pext_attributes) + + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub # location loc in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub # typ t) (sub # class_type ct) + | Pcty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub # location loc in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pctf_attribute x -> attribute ~loc (sub # attribute x) + | Pctf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub # typ pcsig_self) + (List.map (sub # class_type_field) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (map_opt (sub # module_type) mt1) + (sub # module_type mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub # module_type mt) + (List.map (sub # with_constraint) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me) + | Pmty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub # type_declaration d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub # location loc in + match desc with + | Psig_value vd -> value ~loc (sub # value_description vd) + | Psig_type l -> type_ ~loc (List.map (sub # type_declaration) l) + | Psig_typext te -> type_extension ~loc (sub # type_extension te) + | Psig_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Psig_module x -> module_ ~loc (sub # module_declaration x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub # module_declaration) l) + | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Psig_open od -> open_ ~loc (sub # open_description od) + | Psig_include x -> include_ ~loc (sub # include_description x) + | Psig_class l -> class_ ~loc (List.map (sub # class_description) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Psig_attribute x -> attribute ~loc (sub # attribute x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub # structure str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (map_opt (sub # module_type) arg_ty) + (sub # module_expr body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e) + | Pmod_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub # location loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs) + | Pstr_primitive vd -> primitive ~loc (sub # value_description vd) + | Pstr_type l -> type_ ~loc (List.map (sub # type_declaration) l) + | Pstr_typext te -> type_extension ~loc (sub # type_extension te) + | Pstr_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Pstr_module x -> module_ ~loc (sub # module_binding x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) + | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Pstr_open od -> open_ ~loc (sub # open_description od) + | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Pstr_include x -> include_ ~loc (sub # include_declaration x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Pstr_attribute x -> attribute ~loc (sub # attribute x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) + (sub # expr e) + | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l) + | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub # expr) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) + (map_opt (sub # expr) eo) + | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) + (map_opt (sub # expr) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub # pat p) (sub # expr e1) (sub # expr e2) d + (sub # expr e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) + (sub # typ t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub # expr e) (sub # typ t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub # expr)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) + (sub # expr e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e) + | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e) + | Pexp_extension x -> extension ~loc ~attrs (sub # extension x) +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) + cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub # pat p) (sub # typ t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) + | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub # location loc in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub # class_structure s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub # expr) e) + (sub # pat p) + (sub # class_expr ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub # class_expr ce) + (List.map (map_snd (sub # expr)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) + (sub # class_expr ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct) + | Pcl_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e) + | Cfk_virtual t -> Cfk_virtual (sub # typ t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub # location loc in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e) + | Pcf_attribute x -> attribute ~loc (sub # attribute x) + | Pcf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub # pat pcstr_self; + pcstr_fields = List.map (sub # class_field) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub # typ)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub # location pci_loc) + ~attrs:(sub # attributes pci_attributes) +end + +(* Now, a generic AST mapper class, to be extended to cover all kinds + and cases of the OCaml grammar. The default behavior of the mapper + is the identity. *) + +class mapper = + object(this) + method structure l = List.map (this # structure_item) l + method structure_item si = M.map_structure_item this si + method module_expr = M.map this + + method signature l = List.map (this # signature_item) l + method signature_item si = MT.map_signature_item this si + method module_type = MT.map this + method with_constraint c = MT.map_with_constraint this c + + method class_declaration = CE.class_infos this (this # class_expr) + method class_expr = CE.map this + method class_field = CE.map_field this + method class_structure = CE.map_structure this + + method class_type = CT.map this + method class_type_field = CT.map_field this + method class_signature = CT.map_signature this + + method class_type_declaration = CE.class_infos this (this # class_type) + method class_description = CE.class_infos this (this # class_type) + + method type_declaration = T.map_type_declaration this + method type_kind = T.map_type_kind this + method typ = T.map this + + method type_extension = T.map_type_extension this + method extension_constructor = T.map_extension_constructor this + + method value_description {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} = + Val.mk + (map_loc this pval_name) + (this # typ pval_type) + ~attrs:(this # attributes pval_attributes) + ~loc:(this # location pval_loc) + ~prim:pval_prim + + method pat = P.map this + method expr = E.map this + + method module_declaration {pmd_name; pmd_type; pmd_attributes; pmd_loc} = + Md.mk + (map_loc this pmd_name) + (this # module_type pmd_type) + ~attrs:(this # attributes pmd_attributes) + ~loc:(this # location pmd_loc) + + method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this # module_type) pmtd_type) + ~attrs:(this # attributes pmtd_attributes) + ~loc:(this # location pmtd_loc) + + method module_binding {pmb_name; pmb_expr; pmb_attributes; pmb_loc} = + Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr) + ~attrs:(this # attributes pmb_attributes) + ~loc:(this # location pmb_loc) + + method value_binding {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} = + Vb.mk + (this # pat pvb_pat) + (this # expr pvb_expr) + ~attrs:(this # attributes pvb_attributes) + ~loc:(this # location pvb_loc) + + + method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; + pcd_attributes} = + Type.constructor + (map_loc this pcd_name) + ~args:(List.map (this # typ) pcd_args) + ?res:(map_opt (this # typ) pcd_res) + ~loc:(this # location pcd_loc) + ~attrs:(this # attributes pcd_attributes) + + method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; + pld_attributes} = + Type.field + (map_loc this pld_name) + (this # typ pld_type) + ~mut:pld_mutable + ~loc:(this # location pld_loc) + ~attrs:(this # attributes pld_attributes) + + + method cases l = List.map (this # case) l + method case {pc_lhs; pc_guard; pc_rhs} = + { + pc_lhs = this # pat pc_lhs; + pc_guard = map_opt (this # expr) pc_guard; + pc_rhs = this # expr pc_rhs; + } + + method open_description + {popen_lid; popen_override; popen_attributes; popen_loc} = + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this # location popen_loc) + ~attrs:(this # attributes popen_attributes) + + method include_description + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_type pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method include_declaration + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_expr pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method location l = l + + method extension (s, e) = (map_loc this s, this # payload e) + method attribute (s, e) = (map_loc this s, this # payload e) + method attributes l = List.map (this # attribute) l + method payload = function + | PStr x -> PStr (this # structure x) + | PTyp x -> PTyp (this # typ x) + | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g) + end + + +let to_mapper this = + let open Ast_mapper in + { + attribute = (fun _ -> this # attribute); + attributes = (fun _ -> this # attributes); + case = (fun _ -> this # case); + cases = (fun _ -> this # cases); + class_declaration = (fun _ -> this # class_declaration); + class_description = (fun _ -> this # class_description); + class_expr = (fun _ -> this # class_expr); + class_field = (fun _ -> this # class_field); + class_signature = (fun _ -> this # class_signature); + class_structure = (fun _ -> this # class_structure); + class_type = (fun _ -> this # class_type); + class_type_declaration = (fun _ -> this # class_type_declaration); + class_type_field = (fun _ -> this # class_type_field); + constructor_declaration = (fun _ -> this # constructor_declaration); + expr = (fun _ -> this # expr); + extension = (fun _ -> this # extension); + extension_constructor = (fun _ -> this # extension_constructor); + include_declaration = (fun _ -> this # include_declaration); + include_description = (fun _ -> this # include_description); + label_declaration = (fun _ -> this # label_declaration); + location = (fun _ -> this # location); + module_binding = (fun _ -> this # module_binding); + module_declaration = (fun _ -> this # module_declaration); + module_expr = (fun _ -> this # module_expr); + module_type = (fun _ -> this # module_type); + module_type_declaration = (fun _ -> this # module_type_declaration); + open_description = (fun _ -> this # open_description); + pat = (fun _ -> this # pat); + payload = (fun _ -> this # payload); + signature = (fun _ -> this # signature); + signature_item = (fun _ -> this # signature_item); + structure = (fun _ -> this # structure); + structure_item = (fun _ -> this # structure_item); + typ = (fun _ -> this # typ); + type_declaration = (fun _ -> this # type_declaration); + type_extension = (fun _ -> this # type_extension); + type_kind = (fun _ -> this # type_kind); + value_binding = (fun _ -> this # value_binding); + value_description = (fun _ -> this # value_description); + with_constraint = (fun _ -> this # with_constraint); + } diff --git a/ast_mapper_class_402.mli b/ast_mapper_class_402.mli new file mode 100644 index 0000000..3fbaa22 --- /dev/null +++ b/ast_mapper_class_402.mli @@ -0,0 +1,57 @@ +open Ast_402 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree + +class mapper: + object + method attribute: attribute -> attribute + method attributes: attribute list -> attribute list + method case: case -> case + method cases: case list -> case list + method class_declaration: class_declaration -> class_declaration + method class_description: class_description -> class_description + method class_expr: class_expr -> class_expr + method class_field: class_field -> class_field + method class_signature: class_signature -> class_signature + method class_structure: class_structure -> class_structure + method class_type: class_type -> class_type + method class_type_declaration: class_type_declaration -> class_type_declaration + method class_type_field: class_type_field -> class_type_field + method constructor_declaration: constructor_declaration -> constructor_declaration + method expr: expression -> expression + method extension: extension -> extension + method extension_constructor: extension_constructor -> extension_constructor + method include_declaration: include_declaration -> include_declaration + method include_description: include_description -> include_description + method label_declaration: label_declaration -> label_declaration + method location: Location.t -> Location.t + method module_binding: module_binding -> module_binding + method module_declaration: module_declaration -> module_declaration + method module_expr: module_expr -> module_expr + method module_type: module_type -> module_type + method module_type_declaration: module_type_declaration -> module_type_declaration + method open_description: open_description -> open_description + method pat: pattern -> pattern + method payload: payload -> payload + method signature: signature -> signature + method signature_item: signature_item -> signature_item + method structure: structure -> structure + method structure_item: structure_item -> structure_item + method typ: core_type -> core_type + method type_declaration: type_declaration -> type_declaration + method type_extension: type_extension -> type_extension + method type_kind: type_kind -> type_kind + method value_binding: value_binding -> value_binding + method value_description: value_description -> value_description + method with_constraint: with_constraint -> with_constraint + end + +val to_mapper: #mapper -> Ast_mapper.mapper +(** The resulting mapper is "closed", i.e. methods ignore + their first argument. *) diff --git a/ast_mapper_class_403.ml b/ast_mapper_class_403.ml new file mode 100644 index 0000000..0d76977 --- /dev/null +++ b/ast_mapper_class_403.ml @@ -0,0 +1,581 @@ +open Ast_403 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree +open Asttypes +open Ast_helper + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub # location loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub # attributes attrs, b, List.map (sub # typ) tl) + | Rinherit t -> Rinherit (sub # typ t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub # attributes a, sub # typ t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub # typ)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub # typ)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) + ptype_cstrs) + ~kind:(sub # type_kind ptype_kind) + ?manifest:(map_opt (sub # typ) ptype_manifest) + ~loc:(sub # location ptype_loc) + ~attrs:(sub # attributes ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub # constructor_declaration) l) + | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub # extension_constructor) ptyext_constructors) + ~params:(List.map (map_fst (sub # typ)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub # attributes ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(sub # constructor_arguments ctl, map_opt (sub # typ) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub # location pext_loc) + ~attrs:(sub # attributes pext_attributes) + + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub # location loc in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub # typ t) (sub # class_type ct) + | Pcty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub # location loc in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pctf_attribute x -> attribute ~loc (sub # attribute x) + | Pctf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub # typ pcsig_self) + (List.map (sub # class_type_field) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (map_opt (sub # module_type) mt1) + (sub # module_type mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub # module_type mt) + (List.map (sub # with_constraint) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me) + | Pmty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub # type_declaration d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub # location loc in + match desc with + | Psig_value vd -> value ~loc (sub # value_description vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Psig_typext te -> type_extension ~loc (sub # type_extension te) + | Psig_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Psig_module x -> module_ ~loc (sub # module_declaration x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub # module_declaration) l) + | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Psig_open od -> open_ ~loc (sub # open_description od) + | Psig_include x -> include_ ~loc (sub # include_description x) + | Psig_class l -> class_ ~loc (List.map (sub # class_description) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Psig_attribute x -> attribute ~loc (sub # attribute x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub # structure str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (map_opt (sub # module_type) arg_ty) + (sub # module_expr body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e) + | Pmod_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub # location loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs) + | Pstr_primitive vd -> primitive ~loc (sub # value_description vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Pstr_typext te -> type_extension ~loc (sub # type_extension te) + | Pstr_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Pstr_module x -> module_ ~loc (sub # module_binding x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) + | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Pstr_open od -> open_ ~loc (sub # open_description od) + | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Pstr_include x -> include_ ~loc (sub # include_declaration x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Pstr_attribute x -> attribute ~loc (sub # attribute x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) + (sub # expr e) + | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l) + | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub # expr) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) + (map_opt (sub # expr) eo) + | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) + (map_opt (sub # expr) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub # pat p) (sub # expr e1) (sub # expr e2) d + (sub # expr e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) + (sub # typ t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub # expr e) (sub # typ t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub # expr)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) + (sub # expr e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e) + | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e) + | Pexp_extension x -> extension ~loc ~attrs (sub # extension x) + | Pexp_unreachable -> unreachable ~loc ~attrs () +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) + cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub # pat p) (sub # typ t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) + | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub # location loc in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub # class_structure s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub # expr) e) + (sub # pat p) + (sub # class_expr ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub # class_expr ce) + (List.map (map_snd (sub # expr)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) + (sub # class_expr ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct) + | Pcl_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e) + | Cfk_virtual t -> Cfk_virtual (sub # typ t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub # location loc in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e) + | Pcf_attribute x -> attribute ~loc (sub # attribute x) + | Pcf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub # pat pcstr_self; + pcstr_fields = List.map (sub # class_field) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub # typ)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub # location pci_loc) + ~attrs:(sub # attributes pci_attributes) +end + +(* Now, a generic AST mapper class, to be extended to cover all kinds + and cases of the OCaml grammar. The default behavior of the mapper + is the identity. *) + +class mapper = + object(this) + method structure l = List.map (this # structure_item) l + method structure_item si = M.map_structure_item this si + method module_expr = M.map this + + method signature l = List.map (this # signature_item) l + method signature_item si = MT.map_signature_item this si + method module_type = MT.map this + method with_constraint c = MT.map_with_constraint this c + + method class_declaration = CE.class_infos this (this # class_expr) + method class_expr = CE.map this + method class_field = CE.map_field this + method class_structure = CE.map_structure this + + method class_type = CT.map this + method class_type_field = CT.map_field this + method class_signature = CT.map_signature this + + method class_type_declaration = CE.class_infos this (this # class_type) + method class_description = CE.class_infos this (this # class_type) + + method type_declaration = T.map_type_declaration this + method type_kind = T.map_type_kind this + method typ = T.map this + + method type_extension = T.map_type_extension this + method extension_constructor = T.map_extension_constructor this + + method value_description {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} = + Val.mk + (map_loc this pval_name) + (this # typ pval_type) + ~attrs:(this # attributes pval_attributes) + ~loc:(this # location pval_loc) + ~prim:pval_prim + + method pat = P.map this + method expr = E.map this + + method module_declaration {pmd_name; pmd_type; pmd_attributes; pmd_loc} = + Md.mk + (map_loc this pmd_name) + (this # module_type pmd_type) + ~attrs:(this # attributes pmd_attributes) + ~loc:(this # location pmd_loc) + + method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this # module_type) pmtd_type) + ~attrs:(this # attributes pmtd_attributes) + ~loc:(this # location pmtd_loc) + + method module_binding {pmb_name; pmb_expr; pmb_attributes; pmb_loc} = + Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr) + ~attrs:(this # attributes pmb_attributes) + ~loc:(this # location pmb_loc) + + method value_binding {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} = + Vb.mk + (this # pat pvb_pat) + (this # expr pvb_expr) + ~attrs:(this # attributes pvb_attributes) + ~loc:(this # location pvb_loc) + + method constructor_arguments = function + | Pcstr_tuple (tys) -> Pcstr_tuple (List.map (this # typ) tys) + | Pcstr_record (ls) -> Pcstr_record (List.map (this # label_declaration) ls) + + method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; + pcd_attributes} = + Type.constructor + (map_loc this pcd_name) + ~args:(this # constructor_arguments pcd_args) + ?res:(map_opt (this # typ) pcd_res) + ~loc:(this # location pcd_loc) + ~attrs:(this # attributes pcd_attributes) + + method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; + pld_attributes} = + Type.field + (map_loc this pld_name) + (this # typ pld_type) + ~mut:pld_mutable + ~loc:(this # location pld_loc) + ~attrs:(this # attributes pld_attributes) + + + method cases l = List.map (this # case) l + method case {pc_lhs; pc_guard; pc_rhs} = + { + pc_lhs = this # pat pc_lhs; + pc_guard = map_opt (this # expr) pc_guard; + pc_rhs = this # expr pc_rhs; + } + + method open_description + {popen_lid; popen_override; popen_attributes; popen_loc} = + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this # location popen_loc) + ~attrs:(this # attributes popen_attributes) + + method include_description + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_type pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method include_declaration + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_expr pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method location l = l + + method extension (s, e) = (map_loc this s, this # payload e) + method attribute (s, e) = (map_loc this s, this # payload e) + method attributes l = List.map (this # attribute) l + method payload = function + | PStr x -> PStr (this # structure x) + | PTyp x -> PTyp (this # typ x) + | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g) + | PSig x -> PSig (this # signature x) + end + + +let to_mapper this = + let open Ast_mapper in + { + attribute = (fun _ -> this # attribute); + attributes = (fun _ -> this # attributes); + case = (fun _ -> this # case); + cases = (fun _ -> this # cases); + class_declaration = (fun _ -> this # class_declaration); + class_description = (fun _ -> this # class_description); + class_expr = (fun _ -> this # class_expr); + class_field = (fun _ -> this # class_field); + class_signature = (fun _ -> this # class_signature); + class_structure = (fun _ -> this # class_structure); + class_type = (fun _ -> this # class_type); + class_type_declaration = (fun _ -> this # class_type_declaration); + class_type_field = (fun _ -> this # class_type_field); + constructor_declaration = (fun _ -> this # constructor_declaration); + expr = (fun _ -> this # expr); + extension = (fun _ -> this # extension); + extension_constructor = (fun _ -> this # extension_constructor); + include_declaration = (fun _ -> this # include_declaration); + include_description = (fun _ -> this # include_description); + label_declaration = (fun _ -> this # label_declaration); + location = (fun _ -> this # location); + module_binding = (fun _ -> this # module_binding); + module_declaration = (fun _ -> this # module_declaration); + module_expr = (fun _ -> this # module_expr); + module_type = (fun _ -> this # module_type); + module_type_declaration = (fun _ -> this # module_type_declaration); + open_description = (fun _ -> this # open_description); + pat = (fun _ -> this # pat); + payload = (fun _ -> this # payload); + signature = (fun _ -> this # signature); + signature_item = (fun _ -> this # signature_item); + structure = (fun _ -> this # structure); + structure_item = (fun _ -> this # structure_item); + typ = (fun _ -> this # typ); + type_declaration = (fun _ -> this # type_declaration); + type_extension = (fun _ -> this # type_extension); + type_kind = (fun _ -> this # type_kind); + value_binding = (fun _ -> this # value_binding); + value_description = (fun _ -> this # value_description); + with_constraint = (fun _ -> this # with_constraint); + } diff --git a/ast_mapper_class_403.mli b/ast_mapper_class_403.mli new file mode 100644 index 0000000..9672290 --- /dev/null +++ b/ast_mapper_class_403.mli @@ -0,0 +1,58 @@ +open Ast_403 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree + +class mapper: + object + method attribute: attribute -> attribute + method attributes: attribute list -> attribute list + method case: case -> case + method cases: case list -> case list + method class_declaration: class_declaration -> class_declaration + method class_description: class_description -> class_description + method class_expr: class_expr -> class_expr + method class_field: class_field -> class_field + method class_signature: class_signature -> class_signature + method class_structure: class_structure -> class_structure + method class_type: class_type -> class_type + method class_type_declaration: class_type_declaration -> class_type_declaration + method class_type_field: class_type_field -> class_type_field + method constructor_arguments: constructor_arguments -> constructor_arguments + method constructor_declaration: constructor_declaration -> constructor_declaration + method expr: expression -> expression + method extension: extension -> extension + method extension_constructor: extension_constructor -> extension_constructor + method include_declaration: include_declaration -> include_declaration + method include_description: include_description -> include_description + method label_declaration: label_declaration -> label_declaration + method location: Location.t -> Location.t + method module_binding: module_binding -> module_binding + method module_declaration: module_declaration -> module_declaration + method module_expr: module_expr -> module_expr + method module_type: module_type -> module_type + method module_type_declaration: module_type_declaration -> module_type_declaration + method open_description: open_description -> open_description + method pat: pattern -> pattern + method payload: payload -> payload + method signature: signature -> signature + method signature_item: signature_item -> signature_item + method structure: structure -> structure + method structure_item: structure_item -> structure_item + method typ: core_type -> core_type + method type_declaration: type_declaration -> type_declaration + method type_extension: type_extension -> type_extension + method type_kind: type_kind -> type_kind + method value_binding: value_binding -> value_binding + method value_description: value_description -> value_description + method with_constraint: with_constraint -> with_constraint + end + +val to_mapper: #mapper -> Ast_mapper.mapper +(** The resulting mapper is "closed", i.e. methods ignore + their first argument. *) diff --git a/ast_mapper_class_404.ml b/ast_mapper_class_404.ml new file mode 100644 index 0000000..3d0ab18 --- /dev/null +++ b/ast_mapper_class_404.ml @@ -0,0 +1,586 @@ +open Ast_404 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree +open Asttypes +open Ast_helper + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub # location loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub # attributes attrs, b, List.map (sub # typ) tl) + | Rinherit t -> Rinherit (sub # typ t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub # attributes a, sub # typ t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub # typ)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub # typ)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) + ptype_cstrs) + ~kind:(sub # type_kind ptype_kind) + ?manifest:(map_opt (sub # typ) ptype_manifest) + ~loc:(sub # location ptype_loc) + ~attrs:(sub # attributes ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub # constructor_declaration) l) + | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub # extension_constructor) ptyext_constructors) + ~params:(List.map (map_fst (sub # typ)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub # attributes ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(sub # constructor_arguments ctl, map_opt (sub # typ) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub # location pext_loc) + ~attrs:(sub # attributes pext_attributes) + + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub # location loc in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub # typ t) (sub # class_type ct) + | Pcty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub # location loc in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pctf_attribute x -> attribute ~loc (sub # attribute x) + | Pctf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub # typ pcsig_self) + (List.map (sub # class_type_field) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (map_opt (sub # module_type) mt1) + (sub # module_type mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub # module_type mt) + (List.map (sub # with_constraint) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me) + | Pmty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub # type_declaration d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub # location loc in + match desc with + | Psig_value vd -> value ~loc (sub # value_description vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Psig_typext te -> type_extension ~loc (sub # type_extension te) + | Psig_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Psig_module x -> module_ ~loc (sub # module_declaration x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub # module_declaration) l) + | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Psig_open od -> open_ ~loc (sub # open_description od) + | Psig_include x -> include_ ~loc (sub # include_description x) + | Psig_class l -> class_ ~loc (List.map (sub # class_description) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Psig_attribute x -> attribute ~loc (sub # attribute x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub # structure str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (map_opt (sub # module_type) arg_ty) + (sub # module_expr body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e) + | Pmod_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub # location loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs) + | Pstr_primitive vd -> primitive ~loc (sub # value_description vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Pstr_typext te -> type_extension ~loc (sub # type_extension te) + | Pstr_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Pstr_module x -> module_ ~loc (sub # module_binding x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) + | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Pstr_open od -> open_ ~loc (sub # open_description od) + | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Pstr_include x -> include_ ~loc (sub # include_declaration x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Pstr_attribute x -> attribute ~loc (sub # attribute x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) + (sub # expr e) + | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l) + | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub # expr) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) + (map_opt (sub # expr) eo) + | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) + (map_opt (sub # expr) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub # pat p) (sub # expr e1) (sub # expr e2) d + (sub # expr e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) + (sub # typ t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub # expr e) (sub # typ t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub # expr)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) + (sub # expr e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub # extension_constructor cd) + (sub # expr e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e) + | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e) + | Pexp_extension x -> extension ~loc ~attrs (sub # extension x) + | Pexp_unreachable -> unreachable ~loc ~attrs () +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) + cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub # pat p) (sub # typ t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) + | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) + | Ppat_open (l, p) -> open_ ~loc ~attrs (map_loc sub l) (sub # pat p) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub # location loc in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub # class_structure s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub # expr) e) + (sub # pat p) + (sub # class_expr ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub # class_expr ce) + (List.map (map_snd (sub # expr)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) + (sub # class_expr ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct) + | Pcl_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e) + | Cfk_virtual t -> Cfk_virtual (sub # typ t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub # location loc in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e) + | Pcf_attribute x -> attribute ~loc (sub # attribute x) + | Pcf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub # pat pcstr_self; + pcstr_fields = List.map (sub # class_field) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub # typ)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub # location pci_loc) + ~attrs:(sub # attributes pci_attributes) +end + +(* Now, a generic AST mapper class, to be extended to cover all kinds + and cases of the OCaml grammar. The default behavior of the mapper + is the identity. *) + +class mapper = + object(this) + method structure l = List.map (this # structure_item) l + method structure_item si = M.map_structure_item this si + method module_expr = M.map this + + method signature l = List.map (this # signature_item) l + method signature_item si = MT.map_signature_item this si + method module_type = MT.map this + method with_constraint c = MT.map_with_constraint this c + + method class_declaration = CE.class_infos this (this # class_expr) + method class_expr = CE.map this + method class_field = CE.map_field this + method class_structure = CE.map_structure this + + method class_type = CT.map this + method class_type_field = CT.map_field this + method class_signature = CT.map_signature this + + method class_type_declaration = CE.class_infos this (this # class_type) + method class_description = CE.class_infos this (this # class_type) + + method type_declaration = T.map_type_declaration this + method type_kind = T.map_type_kind this + method typ = T.map this + + method type_extension = T.map_type_extension this + method extension_constructor = T.map_extension_constructor this + + method value_description {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} = + Val.mk + (map_loc this pval_name) + (this # typ pval_type) + ~attrs:(this # attributes pval_attributes) + ~loc:(this # location pval_loc) + ~prim:pval_prim + + method pat = P.map this + method expr = E.map this + + method module_declaration {pmd_name; pmd_type; pmd_attributes; pmd_loc} = + Md.mk + (map_loc this pmd_name) + (this # module_type pmd_type) + ~attrs:(this # attributes pmd_attributes) + ~loc:(this # location pmd_loc) + + method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this # module_type) pmtd_type) + ~attrs:(this # attributes pmtd_attributes) + ~loc:(this # location pmtd_loc) + + method module_binding {pmb_name; pmb_expr; pmb_attributes; pmb_loc} = + Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr) + ~attrs:(this # attributes pmb_attributes) + ~loc:(this # location pmb_loc) + + method value_binding {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} = + Vb.mk + (this # pat pvb_pat) + (this # expr pvb_expr) + ~attrs:(this # attributes pvb_attributes) + ~loc:(this # location pvb_loc) + + method constructor_arguments = function + | Pcstr_tuple (tys) -> Pcstr_tuple (List.map (this # typ) tys) + | Pcstr_record (ls) -> Pcstr_record (List.map (this # label_declaration) ls) + + method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; + pcd_attributes} = + Type.constructor + (map_loc this pcd_name) + ~args:(this # constructor_arguments pcd_args) + ?res:(map_opt (this # typ) pcd_res) + ~loc:(this # location pcd_loc) + ~attrs:(this # attributes pcd_attributes) + + method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; + pld_attributes} = + Type.field + (map_loc this pld_name) + (this # typ pld_type) + ~mut:pld_mutable + ~loc:(this # location pld_loc) + ~attrs:(this # attributes pld_attributes) + + + method cases l = List.map (this # case) l + method case {pc_lhs; pc_guard; pc_rhs} = + { + pc_lhs = this # pat pc_lhs; + pc_guard = map_opt (this # expr) pc_guard; + pc_rhs = this # expr pc_rhs; + } + + method open_description + {popen_lid; popen_override; popen_attributes; popen_loc} = + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this # location popen_loc) + ~attrs:(this # attributes popen_attributes) + + method include_description + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_type pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method include_declaration + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_expr pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method location l = l + + method extension (s, e) = (map_loc this s, this # payload e) + method attribute (s, e) = (map_loc this s, this # payload e) + method attributes l = List.map (this # attribute) l + method payload = function + | PStr x -> PStr (this # structure x) + | PTyp x -> PTyp (this # typ x) + | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g) + | PSig x -> PSig (this # signature x) + end + + +let to_mapper this = + let open Ast_mapper in + { + attribute = (fun _ -> this # attribute); + attributes = (fun _ -> this # attributes); + case = (fun _ -> this # case); + cases = (fun _ -> this # cases); + class_declaration = (fun _ -> this # class_declaration); + class_description = (fun _ -> this # class_description); + class_expr = (fun _ -> this # class_expr); + class_field = (fun _ -> this # class_field); + class_signature = (fun _ -> this # class_signature); + class_structure = (fun _ -> this # class_structure); + class_type = (fun _ -> this # class_type); + class_type_declaration = (fun _ -> this # class_type_declaration); + class_type_field = (fun _ -> this # class_type_field); + constructor_declaration = (fun _ -> this # constructor_declaration); + expr = (fun _ -> this # expr); + extension = (fun _ -> this # extension); + extension_constructor = (fun _ -> this # extension_constructor); + include_declaration = (fun _ -> this # include_declaration); + include_description = (fun _ -> this # include_description); + label_declaration = (fun _ -> this # label_declaration); + location = (fun _ -> this # location); + module_binding = (fun _ -> this # module_binding); + module_declaration = (fun _ -> this # module_declaration); + module_expr = (fun _ -> this # module_expr); + module_type = (fun _ -> this # module_type); + module_type_declaration = (fun _ -> this # module_type_declaration); + open_description = (fun _ -> this # open_description); + pat = (fun _ -> this # pat); + payload = (fun _ -> this # payload); + signature = (fun _ -> this # signature); + signature_item = (fun _ -> this # signature_item); + structure = (fun _ -> this # structure); + structure_item = (fun _ -> this # structure_item); + typ = (fun _ -> this # typ); + type_declaration = (fun _ -> this # type_declaration); + type_extension = (fun _ -> this # type_extension); + type_kind = (fun _ -> this # type_kind); + value_binding = (fun _ -> this # value_binding); + value_description = (fun _ -> this # value_description); + with_constraint = (fun _ -> this # with_constraint); + } diff --git a/ast_mapper_class_404.mli b/ast_mapper_class_404.mli new file mode 100644 index 0000000..f30a0bf --- /dev/null +++ b/ast_mapper_class_404.mli @@ -0,0 +1,58 @@ +open Ast_404 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree + +class mapper: + object + method attribute: attribute -> attribute + method attributes: attribute list -> attribute list + method case: case -> case + method cases: case list -> case list + method class_declaration: class_declaration -> class_declaration + method class_description: class_description -> class_description + method class_expr: class_expr -> class_expr + method class_field: class_field -> class_field + method class_signature: class_signature -> class_signature + method class_structure: class_structure -> class_structure + method class_type: class_type -> class_type + method class_type_declaration: class_type_declaration -> class_type_declaration + method class_type_field: class_type_field -> class_type_field + method constructor_arguments: constructor_arguments -> constructor_arguments + method constructor_declaration: constructor_declaration -> constructor_declaration + method expr: expression -> expression + method extension: extension -> extension + method extension_constructor: extension_constructor -> extension_constructor + method include_declaration: include_declaration -> include_declaration + method include_description: include_description -> include_description + method label_declaration: label_declaration -> label_declaration + method location: Location.t -> Location.t + method module_binding: module_binding -> module_binding + method module_declaration: module_declaration -> module_declaration + method module_expr: module_expr -> module_expr + method module_type: module_type -> module_type + method module_type_declaration: module_type_declaration -> module_type_declaration + method open_description: open_description -> open_description + method pat: pattern -> pattern + method payload: payload -> payload + method signature: signature -> signature + method signature_item: signature_item -> signature_item + method structure: structure -> structure + method structure_item: structure_item -> structure_item + method typ: core_type -> core_type + method type_declaration: type_declaration -> type_declaration + method type_extension: type_extension -> type_extension + method type_kind: type_kind -> type_kind + method value_binding: value_binding -> value_binding + method value_description: value_description -> value_description + method with_constraint: with_constraint -> with_constraint + end + +val to_mapper: #mapper -> Ast_mapper.mapper +(** The resulting mapper is "closed", i.e. methods ignore + their first argument. *) diff --git a/ast_mapper_class_405.ml b/ast_mapper_class_405.ml new file mode 100644 index 0000000..2947185 --- /dev/null +++ b/ast_mapper_class_405.ml @@ -0,0 +1,586 @@ +open Ast_405 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree +open Asttypes +open Ast_helper + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub # location loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub # attributes attrs, b, List.map (sub # typ) tl) + | Rinherit t -> Rinherit (sub # typ t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_object (l, o) -> + let f (s, a, t) = (s, sub # attributes a, sub # typ t) in + object_ ~loc ~attrs (List.map f l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub # typ)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub # typ)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) + ptype_cstrs) + ~kind:(sub # type_kind ptype_kind) + ?manifest:(map_opt (sub # typ) ptype_manifest) + ~loc:(sub # location ptype_loc) + ~attrs:(sub # attributes ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub # constructor_declaration) l) + | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub # extension_constructor) ptyext_constructors) + ~params:(List.map (map_fst (sub # typ)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub # attributes ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(sub # constructor_arguments ctl, map_opt (sub # typ) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub # location pext_loc) + ~attrs:(sub # attributes pext_attributes) + + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub # location loc in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub # typ t) (sub # class_type ct) + | Pcty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub # location loc in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pctf_attribute x -> attribute ~loc (sub # attribute x) + | Pctf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub # typ pcsig_self) + (List.map (sub # class_type_field) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (map_opt (sub # module_type) mt1) + (sub # module_type mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub # module_type mt) + (List.map (sub # with_constraint) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me) + | Pmty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub # type_declaration d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst d -> Pwith_typesubst (sub # type_declaration d) + | Pwith_modsubst (s, lid) -> + Pwith_modsubst (map_loc sub s, map_loc sub lid) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub # location loc in + match desc with + | Psig_value vd -> value ~loc (sub # value_description vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Psig_typext te -> type_extension ~loc (sub # type_extension te) + | Psig_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Psig_module x -> module_ ~loc (sub # module_declaration x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub # module_declaration) l) + | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Psig_open od -> open_ ~loc (sub # open_description od) + | Psig_include x -> include_ ~loc (sub # include_description x) + | Psig_class l -> class_ ~loc (List.map (sub # class_description) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Psig_attribute x -> attribute ~loc (sub # attribute x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub # structure str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (map_opt (sub # module_type) arg_ty) + (sub # module_expr body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e) + | Pmod_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub # location loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs) + | Pstr_primitive vd -> primitive ~loc (sub # value_description vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Pstr_typext te -> type_extension ~loc (sub # type_extension te) + | Pstr_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Pstr_module x -> module_ ~loc (sub # module_binding x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) + | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Pstr_open od -> open_ ~loc (sub # open_description od) + | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Pstr_include x -> include_ ~loc (sub # include_declaration x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Pstr_attribute x -> attribute ~loc (sub # attribute x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) + (sub # expr e) + | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l) + | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub # expr) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) + (map_opt (sub # expr) eo) + | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) + (map_opt (sub # expr) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub # pat p) (sub # expr e1) (sub # expr e2) d + (sub # expr e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) + (sub # typ t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub # expr e) (sub # typ t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub # expr)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) + (sub # expr e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub # extension_constructor cd) + (sub # expr e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e) + | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e) + | Pexp_extension x -> extension ~loc ~attrs (sub # extension x) + | Pexp_unreachable -> unreachable ~loc ~attrs () +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) + cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub # pat p) (sub # typ t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) + | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) + | Ppat_open (l, p) -> open_ ~loc ~attrs (map_loc sub l) (sub # pat p) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub # location loc in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub # class_structure s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub # expr) e) + (sub # pat p) + (sub # class_expr ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub # class_expr ce) + (List.map (map_snd (sub # expr)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) + (sub # class_expr ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct) + | Pcl_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e) + | Cfk_virtual t -> Cfk_virtual (sub # typ t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub # location loc in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e) + | Pcf_attribute x -> attribute ~loc (sub # attribute x) + | Pcf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub # pat pcstr_self; + pcstr_fields = List.map (sub # class_field) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub # typ)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub # location pci_loc) + ~attrs:(sub # attributes pci_attributes) +end + +(* Now, a generic AST mapper class, to be extended to cover all kinds + and cases of the OCaml grammar. The default behavior of the mapper + is the identity. *) + +class mapper = + object(this) + method structure l = List.map (this # structure_item) l + method structure_item si = M.map_structure_item this si + method module_expr = M.map this + + method signature l = List.map (this # signature_item) l + method signature_item si = MT.map_signature_item this si + method module_type = MT.map this + method with_constraint c = MT.map_with_constraint this c + + method class_declaration = CE.class_infos this (this # class_expr) + method class_expr = CE.map this + method class_field = CE.map_field this + method class_structure = CE.map_structure this + + method class_type = CT.map this + method class_type_field = CT.map_field this + method class_signature = CT.map_signature this + + method class_type_declaration = CE.class_infos this (this # class_type) + method class_description = CE.class_infos this (this # class_type) + + method type_declaration = T.map_type_declaration this + method type_kind = T.map_type_kind this + method typ = T.map this + + method type_extension = T.map_type_extension this + method extension_constructor = T.map_extension_constructor this + + method value_description {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} = + Val.mk + (map_loc this pval_name) + (this # typ pval_type) + ~attrs:(this # attributes pval_attributes) + ~loc:(this # location pval_loc) + ~prim:pval_prim + + method pat = P.map this + method expr = E.map this + + method module_declaration {pmd_name; pmd_type; pmd_attributes; pmd_loc} = + Md.mk + (map_loc this pmd_name) + (this # module_type pmd_type) + ~attrs:(this # attributes pmd_attributes) + ~loc:(this # location pmd_loc) + + method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this # module_type) pmtd_type) + ~attrs:(this # attributes pmtd_attributes) + ~loc:(this # location pmtd_loc) + + method module_binding {pmb_name; pmb_expr; pmb_attributes; pmb_loc} = + Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr) + ~attrs:(this # attributes pmb_attributes) + ~loc:(this # location pmb_loc) + + method value_binding {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} = + Vb.mk + (this # pat pvb_pat) + (this # expr pvb_expr) + ~attrs:(this # attributes pvb_attributes) + ~loc:(this # location pvb_loc) + + method constructor_arguments = function + | Pcstr_tuple (tys) -> Pcstr_tuple (List.map (this # typ) tys) + | Pcstr_record (ls) -> Pcstr_record (List.map (this # label_declaration) ls) + + method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; + pcd_attributes} = + Type.constructor + (map_loc this pcd_name) + ~args:(this # constructor_arguments pcd_args) + ?res:(map_opt (this # typ) pcd_res) + ~loc:(this # location pcd_loc) + ~attrs:(this # attributes pcd_attributes) + + method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; + pld_attributes} = + Type.field + (map_loc this pld_name) + (this # typ pld_type) + ~mut:pld_mutable + ~loc:(this # location pld_loc) + ~attrs:(this # attributes pld_attributes) + + + method cases l = List.map (this # case) l + method case {pc_lhs; pc_guard; pc_rhs} = + { + pc_lhs = this # pat pc_lhs; + pc_guard = map_opt (this # expr) pc_guard; + pc_rhs = this # expr pc_rhs; + } + + method open_description + {popen_lid; popen_override; popen_attributes; popen_loc} = + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this # location popen_loc) + ~attrs:(this # attributes popen_attributes) + + method include_description + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_type pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method include_declaration + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_expr pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method location l = l + + method extension (s, e) = (map_loc this s, this # payload e) + method attribute (s, e) = (map_loc this s, this # payload e) + method attributes l = List.map (this # attribute) l + method payload = function + | PStr x -> PStr (this # structure x) + | PTyp x -> PTyp (this # typ x) + | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g) + | PSig x -> PSig (this # signature x) + end + + +let to_mapper this = + let open Ast_mapper in + { + attribute = (fun _ -> this # attribute); + attributes = (fun _ -> this # attributes); + case = (fun _ -> this # case); + cases = (fun _ -> this # cases); + class_declaration = (fun _ -> this # class_declaration); + class_description = (fun _ -> this # class_description); + class_expr = (fun _ -> this # class_expr); + class_field = (fun _ -> this # class_field); + class_signature = (fun _ -> this # class_signature); + class_structure = (fun _ -> this # class_structure); + class_type = (fun _ -> this # class_type); + class_type_declaration = (fun _ -> this # class_type_declaration); + class_type_field = (fun _ -> this # class_type_field); + constructor_declaration = (fun _ -> this # constructor_declaration); + expr = (fun _ -> this # expr); + extension = (fun _ -> this # extension); + extension_constructor = (fun _ -> this # extension_constructor); + include_declaration = (fun _ -> this # include_declaration); + include_description = (fun _ -> this # include_description); + label_declaration = (fun _ -> this # label_declaration); + location = (fun _ -> this # location); + module_binding = (fun _ -> this # module_binding); + module_declaration = (fun _ -> this # module_declaration); + module_expr = (fun _ -> this # module_expr); + module_type = (fun _ -> this # module_type); + module_type_declaration = (fun _ -> this # module_type_declaration); + open_description = (fun _ -> this # open_description); + pat = (fun _ -> this # pat); + payload = (fun _ -> this # payload); + signature = (fun _ -> this # signature); + signature_item = (fun _ -> this # signature_item); + structure = (fun _ -> this # structure); + structure_item = (fun _ -> this # structure_item); + typ = (fun _ -> this # typ); + type_declaration = (fun _ -> this # type_declaration); + type_extension = (fun _ -> this # type_extension); + type_kind = (fun _ -> this # type_kind); + value_binding = (fun _ -> this # value_binding); + value_description = (fun _ -> this # value_description); + with_constraint = (fun _ -> this # with_constraint); + } diff --git a/ast_mapper_class_405.mli b/ast_mapper_class_405.mli new file mode 100644 index 0000000..5285a9b --- /dev/null +++ b/ast_mapper_class_405.mli @@ -0,0 +1,58 @@ +open Ast_405 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree + +class mapper: + object + method attribute: attribute -> attribute + method attributes: attribute list -> attribute list + method case: case -> case + method cases: case list -> case list + method class_declaration: class_declaration -> class_declaration + method class_description: class_description -> class_description + method class_expr: class_expr -> class_expr + method class_field: class_field -> class_field + method class_signature: class_signature -> class_signature + method class_structure: class_structure -> class_structure + method class_type: class_type -> class_type + method class_type_declaration: class_type_declaration -> class_type_declaration + method class_type_field: class_type_field -> class_type_field + method constructor_arguments: constructor_arguments -> constructor_arguments + method constructor_declaration: constructor_declaration -> constructor_declaration + method expr: expression -> expression + method extension: extension -> extension + method extension_constructor: extension_constructor -> extension_constructor + method include_declaration: include_declaration -> include_declaration + method include_description: include_description -> include_description + method label_declaration: label_declaration -> label_declaration + method location: Location.t -> Location.t + method module_binding: module_binding -> module_binding + method module_declaration: module_declaration -> module_declaration + method module_expr: module_expr -> module_expr + method module_type: module_type -> module_type + method module_type_declaration: module_type_declaration -> module_type_declaration + method open_description: open_description -> open_description + method pat: pattern -> pattern + method payload: payload -> payload + method signature: signature -> signature + method signature_item: signature_item -> signature_item + method structure: structure -> structure + method structure_item: structure_item -> structure_item + method typ: core_type -> core_type + method type_declaration: type_declaration -> type_declaration + method type_extension: type_extension -> type_extension + method type_kind: type_kind -> type_kind + method value_binding: value_binding -> value_binding + method value_description: value_description -> value_description + method with_constraint: with_constraint -> with_constraint + end + +val to_mapper: #mapper -> Ast_mapper.mapper +(** The resulting mapper is "closed", i.e. methods ignore + their first argument. *) diff --git a/ast_mapper_class_406.ml b/ast_mapper_class_406.ml new file mode 100644 index 0000000..4d4522e --- /dev/null +++ b/ast_mapper_class_406.ml @@ -0,0 +1,594 @@ +open Ast_406 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree +open Asttypes +open Ast_helper + +let map_fst f (x, y) = (f x, y) +let map_snd f (x, y) = (x, f y) +let map_tuple f1 f2 (x, y) = (f1 x, f2 y) +let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) +let map_opt f = function None -> None | Some x -> Some (f x) + +let map_loc sub {loc; txt} = {loc = sub # location loc; txt} + +module T = struct + (* Type expressions for the core language *) + + let row_field sub = function + | Rtag (l, attrs, b, tl) -> + Rtag (l, sub # attributes attrs, b, List.map (sub # typ) tl) + | Rinherit t -> Rinherit (sub # typ t) + + let object_field sub = function + | Otag (s, a, t) -> Otag (s, sub # attributes a, sub # typ t) + | Oinherit t -> Oinherit (sub # typ t) + + let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = + let open Typ in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ptyp_any -> any ~loc ~attrs () + | Ptyp_var s -> var ~loc ~attrs s + | Ptyp_arrow (lab, t1, t2) -> + arrow ~loc ~attrs lab (sub # typ t1) (sub # typ t2) + | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub # typ) tyl) + | Ptyp_constr (lid, tl) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_object (l, o) -> + object_ ~loc ~attrs (List.map (object_field sub) l) o + | Ptyp_class (lid, tl) -> + class_ ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tl) + | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub # typ t) s + | Ptyp_variant (rl, b, ll) -> + variant ~loc ~attrs (List.map (row_field sub) rl) b ll + | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub # typ t) + | Ptyp_package (lid, l) -> + package ~loc ~attrs (map_loc sub lid) + (List.map (map_tuple (map_loc sub) (sub # typ)) l) + | Ptyp_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_type_declaration sub + {ptype_name; ptype_params; ptype_cstrs; + ptype_kind; + ptype_private; + ptype_manifest; + ptype_attributes; + ptype_loc} = + Type.mk (map_loc sub ptype_name) + ~params:(List.map (map_fst (sub # typ)) ptype_params) + ~priv:ptype_private + ~cstrs:(List.map (map_tuple3 (sub # typ) (sub # typ) (sub # location)) + ptype_cstrs) + ~kind:(sub # type_kind ptype_kind) + ?manifest:(map_opt (sub # typ) ptype_manifest) + ~loc:(sub # location ptype_loc) + ~attrs:(sub # attributes ptype_attributes) + + let map_type_kind sub = function + | Ptype_abstract -> Ptype_abstract + | Ptype_variant l -> + Ptype_variant (List.map (sub # constructor_declaration) l) + | Ptype_record l -> Ptype_record (List.map (sub # label_declaration) l) + | Ptype_open -> Ptype_open + + let map_type_extension sub + {ptyext_path; ptyext_params; + ptyext_constructors; + ptyext_private; + ptyext_attributes} = + Te.mk + (map_loc sub ptyext_path) + (List.map (sub # extension_constructor) ptyext_constructors) + ~params:(List.map (map_fst (sub # typ)) ptyext_params) + ~priv:ptyext_private + ~attrs:(sub # attributes ptyext_attributes) + + let map_extension_constructor_kind sub = function + Pext_decl(ctl, cto) -> + Pext_decl(sub # constructor_arguments ctl, map_opt (sub # typ) cto) + | Pext_rebind li -> + Pext_rebind (map_loc sub li) + + let map_extension_constructor sub + {pext_name; + pext_kind; + pext_loc; + pext_attributes} = + Te.constructor + (map_loc sub pext_name) + (map_extension_constructor_kind sub pext_kind) + ~loc:(sub # location pext_loc) + ~attrs:(sub # attributes pext_attributes) + + +end + +module CT = struct + (* Type expressions for the class language *) + + let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = + let open Cty in + let loc = sub # location loc in + match desc with + | Pcty_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcty_signature x -> signature ~loc ~attrs (sub # class_signature x) + | Pcty_arrow (lab, t, ct) -> + arrow ~loc ~attrs lab (sub # typ t) (sub # class_type ct) + | Pcty_extension x -> extension ~loc ~attrs (sub # extension x) + | Pcty_open (ovf, lid, ct) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # class_type ct) + + let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} + = + let open Ctf in + let loc = sub # location loc in + match desc with + | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub # class_type ct) + | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub # typ t) + | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub # typ t) + | Pctf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pctf_attribute x -> attribute ~loc (sub # attribute x) + | Pctf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_signature sub {pcsig_self; pcsig_fields} = + Csig.mk + (sub # typ pcsig_self) + (List.map (sub # class_type_field) pcsig_fields) +end + +module MT = struct + (* Type expressions for the module language *) + + let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = + let open Mty in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) + | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) + | Pmty_signature sg -> signature ~loc ~attrs (sub # signature sg) + | Pmty_functor (s, mt1, mt2) -> + functor_ ~loc ~attrs (map_loc sub s) + (map_opt (sub # module_type) mt1) + (sub # module_type mt2) + | Pmty_with (mt, l) -> + with_ ~loc ~attrs (sub # module_type mt) + (List.map (sub # with_constraint) l) + | Pmty_typeof me -> typeof_ ~loc ~attrs (sub # module_expr me) + | Pmty_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_with_constraint sub = function + | Pwith_type (lid, d) -> + Pwith_type (map_loc sub lid, sub # type_declaration d) + | Pwith_module (lid, lid2) -> + Pwith_module (map_loc sub lid, map_loc sub lid2) + | Pwith_typesubst (lid, d) -> + Pwith_typesubst (map_loc sub lid, sub # type_declaration d) + | Pwith_modsubst (lid, lid2) -> + Pwith_modsubst (map_loc sub lid, map_loc sub lid2) + + let map_signature_item sub {psig_desc = desc; psig_loc = loc} = + let open Sig in + let loc = sub # location loc in + match desc with + | Psig_value vd -> value ~loc (sub # value_description vd) + | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Psig_typext te -> type_extension ~loc (sub # type_extension te) + | Psig_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Psig_module x -> module_ ~loc (sub # module_declaration x) + | Psig_recmodule l -> + rec_module ~loc (List.map (sub # module_declaration) l) + | Psig_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Psig_open od -> open_ ~loc (sub # open_description od) + | Psig_include x -> include_ ~loc (sub # include_description x) + | Psig_class l -> class_ ~loc (List.map (sub # class_description) l) + | Psig_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Psig_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Psig_attribute x -> attribute ~loc (sub # attribute x) +end + + +module M = struct + (* Value expressions for the module language *) + + let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = + let open Mod in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pmod_structure str -> structure ~loc ~attrs (sub # structure str) + | Pmod_functor (arg, arg_ty, body) -> + functor_ ~loc ~attrs (map_loc sub arg) + (map_opt (sub # module_type) arg_ty) + (sub # module_expr body) + | Pmod_apply (m1, m2) -> + apply ~loc ~attrs (sub # module_expr m1) (sub # module_expr m2) + | Pmod_constraint (m, mty) -> + constraint_ ~loc ~attrs (sub # module_expr m) (sub # module_type mty) + | Pmod_unpack e -> unpack ~loc ~attrs (sub # expr e) + | Pmod_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = + let open Str in + let loc = sub # location loc in + match desc with + | Pstr_eval (x, attrs) -> + eval ~loc ~attrs:(sub # attributes attrs) (sub # expr x) + | Pstr_value (r, vbs) -> value ~loc r (List.map (sub # value_binding) vbs) + | Pstr_primitive vd -> primitive ~loc (sub # value_description vd) + | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub # type_declaration) l) + | Pstr_typext te -> type_extension ~loc (sub # type_extension te) + | Pstr_exception ed -> exception_ ~loc (sub # extension_constructor ed) + | Pstr_module x -> module_ ~loc (sub # module_binding x) + | Pstr_recmodule l -> rec_module ~loc (List.map (sub # module_binding) l) + | Pstr_modtype x -> modtype ~loc (sub # module_type_declaration x) + | Pstr_open od -> open_ ~loc (sub # open_description od) + | Pstr_class l -> class_ ~loc (List.map (sub # class_declaration) l) + | Pstr_class_type l -> + class_type ~loc (List.map (sub # class_type_declaration) l) + | Pstr_include x -> include_ ~loc (sub # include_declaration x) + | Pstr_extension (x, attrs) -> + extension ~loc (sub # extension x) ~attrs:(sub # attributes attrs) + | Pstr_attribute x -> attribute ~loc (sub # attribute x) +end + +module E = struct + (* Value expressions for the core language *) + + let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = + let open Exp in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant x -> constant ~loc ~attrs x + | Pexp_let (r, vbs, e) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) (sub # expr e) + | Pexp_fun (lab, def, p, e) -> + fun_ ~loc ~attrs lab (map_opt (sub # expr) def) (sub # pat p) + (sub # expr e) + | Pexp_function pel -> function_ ~loc ~attrs (sub # cases pel) + | Pexp_apply (e, l) -> + apply ~loc ~attrs (sub # expr e) (List.map (map_snd (sub # expr)) l) + | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub # expr e) (sub # cases pel) + | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub # expr) el) + | Pexp_construct (lid, arg) -> + construct ~loc ~attrs (map_loc sub lid) (map_opt (sub # expr) arg) + | Pexp_variant (lab, eo) -> + variant ~loc ~attrs lab (map_opt (sub # expr) eo) + | Pexp_record (l, eo) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # expr)) l) + (map_opt (sub # expr) eo) + | Pexp_field (e, lid) -> field ~loc ~attrs (sub # expr e) (map_loc sub lid) + | Pexp_setfield (e1, lid, e2) -> + setfield ~loc ~attrs (sub # expr e1) (map_loc sub lid) (sub # expr e2) + | Pexp_array el -> array ~loc ~attrs (List.map (sub # expr) el) + | Pexp_ifthenelse (e1, e2, e3) -> + ifthenelse ~loc ~attrs (sub # expr e1) (sub # expr e2) + (map_opt (sub # expr) e3) + | Pexp_sequence (e1, e2) -> + sequence ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub # expr e1) (sub # expr e2) + | Pexp_for (p, e1, e2, d, e3) -> + for_ ~loc ~attrs (sub # pat p) (sub # expr e1) (sub # expr e2) d + (sub # expr e3) + | Pexp_coerce (e, t1, t2) -> + coerce ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t1) + (sub # typ t2) + | Pexp_constraint (e, t) -> + constraint_ ~loc ~attrs (sub # expr e) (sub # typ t) + | Pexp_send (e, s) -> send ~loc ~attrs (sub # expr e) s + | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) + | Pexp_setinstvar (s, e) -> + setinstvar ~loc ~attrs (map_loc sub s) (sub # expr e) + | Pexp_override sel -> + override ~loc ~attrs + (List.map (map_tuple (map_loc sub) (sub # expr)) sel) + | Pexp_letmodule (s, me, e) -> + letmodule ~loc ~attrs (map_loc sub s) (sub # module_expr me) + (sub # expr e) + | Pexp_letexception (cd, e) -> + letexception ~loc ~attrs + (sub # extension_constructor cd) + (sub # expr e) + | Pexp_assert e -> assert_ ~loc ~attrs (sub # expr e) + | Pexp_lazy e -> lazy_ ~loc ~attrs (sub # expr e) + | Pexp_poly (e, t) -> + poly ~loc ~attrs (sub # expr e) (map_opt (sub # typ) t) + | Pexp_object cls -> object_ ~loc ~attrs (sub # class_structure cls) + | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub # expr e) + | Pexp_pack me -> pack ~loc ~attrs (sub # module_expr me) + | Pexp_open (ovf, lid, e) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # expr e) + | Pexp_extension x -> extension ~loc ~attrs (sub # extension x) + | Pexp_unreachable -> unreachable ~loc ~attrs () +end + +module P = struct + (* Patterns *) + + let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = + let open Pat in + let loc = sub # location loc in + let attrs = sub # attributes attrs in + match desc with + | Ppat_any -> any ~loc ~attrs () + | Ppat_var s -> var ~loc ~attrs (map_loc sub s) + | Ppat_alias (p, s) -> alias ~loc ~attrs (sub # pat p) (map_loc sub s) + | Ppat_constant c -> constant ~loc ~attrs c + | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 + | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_construct (l, p) -> + construct ~loc ~attrs (map_loc sub l) (map_opt (sub # pat) p) + | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub # pat) p) + | Ppat_record (lpl, cf) -> + record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub # pat)) lpl) + cf + | Ppat_array pl -> array ~loc ~attrs (List.map (sub # pat) pl) + | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub # pat p1) (sub # pat p2) + | Ppat_constraint (p, t) -> + constraint_ ~loc ~attrs (sub # pat p) (sub # typ t) + | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) + | Ppat_lazy p -> lazy_ ~loc ~attrs (sub # pat p) + | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) + | Ppat_exception p -> exception_ ~loc ~attrs (sub # pat p) + | Ppat_extension x -> extension ~loc ~attrs (sub # extension x) + | Ppat_open (l, p) -> open_ ~loc ~attrs (map_loc sub l) (sub # pat p) +end + +module CE = struct + (* Value expressions for the class language *) + + let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = + let open Cl in + let loc = sub # location loc in + match desc with + | Pcl_constr (lid, tys) -> + constr ~loc ~attrs (map_loc sub lid) (List.map (sub # typ) tys) + | Pcl_structure s -> + structure ~loc ~attrs (sub # class_structure s) + | Pcl_fun (lab, e, p, ce) -> + fun_ ~loc ~attrs lab + (map_opt (sub # expr) e) + (sub # pat p) + (sub # class_expr ce) + | Pcl_apply (ce, l) -> + apply ~loc ~attrs (sub # class_expr ce) + (List.map (map_snd (sub # expr)) l) + | Pcl_let (r, vbs, ce) -> + let_ ~loc ~attrs r (List.map (sub # value_binding) vbs) + (sub # class_expr ce) + | Pcl_constraint (ce, ct) -> + constraint_ ~loc ~attrs (sub # class_expr ce) (sub # class_type ct) + | Pcl_extension x -> extension ~loc ~attrs (sub # extension x) + | Pcl_open (ovf, lid, ce) -> + open_ ~loc ~attrs ovf (map_loc sub lid) (sub # class_expr ce) + + let map_kind sub = function + | Cfk_concrete (o, e) -> Cfk_concrete (o, sub # expr e) + | Cfk_virtual t -> Cfk_virtual (sub # typ t) + + let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = + let open Cf in + let loc = sub # location loc in + match desc with + | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub # class_expr ce) s + | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) + | Pcf_method (s, p, k) -> + method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) + | Pcf_constraint (t1, t2) -> + constraint_ ~loc ~attrs (sub # typ t1) (sub # typ t2) + | Pcf_initializer e -> initializer_ ~loc ~attrs (sub # expr e) + | Pcf_attribute x -> attribute ~loc (sub # attribute x) + | Pcf_extension x -> extension ~loc ~attrs (sub # extension x) + + let map_structure sub {pcstr_self; pcstr_fields} = + { + pcstr_self = sub # pat pcstr_self; + pcstr_fields = List.map (sub # class_field) pcstr_fields; + } + + let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; + pci_loc; pci_attributes} = + Ci.mk + ~virt:pci_virt + ~params:(List.map (map_fst (sub # typ)) pl) + (map_loc sub pci_name) + (f pci_expr) + ~loc:(sub # location pci_loc) + ~attrs:(sub # attributes pci_attributes) +end + +(* Now, a generic AST mapper class, to be extended to cover all kinds + and cases of the OCaml grammar. The default behavior of the mapper + is the identity. *) + +class mapper = + object(this) + method structure l = List.map (this # structure_item) l + method structure_item si = M.map_structure_item this si + method module_expr = M.map this + + method signature l = List.map (this # signature_item) l + method signature_item si = MT.map_signature_item this si + method module_type = MT.map this + method with_constraint c = MT.map_with_constraint this c + + method class_declaration = CE.class_infos this (this # class_expr) + method class_expr = CE.map this + method class_field = CE.map_field this + method class_structure = CE.map_structure this + + method class_type = CT.map this + method class_type_field = CT.map_field this + method class_signature = CT.map_signature this + + method class_type_declaration = CE.class_infos this (this # class_type) + method class_description = CE.class_infos this (this # class_type) + + method type_declaration = T.map_type_declaration this + method type_kind = T.map_type_kind this + method typ = T.map this + + method type_extension = T.map_type_extension this + method extension_constructor = T.map_extension_constructor this + + method value_description {pval_name; pval_type; pval_prim; pval_loc; + pval_attributes} = + Val.mk + (map_loc this pval_name) + (this # typ pval_type) + ~attrs:(this # attributes pval_attributes) + ~loc:(this # location pval_loc) + ~prim:pval_prim + + method pat = P.map this + method expr = E.map this + + method module_declaration {pmd_name; pmd_type; pmd_attributes; pmd_loc} = + Md.mk + (map_loc this pmd_name) + (this # module_type pmd_type) + ~attrs:(this # attributes pmd_attributes) + ~loc:(this # location pmd_loc) + + method module_type_declaration {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} = + Mtd.mk + (map_loc this pmtd_name) + ?typ:(map_opt (this # module_type) pmtd_type) + ~attrs:(this # attributes pmtd_attributes) + ~loc:(this # location pmtd_loc) + + method module_binding {pmb_name; pmb_expr; pmb_attributes; pmb_loc} = + Mb.mk (map_loc this pmb_name) (this # module_expr pmb_expr) + ~attrs:(this # attributes pmb_attributes) + ~loc:(this # location pmb_loc) + + method value_binding {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} = + Vb.mk + (this # pat pvb_pat) + (this # expr pvb_expr) + ~attrs:(this # attributes pvb_attributes) + ~loc:(this # location pvb_loc) + + method constructor_arguments = function + | Pcstr_tuple (tys) -> Pcstr_tuple (List.map (this # typ) tys) + | Pcstr_record (ls) -> Pcstr_record (List.map (this # label_declaration) ls) + + method constructor_declaration {pcd_name; pcd_args; pcd_res; pcd_loc; + pcd_attributes} = + Type.constructor + (map_loc this pcd_name) + ~args:(this # constructor_arguments pcd_args) + ?res:(map_opt (this # typ) pcd_res) + ~loc:(this # location pcd_loc) + ~attrs:(this # attributes pcd_attributes) + + method label_declaration {pld_name; pld_type; pld_loc; pld_mutable; + pld_attributes} = + Type.field + (map_loc this pld_name) + (this # typ pld_type) + ~mut:pld_mutable + ~loc:(this # location pld_loc) + ~attrs:(this # attributes pld_attributes) + + + method cases l = List.map (this # case) l + method case {pc_lhs; pc_guard; pc_rhs} = + { + pc_lhs = this # pat pc_lhs; + pc_guard = map_opt (this # expr) pc_guard; + pc_rhs = this # expr pc_rhs; + } + + method open_description + {popen_lid; popen_override; popen_attributes; popen_loc} = + Opn.mk (map_loc this popen_lid) + ~override:popen_override + ~loc:(this # location popen_loc) + ~attrs:(this # attributes popen_attributes) + + method include_description + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_type pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method include_declaration + {pincl_mod; pincl_attributes; pincl_loc} = + Incl.mk (this # module_expr pincl_mod) + ~loc:(this # location pincl_loc) + ~attrs:(this # attributes pincl_attributes) + + method location l = l + + method extension (s, e) = (map_loc this s, this # payload e) + method attribute (s, e) = (map_loc this s, this # payload e) + method attributes l = List.map (this # attribute) l + method payload = function + | PStr x -> PStr (this # structure x) + | PTyp x -> PTyp (this # typ x) + | PPat (x, g) -> PPat (this # pat x, map_opt (this # expr) g) + | PSig x -> PSig (this # signature x) + end + + +let to_mapper this = + let open Ast_mapper in + { + attribute = (fun _ -> this # attribute); + attributes = (fun _ -> this # attributes); + case = (fun _ -> this # case); + cases = (fun _ -> this # cases); + class_declaration = (fun _ -> this # class_declaration); + class_description = (fun _ -> this # class_description); + class_expr = (fun _ -> this # class_expr); + class_field = (fun _ -> this # class_field); + class_signature = (fun _ -> this # class_signature); + class_structure = (fun _ -> this # class_structure); + class_type = (fun _ -> this # class_type); + class_type_declaration = (fun _ -> this # class_type_declaration); + class_type_field = (fun _ -> this # class_type_field); + constructor_declaration = (fun _ -> this # constructor_declaration); + expr = (fun _ -> this # expr); + extension = (fun _ -> this # extension); + extension_constructor = (fun _ -> this # extension_constructor); + include_declaration = (fun _ -> this # include_declaration); + include_description = (fun _ -> this # include_description); + label_declaration = (fun _ -> this # label_declaration); + location = (fun _ -> this # location); + module_binding = (fun _ -> this # module_binding); + module_declaration = (fun _ -> this # module_declaration); + module_expr = (fun _ -> this # module_expr); + module_type = (fun _ -> this # module_type); + module_type_declaration = (fun _ -> this # module_type_declaration); + open_description = (fun _ -> this # open_description); + pat = (fun _ -> this # pat); + payload = (fun _ -> this # payload); + signature = (fun _ -> this # signature); + signature_item = (fun _ -> this # signature_item); + structure = (fun _ -> this # structure); + structure_item = (fun _ -> this # structure_item); + typ = (fun _ -> this # typ); + type_declaration = (fun _ -> this # type_declaration); + type_extension = (fun _ -> this # type_extension); + type_kind = (fun _ -> this # type_kind); + value_binding = (fun _ -> this # value_binding); + value_description = (fun _ -> this # value_description); + with_constraint = (fun _ -> this # with_constraint); + } diff --git a/ast_mapper_class_406.mli b/ast_mapper_class_406.mli new file mode 100644 index 0000000..08e1849 --- /dev/null +++ b/ast_mapper_class_406.mli @@ -0,0 +1,58 @@ +open Ast_406 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(** Class-based customizable mapper *) + +open Parsetree + +class mapper: + object + method attribute: attribute -> attribute + method attributes: attribute list -> attribute list + method case: case -> case + method cases: case list -> case list + method class_declaration: class_declaration -> class_declaration + method class_description: class_description -> class_description + method class_expr: class_expr -> class_expr + method class_field: class_field -> class_field + method class_signature: class_signature -> class_signature + method class_structure: class_structure -> class_structure + method class_type: class_type -> class_type + method class_type_declaration: class_type_declaration -> class_type_declaration + method class_type_field: class_type_field -> class_type_field + method constructor_arguments: constructor_arguments -> constructor_arguments + method constructor_declaration: constructor_declaration -> constructor_declaration + method expr: expression -> expression + method extension: extension -> extension + method extension_constructor: extension_constructor -> extension_constructor + method include_declaration: include_declaration -> include_declaration + method include_description: include_description -> include_description + method label_declaration: label_declaration -> label_declaration + method location: Location.t -> Location.t + method module_binding: module_binding -> module_binding + method module_declaration: module_declaration -> module_declaration + method module_expr: module_expr -> module_expr + method module_type: module_type -> module_type + method module_type_declaration: module_type_declaration -> module_type_declaration + method open_description: open_description -> open_description + method pat: pattern -> pattern + method payload: payload -> payload + method signature: signature -> signature + method signature_item: signature_item -> signature_item + method structure: structure -> structure + method structure_item: structure_item -> structure_item + method typ: core_type -> core_type + method type_declaration: type_declaration -> type_declaration + method type_extension: type_extension -> type_extension + method type_kind: type_kind -> type_kind + method value_binding: value_binding -> value_binding + method value_description: value_description -> value_description + method with_constraint: with_constraint -> with_constraint + end + +val to_mapper: #mapper -> Ast_mapper.mapper +(** The resulting mapper is "closed", i.e. methods ignore + their first argument. *) diff --git a/example/ppx_once/.merlin b/example/ppx_once/.merlin new file mode 100644 index 0000000..c25260a --- /dev/null +++ b/example/ppx_once/.merlin @@ -0,0 +1,3 @@ +PKG compiler-libs ocaml-migrate-parsetree ppx_tools_versioned.metaquot_405 + +FLG -safe-string diff --git a/example/ppx_once/META b/example/ppx_once/META new file mode 100644 index 0000000..28ca40b --- /dev/null +++ b/example/ppx_once/META @@ -0,0 +1,8 @@ +description = "once: execute expressions only once" +version = "1.0" +requires(custom_ppx) = "ocaml-migrate-parsetree" +ppx(-custom_ppx,-ppx_driver) = "./ppx_once --as-ppx" +archive(byte,ppx_driver) = "ppx_once.cmo" +archive(native,ppx_driver) = "ppx_once.cmx" +plugin(byte,ppx_driver) = "ppx_once.cma" +plugin(native,ppx_driver) = "ppx_once.cmxs" diff --git a/example/ppx_once/Makefile b/example/ppx_once/Makefile new file mode 100644 index 0000000..56b8b3e --- /dev/null +++ b/example/ppx_once/Makefile @@ -0,0 +1,34 @@ +PACKAGE=ppx_once +OCAMLC=ocamlfind c +OCAMLOPT=ocamlfind opt +FLAGS=-package ocaml-migrate-parsetree,ppx_tools_versioned.metaquot_405 +TARGETS=ppx_once ppx_once.cmo ppx_once.cmx ppx_once.cmxs + +all: build + +clean: + rm -f *.o *.cm* $(TARGETS) + +build: $(TARGETS) + +install: build + ocamlfind install $(PACKAGE) META $(TARGETS) + +uninstall: + ocamlfind remove $(PACKAGE) + +reinstall: + $(MAKE) uninstall + $(MAKE) install + +%.cmo: %.ml + $(OCAMLC) $(FLAGS) -c $^ + +%.cmx: %.ml + $(OCAMLOPT) $(FLAGS) -c $^ + +ppx_once.cmxs: ppx_once.cmx + $(OCAMLOPT) -o $@ -shared $^ + +ppx_once: ppx_once.cmx standalone.ml + $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ diff --git a/example/ppx_once/ppx_once.ml b/example/ppx_once/ppx_once.ml new file mode 100644 index 0000000..46fd83b --- /dev/null +++ b/example/ppx_once/ppx_once.ml @@ -0,0 +1,70 @@ +open Migrate_parsetree +open Ast_405 +open Ppx_tools_405 + +(* + * This ppx rewrites expression extension of the form [%once expr]. + * The first time the expression is evaluated, its result is cached. + * After that, the evaluation will be skipped and the result reused. + * + * The ppx introduces references at the top-level to cache the results. + *) + +let inject_once var code = + [%expr match ![%e var] with + | Some result -> result + | None -> + let result = [%e code] in + [%e var] := Some result; + result] + [@metaloc {code.Parsetree.pexp_loc with Location.loc_ghost = true}] + +let mapper _config _cookies = + let open Ast_mapper in + let toplevel = ref true in + let uid = ref 0 in + let insert = ref [] in + let make_option name = [%str let [%p Ast_helper.Pat.var name] = ref None] in + let toplevel_structure mapper str = + let items = List.fold_left (fun acc x -> + let x' = mapper.structure_item mapper x in + let items = List.map make_option !insert in + insert := []; + x' :: List.concat items @ acc + ) [] str + in + List.rev items + in + let expr mapper pexp = + let open Parsetree in + match pexp.pexp_desc with + | Pexp_extension ( + {Location. txt = "once"; loc}, + payload + ) -> + begin match payload with + | PStr [{pstr_desc = Pstr_eval (body, []) }] -> + incr uid; + let name = "__ppx_once_" ^ string_of_int !uid in + insert := Location.mkloc name loc :: !insert; + inject_once + (Ast_helper.Exp.ident (Location.mkloc (Longident.Lident name) loc)) + (mapper.expr mapper body) + | _ -> default_mapper.expr mapper pexp + end; + | _ -> default_mapper.expr mapper pexp + in + let structure mapper str = + if !toplevel then ( + uid := 0; + insert := []; + toplevel := false; + match toplevel_structure mapper str with + | result -> toplevel := true; result + | exception exn -> toplevel := true; raise exn + ) else + default_mapper.structure mapper str + in + {default_mapper with structure; expr} + +let () = Driver.register ~name:"ppx_once" Versions.ocaml_405 mapper diff --git a/example/ppx_once/standalone.ml b/example/ppx_once/standalone.ml new file mode 100644 index 0000000..8834410 --- /dev/null +++ b/example/ppx_once/standalone.ml @@ -0,0 +1,4 @@ +open Migrate_parsetree + +(* To run as a standalone binary, run the registered drivers *) +let () = Driver.run_main () diff --git a/gen/update_jbuild.ml b/gen/update_jbuild.ml new file mode 100644 index 0000000..1e069e6 --- /dev/null +++ b/gen/update_jbuild.ml @@ -0,0 +1,47 @@ +let versions = ["402"; "403"; "404"; "405"; "406"] + +let flags = "(:standard -w +A-4-17-44-45-105-42 -safe-string)" + +let ppx_tools_versioned_modules = + versions + |> List.map (fun v -> + [ "ast_convenience" + ; "ast_mapper_class" + ; "ast_lifter" + ; "ppx_tools" ] + |> List.map (fun m -> Printf.sprintf "%s_%s" m v) + |> String.concat " " + ) + |> String.concat "\n" + +let () = + Printf.printf + {sexp| +(library + ((name ppx_tools_versioned) + (public_name ppx_tools_versioned) + (synopsis "Tools for authors of ppx rewriters and other syntactic tools (with ocaml-migrate-parsetree support)") + (libraries (ocaml-migrate-parsetree)) + (flags (%s)) + (wrapped false) + (modules (%s)))) +|sexp} flags ppx_tools_versioned_modules + +let synopsis_v v = + Printf.sprintf "%c.%s" v.[0] (String.sub v 1 (String.length v - 1)) + +let () = + List.iter (fun version -> + Printf.printf + {sexp| +(library + ((name ppx_tools_versioned_metaquot_%s) + (public_name ppx_tools_versioned.metaquot_%s) + (synopsis "Meta-quotation: %s parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_%s)) + (flags (%s)))) +|sexp} version version (synopsis_v version) version flags + ) versions diff --git a/jbuild b/jbuild new file mode 100644 index 0000000..19128ce --- /dev/null +++ b/jbuild @@ -0,0 +1,11 @@ +(jbuild_version 1) + +(rule + (with-stdout-to jbuild.inc.gen + (run ocaml ${path:gen/update_jbuild.ml}))) + +(alias + ((name runtest) + (action (diff jbuild.inc jbuild.inc.gen)))) + +(include jbuild.inc) diff --git a/jbuild-workspace.dev b/jbuild-workspace.dev new file mode 100644 index 0000000..7b7de5f --- /dev/null +++ b/jbuild-workspace.dev @@ -0,0 +1,5 @@ +(context (opam (switch 4.02.3))) +(context (opam (switch 4.03.0))) +(context (opam (switch 4.04.2))) +(context (opam (switch 4.05.0))) +(context (opam (switch 4.06.0))) \ No newline at end of file diff --git a/jbuild.inc b/jbuild.inc new file mode 100644 index 0000000..cb547cc --- /dev/null +++ b/jbuild.inc @@ -0,0 +1,63 @@ + +(library + ((name ppx_tools_versioned) + (public_name ppx_tools_versioned) + (synopsis "Tools for authors of ppx rewriters and other syntactic tools (with ocaml-migrate-parsetree support)") + (libraries (ocaml-migrate-parsetree)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))) + (wrapped false) + (modules (ast_convenience_402 ast_mapper_class_402 ast_lifter_402 ppx_tools_402 +ast_convenience_403 ast_mapper_class_403 ast_lifter_403 ppx_tools_403 +ast_convenience_404 ast_mapper_class_404 ast_lifter_404 ppx_tools_404 +ast_convenience_405 ast_mapper_class_405 ast_lifter_405 ppx_tools_405 +ast_convenience_406 ast_mapper_class_406 ast_lifter_406 ppx_tools_406)))) + +(library + ((name ppx_tools_versioned_metaquot_402) + (public_name ppx_tools_versioned.metaquot_402) + (synopsis "Meta-quotation: 4.02 parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_402)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))))) + +(library + ((name ppx_tools_versioned_metaquot_403) + (public_name ppx_tools_versioned.metaquot_403) + (synopsis "Meta-quotation: 4.03 parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_403)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))))) + +(library + ((name ppx_tools_versioned_metaquot_404) + (public_name ppx_tools_versioned.metaquot_404) + (synopsis "Meta-quotation: 4.04 parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_404)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))))) + +(library + ((name ppx_tools_versioned_metaquot_405) + (public_name ppx_tools_versioned.metaquot_405) + (synopsis "Meta-quotation: 4.05 parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_405)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))))) + +(library + ((name ppx_tools_versioned_metaquot_406) + (public_name ppx_tools_versioned.metaquot_406) + (synopsis "Meta-quotation: 4.06 parsetree quotation") + (libraries (ocaml-migrate-parsetree ppx_tools_versioned)) + (kind ppx_rewriter) + (wrapped false) + (modules (ppx_metaquot_406)) + (flags ((:standard -w +A-4-17-44-45-105-42 -safe-string))))) diff --git a/pkg/pkg.ml b/pkg/pkg.ml new file mode 100644 index 0000000..1a04c2b --- /dev/null +++ b/pkg/pkg.ml @@ -0,0 +1,2 @@ +#use "topfind" +#require "topkg-jbuilder.auto" diff --git a/ppx_metaquot_402.ml b/ppx_metaquot_402.ml new file mode 100644 index 0000000..e09dd82 --- /dev/null +++ b/ppx_metaquot_402.ml @@ -0,0 +1,236 @@ +open Ast_402 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* A -ppx rewriter to be used to write Parsetree-generating code + (including other -ppx rewriters) using concrete syntax. + + We support the following extensions in expression position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%stri ...] maps to code which creates the structure item represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e ...] where ... is an expression of type Parsetree.expression + [%t ...] where ... is an expression of type Parsetree.core_type + [%p ...] where ... is an expression of type Parsetree.pattern + + + All locations generated by the meta quotation are by default set + to [Ast_helper.default_loc]. This can be overriden by providing a custom + expression which will be inserted whereever a location is required + in the generated AST. This expression can be specified globally + (for the current structure) as a structure item attribute: + + ;;[@@metaloc ...] + + or locally for the scope of an expression: + + e [@metaloc ...] + + + + Support is also provided to use concrete syntax in pattern + position. The location and attribute fields are currently ignored + by patterns generated from meta quotations. + + We support the following extensions in pattern position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e? ...] where ... is a pattern of type Parsetree.expression + [%t? ...] where ... is a pattern of type Parsetree.core_type + [%p? ...] where ... is a pattern of type Parsetree.pattern + +*) + +module Main : sig end = struct + open Asttypes + open Parsetree + open Ast_helper + open Ast_convenience_402 + + let prefix ty s = + let open Longident in + match parse ty with + | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s + | _ -> s + + class exp_builder = + object + method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = constr (prefix ty c) args + method list l = list l + method tuple l = tuple l + method int i = int i + method string s = str s + method char c = char c + method int32 x = Exp.constant (Const_int32 x) + method int64 x = Exp.constant (Const_int64 x) + method nativeint x = Exp.constant (Const_nativeint x) + end + + class pat_builder = + object + method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = pconstr (prefix ty c) args + method list l = plist l + method tuple l = ptuple l + method int i = pint i + method string s = pstr s + method char c = pchar c + method int32 x = Pat.constant (Const_int32 x) + method int64 x = Pat.constant (Const_int64 x) + method nativeint x = Pat.constant (Const_nativeint x) + end + + + let get_exp loc = function + | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e + | _ -> + Format.eprintf "%aExpression expected@." + Location.print_error loc; + exit 2 + + let get_typ loc = function + | PTyp t -> t + | _ -> + Format.eprintf "%aType expected@." + Location.print_error loc; + exit 2 + + let get_pat loc = function + | PPat (t, None) -> t + | _ -> + Format.eprintf "%aPattern expected@." + Location.print_error loc; + exit 2 + + let exp_lifter loc map = + let map = map.Ast_mapper.expr map in + object + inherit [_] Ast_lifter_402.lifter as super + inherit exp_builder + + (* Special support for location in the generated AST *) + method! lift_Location_t _ = loc + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_core_type x + end + + let pat_lifter map = + let map = map.Ast_mapper.pat map in + object + inherit [_] Ast_lifter_402.lifter as super + inherit pat_builder + + (* Special support for location and attributes in the generated AST *) + method! lift_Location_t _ = Pat.any () + method! lift_Parsetree_attributes _ = Pat.any () + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_core_type x + end + + let loc = ref (app (evar "Pervasives.!") [evar "Ast_helper.default_loc"]) + + let handle_attr = function + | {txt="metaloc";loc=l}, e -> loc := get_exp l e + | _ -> () + + let with_loc ?(attrs = []) f = + let old_loc = !loc in + List.iter handle_attr attrs; + let r = f () in + loc := old_loc; + r + + let expander _config _cookies = + let open Ast_mapper in + let super = default_mapper in + let expr this e = + with_loc ~attrs:e.pexp_attributes + (fun () -> + match e.pexp_desc with + | Pexp_extension({txt="expr";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_expression (get_exp l e) + | Pexp_extension({txt="pat";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_pattern (get_pat l e) + | Pexp_extension({txt="str";_}, PStr e) -> + (exp_lifter !loc this) # lift_Parsetree_structure e + | Pexp_extension({txt="stri";_}, PStr [e]) -> + (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="type";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.expr this e + ) + and pat this p = + with_loc ~attrs:p.ppat_attributes + (fun () -> + match p.ppat_desc with + | Ppat_extension({txt="expr";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_expression (get_exp l e) + | Ppat_extension({txt="pat";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_pattern (get_pat l e) + | Ppat_extension({txt="str";_}, PStr e) -> + (pat_lifter this) # lift_Parsetree_structure e + | Ppat_extension({txt="stri";_}, PStr [e]) -> + (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="type";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.pat this p + ) + and structure this l = + with_loc + (fun () -> super.structure this l) + + and structure_item this x = + begin match x.pstr_desc with + | Pstr_attribute x -> handle_attr x + | _ -> () + end; + super.structure_item this x + + in + {super with expr; pat; structure; structure_item} + + let () = + let open Migrate_parsetree in + Driver.register ~name:"metaquot_402" Versions.ocaml_402 expander +end diff --git a/ppx_metaquot_403.ml b/ppx_metaquot_403.ml new file mode 100644 index 0000000..76e0bee --- /dev/null +++ b/ppx_metaquot_403.ml @@ -0,0 +1,236 @@ +open Ast_403 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* A -ppx rewriter to be used to write Parsetree-generating code + (including other -ppx rewriters) using concrete syntax. + + We support the following extensions in expression position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%stri ...] maps to code which creates the structure item represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e ...] where ... is an expression of type Parsetree.expression + [%t ...] where ... is an expression of type Parsetree.core_type + [%p ...] where ... is an expression of type Parsetree.pattern + + + All locations generated by the meta quotation are by default set + to [Ast_helper.default_loc]. This can be overriden by providing a custom + expression which will be inserted whereever a location is required + in the generated AST. This expression can be specified globally + (for the current structure) as a structure item attribute: + + ;;[@@metaloc ...] + + or locally for the scope of an expression: + + e [@metaloc ...] + + + + Support is also provided to use concrete syntax in pattern + position. The location and attribute fields are currently ignored + by patterns generated from meta quotations. + + We support the following extensions in pattern position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e? ...] where ... is a pattern of type Parsetree.expression + [%t? ...] where ... is a pattern of type Parsetree.core_type + [%p? ...] where ... is a pattern of type Parsetree.pattern + +*) + +module Main : sig end = struct + open Asttypes + open Parsetree + open Ast_helper + open Ast_convenience_403 + + let prefix ty s = + let open Longident in + match parse ty with + | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s + | _ -> s + + class exp_builder = + object + method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = constr (prefix ty c) args + method list l = list l + method tuple l = tuple l + method int i = int i + method string s = str s + method char c = char c + method int32 x = Exp.constant (Const.int32 x) + method int64 x = Exp.constant (Const.int64 x) + method nativeint x = Exp.constant (Const.nativeint x) + end + + class pat_builder = + object + method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = pconstr (prefix ty c) args + method list l = plist l + method tuple l = ptuple l + method int i = pint i + method string s = pstr s + method char c = pchar c + method int32 x = Pat.constant (Const.int32 x) + method int64 x = Pat.constant (Const.int64 x) + method nativeint x = Pat.constant (Const.nativeint x) + end + + + let get_exp loc = function + | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e + | _ -> + Format.eprintf "%aExpression expected@." + Location.print_error loc; + exit 2 + + let get_typ loc = function + | PTyp t -> t + | _ -> + Format.eprintf "%aType expected@." + Location.print_error loc; + exit 2 + + let get_pat loc = function + | PPat (t, None) -> t + | _ -> + Format.eprintf "%aPattern expected@." + Location.print_error loc; + exit 2 + + let exp_lifter loc map = + let map = map.Ast_mapper.expr map in + object + inherit [_] Ast_lifter_403.lifter as super + inherit exp_builder + + (* Special support for location in the generated AST *) + method! lift_Location_t _ = loc + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_core_type x + end + + let pat_lifter map = + let map = map.Ast_mapper.pat map in + object + inherit [_] Ast_lifter_403.lifter as super + inherit pat_builder + + (* Special support for location and attributes in the generated AST *) + method! lift_Location_t _ = Pat.any () + method! lift_Parsetree_attributes _ = Pat.any () + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_core_type x + end + + let loc = ref (app (evar "Pervasives.!") [evar "Ast_helper.default_loc"]) + + let handle_attr = function + | {txt="metaloc";loc=l}, e -> loc := get_exp l e + | _ -> () + + let with_loc ?(attrs = []) f = + let old_loc = !loc in + List.iter handle_attr attrs; + let r = f () in + loc := old_loc; + r + + let expander _config _cookies = + let open Ast_mapper in + let super = default_mapper in + let expr this e = + with_loc ~attrs:e.pexp_attributes + (fun () -> + match e.pexp_desc with + | Pexp_extension({txt="expr";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_expression (get_exp l e) + | Pexp_extension({txt="pat";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_pattern (get_pat l e) + | Pexp_extension({txt="str";_}, PStr e) -> + (exp_lifter !loc this) # lift_Parsetree_structure e + | Pexp_extension({txt="stri";_}, PStr [e]) -> + (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="type";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.expr this e + ) + and pat this p = + with_loc ~attrs:p.ppat_attributes + (fun () -> + match p.ppat_desc with + | Ppat_extension({txt="expr";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_expression (get_exp l e) + | Ppat_extension({txt="pat";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_pattern (get_pat l e) + | Ppat_extension({txt="str";_}, PStr e) -> + (pat_lifter this) # lift_Parsetree_structure e + | Ppat_extension({txt="stri";_}, PStr [e]) -> + (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="type";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.pat this p + ) + and structure this l = + with_loc + (fun () -> super.structure this l) + + and structure_item this x = + begin match x.pstr_desc with + | Pstr_attribute x -> handle_attr x + | _ -> () + end; + super.structure_item this x + + in + {super with expr; pat; structure; structure_item} + + let () = + let open Migrate_parsetree in + Driver.register ~name:"metaquot_403" Versions.ocaml_403 expander +end diff --git a/ppx_metaquot_404.ml b/ppx_metaquot_404.ml new file mode 100644 index 0000000..a447b6a --- /dev/null +++ b/ppx_metaquot_404.ml @@ -0,0 +1,281 @@ +open Ast_404 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* A -ppx rewriter to be used to write Parsetree-generating code + (including other -ppx rewriters) using concrete syntax. + + We support the following extensions in expression position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%stri ...] maps to code which creates the structure item represented by ... + [%sig: ...] maps to code which creates the signature represented by ... + [%sigi: ...] maps to code which creates the signature item represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e ...] where ... is an expression of type Parsetree.expression + [%t ...] where ... is an expression of type Parsetree.core_type + [%p ...] where ... is an expression of type Parsetree.pattern + [%%s ...] where ... is an expression of type Parsetree.structure + or Parsetree.signature depending on the context. + + + All locations generated by the meta quotation are by default set + to [Ast_helper.default_loc]. This can be overriden by providing a custom + expression which will be inserted whereever a location is required + in the generated AST. This expression can be specified globally + (for the current structure) as a structure item attribute: + + ;;[@@metaloc ...] + + or locally for the scope of an expression: + + e [@metaloc ...] + + + + Support is also provided to use concrete syntax in pattern + position. The location and attribute fields are currently ignored + by patterns generated from meta quotations. + + We support the following extensions in pattern position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e? ...] where ... is a pattern of type Parsetree.expression + [%t? ...] where ... is a pattern of type Parsetree.core_type + [%p? ...] where ... is a pattern of type Parsetree.pattern + +*) + +module Main : sig end = struct + open Asttypes + open Parsetree + open Ast_helper + open Ast_convenience_404 + + let prefix ty s = + let open Longident in + match parse ty with + | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s + | _ -> s + + let append ?loc ?attrs e e' = + let fn = Location.mknoloc (Longident.(Ldot (Lident "List", "append"))) in + Exp.apply ?loc ?attrs (Exp.ident fn) [Nolabel, e; Nolabel, e'] + + class exp_builder = + object + method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = constr (prefix ty c) args + method list l = list l + method tuple l = tuple l + method int i = int i + method string s = str s + method char c = char c + method int32 x = Exp.constant (Const.int32 x) + method int64 x = Exp.constant (Const.int64 x) + method nativeint x = Exp.constant (Const.nativeint x) + end + + class pat_builder = + object + method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = pconstr (prefix ty c) args + method list l = plist l + method tuple l = ptuple l + method int i = pint i + method string s = pstr s + method char c = pchar c + method int32 x = Pat.constant (Const.int32 x) + method int64 x = Pat.constant (Const.int64 x) + method nativeint x = Pat.constant (Const.nativeint x) + end + + + let get_exp loc = function + | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e + | _ -> + Format.eprintf "%aExpression expected@." + Location.print_error loc; + exit 2 + + let get_typ loc = function + | PTyp t -> t + | _ -> + Format.eprintf "%aType expected@." + Location.print_error loc; + exit 2 + + let get_pat loc = function + | PPat (t, None) -> t + | _ -> + Format.eprintf "%aPattern expected@." + Location.print_error loc; + exit 2 + + let exp_lifter loc map = + let map = map.Ast_mapper.expr map in + object + inherit [_] Ast_lifter_404.lifter as super + inherit exp_builder + + (* Special support for location in the generated AST *) + method! lift_Location_t _ = loc + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_structure str = + List.fold_right + (function + | {pstr_desc=Pstr_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_structure_item x)) + str (nil ()) + + method! lift_Parsetree_signature sign = + List.fold_right + (function + | {psig_desc=Psig_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_signature_item x)) + sign (nil ()) + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_core_type x + end + + let pat_lifter map = + let map = map.Ast_mapper.pat map in + object + inherit [_] Ast_lifter_404.lifter as super + inherit pat_builder + + (* Special support for location and attributes in the generated AST *) + method! lift_Location_t _ = Pat.any () + method! lift_Parsetree_attributes _ = Pat.any () + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_core_type x + end + + let loc = ref (app (evar "Pervasives.!") [evar "Ast_helper.default_loc"]) + + let handle_attr = function + | {txt="metaloc";loc=l}, e -> loc := get_exp l e + | _ -> () + + let with_loc ?(attrs = []) f = + let old_loc = !loc in + List.iter handle_attr attrs; + let r = f () in + loc := old_loc; + r + + let expander _config _cookies = + let open Ast_mapper in + let super = default_mapper in + let expr this e = + with_loc ~attrs:e.pexp_attributes + (fun () -> + match e.pexp_desc with + | Pexp_extension({txt="expr";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_expression (get_exp l e) + | Pexp_extension({txt="pat";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_pattern (get_pat l e) + | Pexp_extension({txt="str";_}, PStr e) -> + (exp_lifter !loc this) # lift_Parsetree_structure e + | Pexp_extension({txt="stri";_}, PStr [e]) -> + (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="sig";_}, PSig e) -> + (exp_lifter !loc this) # lift_Parsetree_signature e + | Pexp_extension({txt="sigi";_}, PSig [e]) -> + (exp_lifter !loc this) # lift_Parsetree_signature_item e + | Pexp_extension({txt="type";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.expr this e + ) + and pat this p = + with_loc ~attrs:p.ppat_attributes + (fun () -> + match p.ppat_desc with + | Ppat_extension({txt="expr";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_expression (get_exp l e) + | Ppat_extension({txt="pat";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_pattern (get_pat l e) + | Ppat_extension({txt="str";_}, PStr e) -> + (pat_lifter this) # lift_Parsetree_structure e + | Ppat_extension({txt="stri";_}, PStr [e]) -> + (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="sig";_}, PSig e) -> + (pat_lifter this) # lift_Parsetree_signature e + | Ppat_extension({txt="sigi";_}, PSig [e]) -> + (pat_lifter this) # lift_Parsetree_signature_item e + | Ppat_extension({txt="type";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.pat this p + ) + and structure this l = + with_loc + (fun () -> super.structure this l) + + and structure_item this x = + begin match x.pstr_desc with + | Pstr_attribute x -> handle_attr x + | _ -> () + end; + super.structure_item this x + + and signature this l = + with_loc + (fun () -> super.signature this l) + + and signature_item this x = + begin match x.psig_desc with + | Psig_attribute x -> handle_attr x + | _ -> () + end; + super.signature_item this x + + in + {super with expr; pat; structure; structure_item; signature; signature_item} + + let () = + let open Migrate_parsetree in + Driver.register ~name:"metaquot_404" Versions.ocaml_404 expander +end diff --git a/ppx_metaquot_405.ml b/ppx_metaquot_405.ml new file mode 100644 index 0000000..c39af1f --- /dev/null +++ b/ppx_metaquot_405.ml @@ -0,0 +1,281 @@ +open Ast_405 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* A -ppx rewriter to be used to write Parsetree-generating code + (including other -ppx rewriters) using concrete syntax. + + We support the following extensions in expression position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%stri ...] maps to code which creates the structure item represented by ... + [%sig: ...] maps to code which creates the signature represented by ... + [%sigi: ...] maps to code which creates the signature item represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e ...] where ... is an expression of type Parsetree.expression + [%t ...] where ... is an expression of type Parsetree.core_type + [%p ...] where ... is an expression of type Parsetree.pattern + [%%s ...] where ... is an expression of type Parsetree.structure + or Parsetree.signature depending on the context. + + + All locations generated by the meta quotation are by default set + to [Ast_helper.default_loc]. This can be overriden by providing a custom + expression which will be inserted whereever a location is required + in the generated AST. This expression can be specified globally + (for the current structure) as a structure item attribute: + + ;;[@@metaloc ...] + + or locally for the scope of an expression: + + e [@metaloc ...] + + + + Support is also provided to use concrete syntax in pattern + position. The location and attribute fields are currently ignored + by patterns generated from meta quotations. + + We support the following extensions in pattern position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e? ...] where ... is a pattern of type Parsetree.expression + [%t? ...] where ... is a pattern of type Parsetree.core_type + [%p? ...] where ... is a pattern of type Parsetree.pattern + +*) + +module Main : sig end = struct + open Asttypes + open Parsetree + open Ast_helper + open Ast_convenience_405 + + let prefix ty s = + let open Longident in + match parse ty with + | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s + | _ -> s + + let append ?loc ?attrs e e' = + let fn = Location.mknoloc (Longident.(Ldot (Lident "List", "append"))) in + Exp.apply ?loc ?attrs (Exp.ident fn) [Nolabel, e; Nolabel, e'] + + class exp_builder = + object + method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = constr (prefix ty c) args + method list l = list l + method tuple l = tuple l + method int i = int i + method string s = str s + method char c = char c + method int32 x = Exp.constant (Const.int32 x) + method int64 x = Exp.constant (Const.int64 x) + method nativeint x = Exp.constant (Const.nativeint x) + end + + class pat_builder = + object + method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = pconstr (prefix ty c) args + method list l = plist l + method tuple l = ptuple l + method int i = pint i + method string s = pstr s + method char c = pchar c + method int32 x = Pat.constant (Const.int32 x) + method int64 x = Pat.constant (Const.int64 x) + method nativeint x = Pat.constant (Const.nativeint x) + end + + + let get_exp loc = function + | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e + | _ -> + Format.eprintf "%aExpression expected@." + Location.print_error loc; + exit 2 + + let get_typ loc = function + | PTyp t -> t + | _ -> + Format.eprintf "%aType expected@." + Location.print_error loc; + exit 2 + + let get_pat loc = function + | PPat (t, None) -> t + | _ -> + Format.eprintf "%aPattern expected@." + Location.print_error loc; + exit 2 + + let exp_lifter loc map = + let map = map.Ast_mapper.expr map in + object + inherit [_] Ast_lifter_405.lifter as super + inherit exp_builder + + (* Special support for location in the generated AST *) + method! lift_Location_t _ = loc + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_structure str = + List.fold_right + (function + | {pstr_desc=Pstr_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_structure_item x)) + str (nil ()) + + method! lift_Parsetree_signature sign = + List.fold_right + (function + | {psig_desc=Psig_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_signature_item x)) + sign (nil ()) + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_core_type x + end + + let pat_lifter map = + let map = map.Ast_mapper.pat map in + object + inherit [_] Ast_lifter_405.lifter as super + inherit pat_builder + + (* Special support for location and attributes in the generated AST *) + method! lift_Location_t _ = Pat.any () + method! lift_Parsetree_attributes _ = Pat.any () + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_core_type x + end + + let loc = ref (app (evar "Pervasives.!") [evar "Ast_helper.default_loc"]) + + let handle_attr = function + | {txt="metaloc";loc=l}, e -> loc := get_exp l e + | _ -> () + + let with_loc ?(attrs = []) f = + let old_loc = !loc in + List.iter handle_attr attrs; + let r = f () in + loc := old_loc; + r + + let expander _config _cookies = + let open Ast_mapper in + let super = default_mapper in + let expr this e = + with_loc ~attrs:e.pexp_attributes + (fun () -> + match e.pexp_desc with + | Pexp_extension({txt="expr";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_expression (get_exp l e) + | Pexp_extension({txt="pat";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_pattern (get_pat l e) + | Pexp_extension({txt="str";_}, PStr e) -> + (exp_lifter !loc this) # lift_Parsetree_structure e + | Pexp_extension({txt="stri";_}, PStr [e]) -> + (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="sig";_}, PSig e) -> + (exp_lifter !loc this) # lift_Parsetree_signature e + | Pexp_extension({txt="sigi";_}, PSig [e]) -> + (exp_lifter !loc this) # lift_Parsetree_signature_item e + | Pexp_extension({txt="type";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.expr this e + ) + and pat this p = + with_loc ~attrs:p.ppat_attributes + (fun () -> + match p.ppat_desc with + | Ppat_extension({txt="expr";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_expression (get_exp l e) + | Ppat_extension({txt="pat";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_pattern (get_pat l e) + | Ppat_extension({txt="str";_}, PStr e) -> + (pat_lifter this) # lift_Parsetree_structure e + | Ppat_extension({txt="stri";_}, PStr [e]) -> + (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="sig";_}, PSig e) -> + (pat_lifter this) # lift_Parsetree_signature e + | Ppat_extension({txt="sigi";_}, PSig [e]) -> + (pat_lifter this) # lift_Parsetree_signature_item e + | Ppat_extension({txt="type";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.pat this p + ) + and structure this l = + with_loc + (fun () -> super.structure this l) + + and structure_item this x = + begin match x.pstr_desc with + | Pstr_attribute x -> handle_attr x + | _ -> () + end; + super.structure_item this x + + and signature this l = + with_loc + (fun () -> super.signature this l) + + and signature_item this x = + begin match x.psig_desc with + | Psig_attribute x -> handle_attr x + | _ -> () + end; + super.signature_item this x + + in + {super with expr; pat; structure; structure_item; signature; signature_item} + + let () = + let open Migrate_parsetree in + Driver.register ~name:"metaquot_405" Versions.ocaml_405 expander +end diff --git a/ppx_metaquot_406.ml b/ppx_metaquot_406.ml new file mode 100644 index 0000000..66fdc3a --- /dev/null +++ b/ppx_metaquot_406.ml @@ -0,0 +1,281 @@ +open Ast_406 + +(* This file is part of the ppx_tools package. It is released *) +(* under the terms of the MIT license (see LICENSE file). *) +(* Copyright 2013 Alain Frisch and LexiFi *) + +(* A -ppx rewriter to be used to write Parsetree-generating code + (including other -ppx rewriters) using concrete syntax. + + We support the following extensions in expression position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%stri ...] maps to code which creates the structure item represented by ... + [%sig: ...] maps to code which creates the signature represented by ... + [%sigi: ...] maps to code which creates the signature item represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e ...] where ... is an expression of type Parsetree.expression + [%t ...] where ... is an expression of type Parsetree.core_type + [%p ...] where ... is an expression of type Parsetree.pattern + [%%s ...] where ... is an expression of type Parsetree.structure + or Parsetree.signature depending on the context. + + + All locations generated by the meta quotation are by default set + to [Ast_helper.default_loc]. This can be overriden by providing a custom + expression which will be inserted whereever a location is required + in the generated AST. This expression can be specified globally + (for the current structure) as a structure item attribute: + + ;;[@@metaloc ...] + + or locally for the scope of an expression: + + e [@metaloc ...] + + + + Support is also provided to use concrete syntax in pattern + position. The location and attribute fields are currently ignored + by patterns generated from meta quotations. + + We support the following extensions in pattern position: + + [%expr ...] maps to code which creates the expression represented by ... + [%pat? ...] maps to code which creates the pattern represented by ... + [%str ...] maps to code which creates the structure represented by ... + [%type: ...] maps to code which creates the core type represented by ... + + Quoted code can refer to expressions representing AST fragments, + using the following extensions: + + [%e? ...] where ... is a pattern of type Parsetree.expression + [%t? ...] where ... is a pattern of type Parsetree.core_type + [%p? ...] where ... is a pattern of type Parsetree.pattern + +*) + +module Main : sig end = struct + open Asttypes + open Parsetree + open Ast_helper + open Ast_convenience_406 + + let prefix ty s = + let open Longident in + match parse ty with + | Ldot(m, _) -> String.concat "." (Longident.flatten m) ^ "." ^ s + | _ -> s + + let append ?loc ?attrs e e' = + let fn = Location.mknoloc (Longident.(Ldot (Lident "List", "append"))) in + Exp.apply ?loc ?attrs (Exp.ident fn) [Nolabel, e; Nolabel, e'] + + class exp_builder = + object + method record ty x = record (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = constr (prefix ty c) args + method list l = list l + method tuple l = tuple l + method int i = int i + method string s = str s + method char c = char c + method int32 x = Exp.constant (Const.int32 x) + method int64 x = Exp.constant (Const.int64 x) + method nativeint x = Exp.constant (Const.nativeint x) + end + + class pat_builder = + object + method record ty x = precord ~closed:Closed (List.map (fun (l, e) -> prefix ty l, e) x) + method constr ty (c, args) = pconstr (prefix ty c) args + method list l = plist l + method tuple l = ptuple l + method int i = pint i + method string s = pstr s + method char c = pchar c + method int32 x = Pat.constant (Const.int32 x) + method int64 x = Pat.constant (Const.int64 x) + method nativeint x = Pat.constant (Const.nativeint x) + end + + + let get_exp loc = function + | PStr [ {pstr_desc=Pstr_eval (e, _); _} ] -> e + | _ -> + Format.eprintf "%aExpression expected@." + Location.print_error loc; + exit 2 + + let get_typ loc = function + | PTyp t -> t + | _ -> + Format.eprintf "%aType expected@." + Location.print_error loc; + exit 2 + + let get_pat loc = function + | PPat (t, None) -> t + | _ -> + Format.eprintf "%aPattern expected@." + Location.print_error loc; + exit 2 + + let exp_lifter loc map = + let map = map.Ast_mapper.expr map in + object + inherit [_] Ast_lifter_406.lifter as super + inherit exp_builder + + (* Special support for location in the generated AST *) + method! lift_Location_t _ = loc + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_structure str = + List.fold_right + (function + | {pstr_desc=Pstr_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_structure_item x)) + str (nil ()) + + method! lift_Parsetree_signature sign = + List.fold_right + (function + | {psig_desc=Psig_extension(({txt="s";loc}, e), _); _} -> + append (get_exp loc e) + | x -> + cons (super # lift_Parsetree_signature_item x)) + sign (nil ()) + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_exp loc e) + | x -> super # lift_Parsetree_core_type x + end + + let pat_lifter map = + let map = map.Ast_mapper.pat map in + object + inherit [_] Ast_lifter_406.lifter as super + inherit pat_builder + + (* Special support for location and attributes in the generated AST *) + method! lift_Location_t _ = Pat.any () + method! lift_Parsetree_attributes _ = Pat.any () + + (* Support for antiquotations *) + method! lift_Parsetree_expression = function + | {pexp_desc=Pexp_extension({txt="e";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_expression x + + method! lift_Parsetree_pattern = function + | {ppat_desc=Ppat_extension({txt="p";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_pattern x + + method! lift_Parsetree_core_type = function + | {ptyp_desc=Ptyp_extension({txt="t";loc}, e); _} -> map (get_pat loc e) + | x -> super # lift_Parsetree_core_type x + end + + let loc = ref (app (evar "Pervasives.!") [evar "Ast_helper.default_loc"]) + + let handle_attr = function + | {txt="metaloc";loc=l}, e -> loc := get_exp l e + | _ -> () + + let with_loc ?(attrs = []) f = + let old_loc = !loc in + List.iter handle_attr attrs; + let r = f () in + loc := old_loc; + r + + let expander _config _cookies = + let open Ast_mapper in + let super = default_mapper in + let expr this e = + with_loc ~attrs:e.pexp_attributes + (fun () -> + match e.pexp_desc with + | Pexp_extension({txt="expr";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_expression (get_exp l e) + | Pexp_extension({txt="pat";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_pattern (get_pat l e) + | Pexp_extension({txt="str";_}, PStr e) -> + (exp_lifter !loc this) # lift_Parsetree_structure e + | Pexp_extension({txt="stri";_}, PStr [e]) -> + (exp_lifter !loc this) # lift_Parsetree_structure_item e + | Pexp_extension({txt="sig";_}, PSig e) -> + (exp_lifter !loc this) # lift_Parsetree_signature e + | Pexp_extension({txt="sigi";_}, PSig [e]) -> + (exp_lifter !loc this) # lift_Parsetree_signature_item e + | Pexp_extension({txt="type";loc=l}, e) -> + (exp_lifter !loc this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.expr this e + ) + and pat this p = + with_loc ~attrs:p.ppat_attributes + (fun () -> + match p.ppat_desc with + | Ppat_extension({txt="expr";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_expression (get_exp l e) + | Ppat_extension({txt="pat";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_pattern (get_pat l e) + | Ppat_extension({txt="str";_}, PStr e) -> + (pat_lifter this) # lift_Parsetree_structure e + | Ppat_extension({txt="stri";_}, PStr [e]) -> + (pat_lifter this) # lift_Parsetree_structure_item e + | Ppat_extension({txt="sig";_}, PSig e) -> + (pat_lifter this) # lift_Parsetree_signature e + | Ppat_extension({txt="sigi";_}, PSig [e]) -> + (pat_lifter this) # lift_Parsetree_signature_item e + | Ppat_extension({txt="type";loc=l}, e) -> + (pat_lifter this) # lift_Parsetree_core_type (get_typ l e) + | _ -> + super.pat this p + ) + and structure this l = + with_loc + (fun () -> super.structure this l) + + and structure_item this x = + begin match x.pstr_desc with + | Pstr_attribute x -> handle_attr x + | _ -> () + end; + super.structure_item this x + + and signature this l = + with_loc + (fun () -> super.signature this l) + + and signature_item this x = + begin match x.psig_desc with + | Psig_attribute x -> handle_attr x + | _ -> () + end; + super.signature_item this x + + in + {super with expr; pat; structure; structure_item; signature; signature_item} + + let () = + let open Migrate_parsetree in + Driver.register ~name:"metaquot_406" Versions.ocaml_406 expander +end diff --git a/ppx_metaquot_run.ml b/ppx_metaquot_run.ml new file mode 100644 index 0000000..7bd1567 --- /dev/null +++ b/ppx_metaquot_run.ml @@ -0,0 +1 @@ +let () = Migrate_parsetree.Driver.run_main () diff --git a/ppx_tools_402.ml b/ppx_tools_402.ml new file mode 100644 index 0000000..7733885 --- /dev/null +++ b/ppx_tools_402.ml @@ -0,0 +1,2 @@ +module Ast_convenience = Ast_convenience_402 +module Ast_mapper_class = Ast_mapper_class_402 diff --git a/ppx_tools_403.ml b/ppx_tools_403.ml new file mode 100644 index 0000000..1d186d9 --- /dev/null +++ b/ppx_tools_403.ml @@ -0,0 +1,2 @@ +module Ast_convenience = Ast_convenience_403 +module Ast_mapper_class = Ast_mapper_class_403 diff --git a/ppx_tools_404.ml b/ppx_tools_404.ml new file mode 100644 index 0000000..cef40a6 --- /dev/null +++ b/ppx_tools_404.ml @@ -0,0 +1,2 @@ +module Ast_convenience = Ast_convenience_404 +module Ast_mapper_class = Ast_mapper_class_404 diff --git a/ppx_tools_405.ml b/ppx_tools_405.ml new file mode 100644 index 0000000..398d008 --- /dev/null +++ b/ppx_tools_405.ml @@ -0,0 +1,2 @@ +module Ast_convenience = Ast_convenience_405 +module Ast_mapper_class = Ast_mapper_class_405 diff --git a/ppx_tools_406.ml b/ppx_tools_406.ml new file mode 100644 index 0000000..4fd2c1e --- /dev/null +++ b/ppx_tools_406.ml @@ -0,0 +1,2 @@ +module Ast_convenience = Ast_convenience_406 +module Ast_mapper_class = Ast_mapper_class_406 diff --git a/ppx_tools_versioned.opam b/ppx_tools_versioned.opam new file mode 100644 index 0000000..1c593a5 --- /dev/null +++ b/ppx_tools_versioned.opam @@ -0,0 +1,21 @@ +opam-version: "1.2" +maintainer: "frederic.bour@lakaban.net" +authors: [ + "Frédéric Bour " + "Alain Frisch " +] +license: "MIT" +homepage: "https://github.com/let-def/ppx_tools_versioned" +bug-reports: "https://github.com/let-def/ppx_tools_versioned/issues" +dev-repo: "git://github.com/let-def/ppx_tools_versioned.git" +tags: [ "syntax" ] +build: [ + ["jbuilder" "subst" "-n" name] {pinned} + ["jbuilder" "build" "-p" name "-j" jobs] +] +build-test: [["jbuilder" "runtest" "-p" name "-j" jobs]] +depends: [ + "jbuilder" {build & >= "1.0+beta17"} + "ocaml-migrate-parsetree" { >= "1.0.10" } +] +available: ocaml-version >= "4.02.0" -- cgit v1.2.3