pax_global_header00006660000000000000000000000064135645046470014530gustar00rootroot0000000000000052 comment=940db942838f1811e499e6afd6bbb0ccb0f1763e ocaml-migrate-parsetree-1.5.0/000077500000000000000000000000001356450464700162445ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/.gitignore000066400000000000000000000002371356450464700202360ustar00rootroot00000000000000*.annot *.cmo *.cma *.cmi *.cmt *.cmti *.a *.o *.cmx *.cmxs *.cmxa *.merlin *.install # jbuilder working directory _build/ # cinaps *.corrected # emacs .#* ocaml-migrate-parsetree-1.5.0/.ocamlformat000066400000000000000000000000071356450464700205460ustar00rootroot00000000000000disableocaml-migrate-parsetree-1.5.0/.ocp-indent000066400000000000000000000000401356450464700202770ustar00rootroot00000000000000match_clause=4 strict_with=auto ocaml-migrate-parsetree-1.5.0/.travis.yml000066400000000000000000000012331356450464700203540ustar00rootroot00000000000000language: 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="ocaml-migrate-parsetree" - 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 - DISTRO=alpine OCAML_VERSION=4.06.0 ocaml-migrate-parsetree-1.5.0/CHANGES.md000066400000000000000000000076031356450464700176440ustar00rootroot00000000000000v1.5.0 2019-11-18 ----------------- - Add support for 4.10 (#86, @diml) v1.4.0 2019-07-04 London ------------------------ - Initial support for 4.09, tested with 4.09+beta1 (#76, @hhugo) - When encoding errors into the AST, duplicate the error message for "ocaml.error" nodes for OCaml versions < 4.08 (#75, @xclerc) v1.3.1 2019-05-20 London ------------------------ - Make sure opening `Ast_408` doesn't shadow `Int` or `Misc` (#71, @hhugo) - Fix a couple of issues related to upgrading the AST from 4.07 to 4.08 (#71, @hhugo) v1.3.0 2019-05-08 London ------------------------ - Get rid of the ocamlbuild plugin. Nobody is using it in opam and it is more work to maintain (#63, @diml) - Set `Location.input_name` to the original filename when reading a binary AST (#66, @diml) - Add support 4.08 (#70, @xclerc) v1.2.0 2018-12-19 London ------------------------ - Remove unused ocamlfind dependency in the opam file (#53, @diml) - Add `--print-transformations` to list registered transformations (#55, @rgrinberg) - Fix Windows compatibility by setting the output to binary mode when writing a binary ast (#57, #59, @bryphe and @dra27) - Switch to dune and opam 2.0 (#58, #60, @diml) v1.1.0 2018-09-05 London ------------------------ - Allow ppx rewriters to specify when they should be applied v1.0.11 2018-06-06 London ------------------------- - Fix handling of `--impl/--intf`. Before the driver would crash if the file extension was neither `.ml` nor `.mli` v1.0.10 2018-04-19 London ------------------------- - Add support for OCaml 4.07 v1.0.9 2018-03-20 New York -------------------------- - Fix an issue where cookies set from the command line sometimes disappeared v1.0.8 2018-03-15 London ------------------------ - Add a `--null` argument to suppress the output. This is used to write linters - Use the new generic ppx driver support of jbuilder v1.0.7 2017-10-31 Paris ----------------------- Contributed by @hhugo: - update Magic Number for 4.06 - fix some compilation warnings v1.0.6 2017-10-11 Paris ----------------------- Fix generation of `Migrate_parsetree` module. v1.0.5 2017-10-02 Paris ----------------------- Resynchronize with trunk. Add a migrating version of Parse module. v1.0.4 2017-08-22 Paris ----------------------- Resynchronize with trunk. Contributed by Xavier Clerc, @xclerc. v1.0.3 2017-08-11 Paris ----------------------- Add a shallow identity mapper (suggested by Anton Bachin, @aantron). v1.0.2 2017-07-28 Paris ----------------------- Synchronize with 4.06 AST with trunk. Accept --cookie arguments also when run in --as-ppx mode. v1.0.1 2017-06-06 Paris ----------------------- Add support for trunk version (as of today...). v1.0 2017-04-17 Paris --------------------- Driver: add --as-pp and --embed-errors flags. --embed-errors causes the driver to embed exceptions raised by rewriters as extension points in the Ast --as-pp is a shorthand for: --dump-ast --embed-errors Expose more primitives for embedding the driver. Fix bug where `reset_args` functions where not being called. Fix "OCaml OCaml" in error messages (contributed by Adrien Guatto). v0.7 2017-03-21 Mâcon --------------------- Fix findlib predicates: - replace `omp_driver` by `ppx_driver` - replace `-custom_ppx` by `-custom_ppx,-ppx_driver` v0.6 2017-03-21 Mâcon --------------------- Add documentation, examples, etc. v0.5 2017-03-11 Mâcon --------------------- Specify ocamlfind dependency in opam file (@yunxing). v0.4 2017-03-10 Mâcon --------------------- API cleanup and extension. Added driver. Switch to jbuilder. v0.3 2017-02-16 Paris ---------------------- Use `-no-alias-deps` to prevent linking failure of `Compiler_libs` (referencing `Parsetree` and `Asttypes` which have no implementation). v0.2 2017-02-07 London ---------------------- Install CMXS too (contributed @vbmithr). v0.1 2017-02-02 London ---------------------- First release. ocaml-migrate-parsetree-1.5.0/LICENSE.md000066400000000000000000000650201356450464700176530ustar00rootroot00000000000000In the following, "this library" refers to all files marked "Copyright INRIA" in this distribution. The OCaml Core System is distributed under the terms of the GNU Lesser General Public License (LGPL) version 2.1 (included below). As a special exception to the GNU Lesser General Public License, you may link, statically or dynamically, a "work that uses the OCaml Core System" with a publicly distributed version of this library to produce an executable file containing portions of the OCaml Core System, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Lesser General Public License. By "a publicly distributed version of this library", we mean either the unmodified OCaml Core System as distributed by INRIA, or a modified version of the OCaml Core System that is distributed under the conditions defined in clause 2 of the GNU Lesser General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Lesser General Public License. ---------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. one line to give the library's name and an idea of what it does. Copyright (C) year name of author This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. signature of Ty Coon, 1 April 1990 Ty Coon, President of Vice That's all there is to it! -------------------------------------------------- ocaml-migrate-parsetree-1.5.0/MANUAL.md000066400000000000000000000400351356450464700175450ustar00rootroot00000000000000Title: Guide to OCaml Migrate Parsetree Author: Frédéric Bour, @let-def Date: March 9, 2017 **Table of Contents** - [Manipulating parsetree](#manipulating-parsetree) - [Talking about different versions of the compiler](#talking-about-different-versions-of-the-compiler) - [Migrating between compiler versions](#migrating-between-compiler-versions) - [(Un)marshalling AST](#unmarshalling-ast) - [Drivers](#drivers) - [The legacy way](#the-legacy-way) - [New registration interface](#new-registration-interface) - [A minimal driver](#a-minimal-driver) - [Custom and standalone drivers](#custom-and-standalone-drivers) - [ppx_tools_versioned](#ppx_tools_versioned) - [ppx_metaquots](#ppx_metaquots) - [Findlib specification](#findlib-specification) - [Standalone *"--as-ppx"* rewriters in META](#standalone---as-ppx-rewriters-in-meta) - [Using arguments in META ppxopt](#using-arguments-in-meta-ppxopt) - [Conventions for distributing a linkable ppx rewriter](#conventions-for-distributing-a-linkable-ppx-rewriter) - [Troubleshooting](#troubleshooting) - [Accessing shadowed compiler libs module](#accessing-shadowed-compiler-libs-module) - [Using functions from compiler-libs results in (unfriendly) type errors](#using-functions-from-compiler-libs-results-in-unfriendly-type-errors) - [Features not supported in targeted version](#features-not-supported-in-targeted-version) - [What kind of guarantees to expect in practice?](#what-kind-of-guarantees-to-expect-in-practice) This library is designed to make PPX rewriters portable across compiler versions. It works by versioning the definitions of OCaml AST. This includes `Parsetree`, `Asttypes`, `Outcometree`, `Ast_helper` and most of `Docstrings` and `Ast_mapper`. *Note:* `Docstrings` and `Ast_mapper` contain some global state which was removed during versioning. This affect registration of rewriters when using `Ast_mapper` as a driver. See the [driver section](#drivers) for reliable solutions. # Manipulating parsetree Most of the work happens by shadowing. If your PPX rewriter was written against OCaml 4.04 AST, just `open Ast_404` (alternatively, you can pass `-open Ast_404` when building the file). This will introduce the versioned modules in scope. When compiled with other supported versions of OCaml, the definitions are still compatible with 4.04. While this is enough to manipulate the AST from within your code, you can no longer have expectations on the version of `compiler-libs`. The rest of the `Migrate_parsetree` module provides tools to deal with that. ## Talking about different versions of the compiler The module `Migrate_parsetree.Versions` provides a way of abstracting compiler versions and getting functions to migrate from one version to another. The interface of the module is quite technical, but one doesn't need to understand all details to work with the module. The main problem that it solves is being able to talk about a "signature" or "structure" without being tied to a specific compiler version (that is, while being polymorphic over concrete versions of the compiler). The module type `Ast` lists all the types that are abstracted for each version. The type `ocaml_version` and the module type `OCaml_version` represent ocaml versions in the term and module languages. Instances are given by the values `ocaml_402`, `ocaml_403`, ... and the modules `OCaml_402`, `OCaml_403`... The `ocaml_current` and `OCaml_current` definitions are special in that they refer to versions compatible with compiler-libs (the current compiler). Functions and functors that operate across compiler versions will take these as arguments. ## Migrating between compiler versions When migrating between two known compiler versions, the modules `Migrate_parsetree.Migrate_40x_40y` contain functions to transform values between two consecutive versions. For instance `Migrate_402_403.copy_signature` turns a signature of OCaml 4.02 into a signature for OCaml 4.03. `Migrate_404_403.copy_mapper` transforms an `Ast_mapper.mapper` for OCaml 4.04 into a mapper for OCaml 4.03. When working with an arbitrary version, it becomes useful to quantify over versions and migrations. The `Migrate_parsetree.Versions` module comes again to the rescue. The `migrate_functions` record is a list of functions for converting each type. The function `Versions.migrate` takes two OCaml version and returns a migration record between the two. The functor `Convert` does the same at the module level. ## (Un)marshalling AST The `Ast_io` module implements AST marshalling and unmarshalling abstracted over OCaml versions. It can read and write binary implementation and interface files from different compiler versions and pack them with the corresponding `Versions.OCaml_version` module. (FIXME: marshalling format is not guaranteed to be stable accross versions) ## Parsing source file The `Parse` module implements an interface similar to the one from compiler-libs, but parsing functions take an OCaml version as first argument. It uses the distributed OCaml parser (current version) then migrate the resulting AST to the requested version. Beware, these parsing functions can alse raise `Migration_error` exceptions. # Driver So far, all tools presented were for working with parsetrees. This is helpful to implement a mapper object, but it is not enough to get to a PPX binary. Drivers fulfill this last step: going from one or more AST mappers to a concrete binary that will do the rewriting. ## The legacy way Traditionally, mappers had to be registered in `Ast_mapper`; either with `Ast_mapper.register` or `Ast_mapper.run_main`. The registration interface was removed from versioned modules. If you try to register with `Ast_mapper` from compiler-libs, remember to migrate the version. In a few lines of code: ```ocaml (* Assuming rewriter is written against OCaml 4.04 parsetree *) let migration = Versions.migrate Versions.ocaml_404 Versions.ocaml_current let () = (* Refer to unshadowed mapper *) Compiler_libs.Ast_mapper.register (fun args -> migration.copy_mapper (my_mapper args)) ``` This method might be convenient for quickly migrating existing rewriters, but we are trying to get away from `Ast_mapper` global state. *ocaml-migrate-parsetree* offers a new, forward looking, interface. ## New registration interface In the new interface, the state that can be accessed by a PPX rewriter is made more explicit. - *Compiler configuration* via `Driver.config`; it snapshots the few compiler settings that are guaranteed to be set by the compiler API. - *Cookies* via `Driver.cookies`, `get_cookies` and `set_cookies`, which work across different versions. - *Command-line arguments*; when registering a mapper, one can provide argument specifications, as defined by the [`Arg`](http://caml.inria.fr/pub/docs/manual-ocaml/libref/Arg.html) module. Rewriters no longer receive an arbitrary list of arguments. Everything happens through the specifications. Collision in rewriter names and argument keys is *an error*: a rewriter should be registered only once, each key should be used only once. ```ocaml open Ast_404 (* Target 4.04 parsetree *) (* Rewriter settings *) let foo_config : string option ref = ref None let set_foo bar = foo_config := Some bar let reset_args () = foo_config := None let args = [ ("-foo", Arg.String set_foo, " Foo value to use in the rewriter") ] (* Rewriter implementation *) let my_rewriter config cookies = let foo = match !foo_config with | None -> raise (Arg.Bad "-foo is mandatory") | Some foo -> foo in {Ast_mapper.default_mapper with ...} (* Registration *) let () = Driver.register ~name:"hello_world" ~reset_args ~args Versions.ocaml_404 my_rewriter ``` ## A minimal driver The code above gets the rewriter registered, but this won't produce a runnable binary. One or more rewriters can be registered, the final step will be to run them. `Driver.run_as_ast_mapper` is suitable as an argument to `Ast_mapper.run_main` (or even `Ast_mapper.register`). It acts as a "meta-mapper" that will apply all the registered mappers. `Driver.run_as_ppx_rewriter` does that, calling `Ast_mapper.run_main Driver.run_as_ast_mapper`. The order is chosen to minimize the number of rewriting that happens: - rewriters are sorted by versions, lower versions first - rewriters targeting the same version are applied in the registration order ## Custom and standalone drivers Using `Driver.run_main` as an entry point offers a way to make custom and standalone rewriters. A standalone rewriter can be used independently of the OCaml compiler. It can rewrite source files or save processed ASTs. Try `./myrewriter --help` for more information. When the first argument is "--as-ppx", it behaves like a normal PPX and is suitable for use with "-ppx" (`ocamlc -ppx "./myrewriter --as-ppx"`). Linking the `ocaml-migrate-parsetree.driver-main` package has the effect of just calling `Driver.run_main`. It should be linked last. The purpose is to let you make a custom rewriter that link all the PPX in use in your project to reduce the overhead of rewriting: ```shell ocamlfind ocamlopt -linkpkg -package rewriter1,rewriter2,... \ -package ocaml-migrate-parsetree.driver-main -o myrewriter ``` # ppx_tools_versioned Some rewriters make use of the *ppx_tools* package that offers conveniences for manipulating parsetrees. As *ppx_tools* itself uses compiler-libs, using it directly defeats the purpose of *ocaml-migrate-parsetree*. We provide the [ppx_tools_versioned](https://github.com/let-def/ppx_tools_versioned) package to overcome this. It offers migrate friendly versions of `Ast_convenience`, `Ast_lifter`, `Ast_mapper_class` and `Ppx_metaquot`. To use these versions, just append `_40x` to the module names or `open Ppx_tool_40x` module. ```ocaml (* Original code *) open Ast_mapper_class class my_mapper = object inherit mapper ... end (* Targeting 4.04 *) open Ast_404 open Ppx_tools_404 open Ast_mapper_class class my_mapper = object inherit mapper ... end (* Alternatively, if you use a single module from Ppx_tools *) open Ast_mapper_class_404 class my_mapper = object inherit mapper ... end ``` ### ppx_metaquots The *metaquot* rewriter allows quoting of the OCaml AST. The version provided by *ppx_tools* will quote the Parsetree from *compiler-libs*. The versioned ones are accessed by using *ppx_tools_versioned.metaquot_40x* packages. For instance, *ppx_tools_versioned.metaquot_404* will quote `Ast_404.Parsetree`. # Findlib specification Some precautions have to be taken when writing *META* files for *ocaml-migrate-parsetree* driven PPXs. The ppx and ppxopt directives are affected. ## Standalone *"--as-ppx"* rewriters in META If your rewriter is produced as standalone rewriter, then you have to pass the "--as-ppx" argument first: ```diff -ppx = "./my_ppx" +ppx = "./my_ppx --as-ppx" ``` As long as the PPX command line begins with `./`, findlib will expand the path to an absolute directory and you will get the correct invocation: ``` /home/me/.opam/.../my_lib/./my_ppx --as-ppx ``` ## Using arguments in META ppxopt Since rewriters use the `Arg` module to specify command-line arguments, anonymous arguments are no longer allowed. If you used to pass anonymous arguments with ppxopt, you should pick an argument name and prefix them. For instance: ``` -ppxopt = "my_ppx,./bar" +ppxopt = "my_ppx,-foo,./bar" ``` As you can see, arguments are separated by commas. Commas ensure that filename expansion still happens, such that invocation looks like: ``` /home/me/.opam/.../my_lib/./my_ppx ... -foo /home/me/.opam/.../my_lib/./bar ``` ## Conventions for distributing a linkable ppx rewriter The common case is to run ppx binaries on-demand: a findlib package describing a ppx rewriter will essentially add a new `-ppx my_binary` argument to the compiler invocation. It is also possible to link and run a dedicated binary that will apply many rewriters consecutively. A package following that convention will use *ocaml-migrate-parsetree* to register a rewriter using `Driver.register`, but not do any actual rewriting (no `-ppx ...`). The build system of a project making use of this feature will first build a custom rewriter that links all the necessary packages to produce a first binary. This binary is then used as the only ppx rewriter for the main source files of this project. The convention to distinguish when a ppx package is used as a rewriter and when it is used a library is to use two findlib predicates (see [META](http://projects.camlcity.org/projects/dl/findlib-1.7.1/doc/ref-html/r759.html) documentation and also `ocamlfind(1)` man page): - `custom_ppx`: we are building a custom ppx driver, no rewriting should be done now (in other words, don't pass `-ppx ...` argument) - `ppx_driver`: we are making our own driver, registration should be done using `Driver.register` ### Linking example ```shell $ ocamlfind opt -o my_driver -linkpkg -predicates custom_ppx,ppx_driver -package ppx_tools_versioned.metaquot_402 -package ocaml-migrate-parsetree.driver-main ``` The predicates change the behavior of `ppx_tools_versioned.metaquot_402` package. Linking `ocaml-migrate-parsetree.driver-main` lasts executes all the rewriters that were registered. ### Package example META ``` version = "1.0" description = "dummy ppx" requires = "ocaml-migrate-parsetree" ppx(-custom_ppx,-ppx_driver) = "./ppx_dummy --as-ppx" archive(byte,ppx_driver) = "ppx_dummy.cma" archive(native,ppx_driver) = "ppx_dummy.cmxa" ``` Rewrite only when `custom_ppx` is not defined. Link *ppx_dummy* objects when `ppx_driver` is defined. # Troubleshooting ## Accessing shadowed compiler libs module `Migrate_parsetree` defines a `Compiler_libs` module that reexports all modules that could have been shadowed by `Ast_40x` modules. ## Using functions from compiler-libs results in (unfriendly) type errors Remember that because of abstraction, most values manipulated from within the rewriter have types that are unrelated to compiler-libs definitions. For instance, you cannot directly use `Pprintast.core_type` to print a type. You should first make a migration record for the version you are targeting and then lift the `core_type` instance: ```ocaml (* Assuming rewriter is written against OCaml 4.04 parsetree *) let migration = Versions.migrate Versions.ocaml_404 Versions.ocaml_current let print_core_type fmt typ = Pprintast.core_type fmt (migration.copy_core_type typ) ``` As for the error message, it contains all information needed to be polymorphic over a whole version of compiler parsetree. Pick what is relevant to your use case :-). ## Features not supported in targeted version When converting to an earlier version, some features might not be supported. In this case, the migration library will raise an exception. You can find the definition of these cases in `Migrate_parsetree.Def`. A reasonable error message is provided by default, otherwise you should catch `Migration_error` exceptions after any call to a migration function (either a call to a function from `Migrate_40x_40y` or to a field of `migrate_functions` record). Only backward migrations are partials. ### What kind of guarantees to expect in practice? The fact that migrations are partial functions can seem too restrictive. In practice, a problem only happens when an OCaml construction is used that didn't exist in the version the PPX rewriter was implemented with. This cannot occur when a new version of the compiler is released: existing code that was working before should work immediately after an update, since new features are not yet in use. This use case is the critical one for helping the introduction of a new compiler version (an opam switch should be usable readily after update). In the future, we might allow rewriting of unsupported features into extensions or attributes for rewriters that opt-in. Rewriting would succeed as long as all extensions disappeared when reaching the compiler (for instance, an OCaml 4.04 file using inline records could be rewritten by a rewriter targeting 4.02; however, a 4.02 files couldn't be rewritten by a 4.04 PPX that introduces inline records). Please voice your concerns if you have any, so that this use case is better understood.4.02 ocaml-migrate-parsetree-1.5.0/Makefile000066400000000000000000000016141356450464700177060ustar00rootroot00000000000000# This file is part of the migrate-parsetree package. It is released under the # terms of the LGPL 2.1 license (see LICENSE file). # Copyright 2017 Frédéric Bour # 2017 Jérémie Dimino INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) .PHONY: all all: dune build @install .PHONY: install install: dune install $(INSTALL_ARGS) .PHONY: uninstall uninstall: dune uninstall $(INSTALL_ARGS) .PHONY: reinstall reinstall: $(MAKE) uninstall $(MAKE) install .PHONY: test test: dune runtest .PHONY: all-supported-ocaml-versions all-supported-ocaml-versions: dune runtest --workspace dune-workspace.dev .PHONY: cinaps cinaps: cinaps -styler ocp-indent -i src/migrate_parsetree_versions.ml* cinaps -styler ocp-indent -i src/migrate_parsetree_4??_4??.ml* cinaps -styler ocp-indent -i src/migrate_parsetree.ml .PHONY: clean clean: rm -rf _build *.install find . -name .merlin -delete ocaml-migrate-parsetree-1.5.0/README.md000066400000000000000000000150221356450464700175230ustar00rootroot00000000000000# OCaml-migrate-parsetree Convert OCaml parsetrees between different major versions This library converts between parsetrees of different OCaml versions. Supported versions are 4.02, 4.03, 4.04, 4.05, 4.06, 4.07, 4.08 and 4.09. For each version, there is a snapshot of the parsetree and conversion functions to the next and/or previous version. ## Asts ```ocaml module Ast_402, Ast_403, Ast_404, Ast_405, Ast_406, Ast_407, Ast_408, Ast_409 : sig (* These two modules didn't change between compiler versions. Just share the ones from compiler-libs. *) module Location = Location module Longident = Longident (* Version specific copy of AST *) module Asttypes module Parsetree module Outcometree (* Other modules that are useful for implementing PPX. Docstrings and Ast_mapper only contain general definitions In particular, the internal state used by compiler-libs has been removed. Also equalities are lost for abstract types (Docstring.docstring). *) module Docstrings module Ast_helper module Ast_mapper (* Magic numbers used for marshalling *) module Config : sig val ast_impl_magic_number : string val ast_intf_magic_number : string end end ``` These embed copies of AST definitions for each supported OCaml major version. The AST matching the version of the OCaml toolchain will contain equalities relating the copy of types to the definitions from compiler-libs. For instance, when installed with OCaml 4.04.x, `Ast_404.Parsetree` looks like. ## Migration modules For each pair of versions `$(n)` and `$(n+1)`, the two modules `Migrate_parsetree_$(n)_$(n+1)` and `Migrate_parsetree_$(n+1)_$(n)` convert the AST forward and backward. The forward conversion is total while the backward conversion is partial: when a feature is not available in a previous version of the parsetree, a `Migrate_parsetree_def.Migration_error` exception is raised detailing the failure case. `Migrate_parsetree_versions` abstract versions of the compiler. Each version is represented as a module with `OCaml_version` signature. Instances are named `OCaml_402`, `OCaml_403`, ... `OCaml_current` is an alias to the version of the current compiler. The `Convert` functor takes two versions of OCaml and produce conversion functions. Finally, the `Migrate_parsetree_ast_io` provides an easy interface for marshalling/unmarshalling. ## Migrate_parsetree.Driver The `Migrate_parsetree.Driver` provides an API for ppx rewriters to register OCaml AST rewriters. Ppx rewriters using this API can be used as standalone rewriter executable or as part of a _driver_ including several rewriters. Using a single driver for several rewritings has the advantage that it is faster. Especially when using many ppx rewriters, it can speed up compilation a lot. If using [Dune](https://github.com/ocaml/dune), you can consult the dune manual to see how to define and use ppx rewriters. Dune automatically creates drivers based on ocaml-migrate-parsetree on demand. The rest of this section describes how to do things manually or with [ocamlbuild](https://github.com/ocaml/ocamlbuild). ## Building a custom driver using ocamlfind To build a custom driver using ocamlfind, simply link all the ppx rewriter libraries together with the `ocaml-migrate-parsetree.driver-main` package at the end: ocamlfind ocamlopt -predicates ppx_driver -o ppx -linkpkg \ -package ppx_sexp_conv -package ppx_bin_prot \ -package ocaml-migrate-parsetree.driver-main Normally, ocaml-migrate-parsetree based rewriters should be build with the approriate `-linkall` option on individual libraries. If one is missing this option, the rewriter might not get linked in. If this is the case, a workaround is to pass `-linkall` when linking the custom driver. The resulting `ppx` program can be used as follow: - `./ppx file.ml` to print the transformed code - `ocamlc -pp './ppx --as-pp' ...` to use it as a pre-processor - `ocamlc -ppx './ppx --as-ppx' ...` to use it as a `-ppx` rewriter # Development It started from the work of Alain Frisch in [ppx\_tools](https://github.com/alainfrisch/ppx_tools). The library is distributed under LGPL 2.1 and is copyright INRIA. ## Adding a new OCaml version We use [Cinaps](https://github.com/janestreet/cinaps) to generate boilerplate. You can install it via opam: `opam install cinaps`. Add the new version in [src/cinaps_helpers](https://github.com/ocaml-ppx/ocaml-migrate-parsetree/blob/master/src/cinaps_helpers) `supported_versions`. Copy the last `src/ast_xxx.ml` file to `src/ast_.ml`, then go over the file and update each sub-module by replacing its signature and implementation with the code from the compiler. For the `Config` sub-module, update the two variables with the values in `utils/config.mlp` in the compiler source tree. Once this is done, call `tools/add_special_comments.native` on the file. Then diff the `src/ast_xxx.ml` and `src/ast_.ml` and go over the diff to make sure the difference are relevant. The `ast_...` files require some adjustments which should pop up when you do this diff. Port the old adjustments to the new file as required. Add migration functions: - Manually compile the asts (`ocamlc -c src/ast_{NEW,OLD}.ml -I +compiler-libs -I _build/default/src/.migrate_parsetree.objs/byte/ -open Migrate_parsetree__`) - Using `tools/gencopy.exe` (`dune build tools/gencopy.exe`), generate copy code to and from previous version (assuming it is 408): ``` _build/default/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_409:Ast_408 Ast_409.Parsetree.{expression,expr,pattern,pat,core_type,typ,toplevel_phrase} Ast_409.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_409_408_migrate.ml _build/default/tools/gencopy.exe -I . -I src/ -I +compiler-libs -map Ast_408:Ast_409 Ast_408.Parsetree.{expression,expr,pattern,pat,core_type,typ,toplevel_phrase} Ast_408.Outcometree.{out_phrase,out_type_extension} > src/migrate_parsetree_408_409_migrate.ml ``` - Fix the generated code by implementing new cases - The migration functor expects specific names, look at `Migrate_parsetree_versions` interface. *TODO*: specialize and improve gencopy for these cases Add mapper lifting functions in the files `migrate_parsetree_NEW_408.ml` and `migrate_parsetree_408_NEW.ml`: - include the corresponding `Migrate_parsetree_40x_40y_migrate` module - define `copy_mapper` function, look at existing `Migrate_parsetree_40x_40y` for guidance. At any time, you can expand boilerplate code by running `make cinaps`. Update build system: - make sure `make cinaps` reaches a fixed point :) - `make` should succeed ocaml-migrate-parsetree-1.5.0/dune000066400000000000000000000001171356450464700171210ustar00rootroot00000000000000(install (section doc) (package ocaml-migrate-parsetree) (files MANUAL.md)) ocaml-migrate-parsetree-1.5.0/dune-project000066400000000000000000000001121356450464700205600ustar00rootroot00000000000000(lang dune 1.9) (name ocaml-migrate-parsetree) (allow_approximate_merlin) ocaml-migrate-parsetree-1.5.0/dune-workspace.dev000066400000000000000000000005551356450464700217000ustar00rootroot00000000000000(lang dune 1.0) ;; This file is used by `make all-supported-ocaml-versions` (context (opam (switch 4.02.3))) (context (opam (switch 4.03.0))) (context (opam (switch 4.04.2))) (context (opam (switch 4.05.0))) (context (opam (switch 4.06.1))) (context (opam (switch 4.07.1))) (context (opam (switch 4.08.0))) ;; (context (opam (switch ocaml-variants.4.09.0+beta1))) ocaml-migrate-parsetree-1.5.0/examples/000077500000000000000000000000001356450464700200625ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/000077500000000000000000000000001356450464700230565ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/META000066400000000000000000000006061356450464700235310ustar00rootroot00000000000000description = "ocaml-migrate-parsetree example: insert ocaml expressions from commandline" version = "1.0" requires(custom_ppx) = "ocaml-migrate-parsetree" ppx(-custom_ppx,-ppx_driver) = "./ppx_define --as-ppx" archive(byte,ppx_driver) = "ppx_define.cmo" archive(native,ppx_driver) = "ppx_define.cmx" plugin(byte,ppx_driver) = "ppx_define.cma" plugin(native,ppx_driver) = "ppx_define.cmxs" ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/Makefile000066400000000000000000000014361356450464700245220ustar00rootroot00000000000000PACKAGE=omp_ppx_define OCAMLC=ocamlfind c OCAMLOPT=ocamlfind opt FLAGS=-package ocaml-migrate-parsetree TARGETS=ppx_define ppx_define.cmo ppx_define.cmx ppx_define.cmxs all: build clean: rm -f *.o *.cm* $(TARGETS) build: $(TARGETS) install: build ocamlfind install $(PACKAGE) META $(TARGETS) uninstall: ocamlfind remove $(PACKAGE) reinstall: $(MAKE) uninstall $(MAKE) install %.cmo: %.ml $(OCAMLC) $(FLAGS) -c $^ %.cmx: %.ml $(OCAMLOPT) $(FLAGS) -c $^ ppx_define.cmxs: ppx_define.cmx $(OCAMLOPT) -o $@ -shared $^ ppx_define: ppx_define.cmx standalone.ml $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ test: ppx_define @echo "(* Original file: cat test.ml *)" @cat test.ml @echo "(* Substituted file: ./ppx_define -D 'var="hello"' test.ml *)" @./ppx_define -D 'var="hello"' test.ml ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/ppx_define.ml000066400000000000000000000045311356450464700255340ustar00rootroot00000000000000open Migrate_parsetree (********************) (* Define the rewriter on OCaml 4.05 AST *) open Ast_405 let ocaml_version = Versions.ocaml_405 (* We will need to convert parsetree of the current compiler (which is not yet known) to 4.05 one. *) let migrate = Versions.migrate Versions.ocaml_current ocaml_version (********************) (* Action of the rewriter: replace identifiers by OCaml expression. Here we define how bindings are parsed. *) let bindings : (string, Parsetree.expression) Hashtbl.t = Hashtbl.create 7 let add_binding binding = match String.index binding '=' with | exception Not_found -> let msg = Printf.sprintf "Malformed binding: %S. Binding should have form name=value" binding in raise (Arg.Bad msg) | pos -> let name = String.sub binding 0 pos in let value = let len = String.length binding in String.sub binding (pos + 1) (len - pos - 1) in let expression = (* Parse the right handside of the binding *) let lexbuf = Lexing.from_string value in (* Use compiler-libs parser to get an expression of the current version*) let expression = Parse.expression lexbuf in (* Use migrate to turn the parsetree into a 4.05 parsetree *) migrate.Versions.copy_expression expression in (* If this pipeline failed, ocaml-migrate-parsetree driver will catch the exception and report it to the user. *) Hashtbl.replace bindings name expression let args_spec = [ "-D", Arg.String add_binding, " Replace identifier by the ocaml expression " ] let reset_args () = Hashtbl.clear bindings (********************) (* The rewriter itself *) let mapper _config _cookies = let open Ast_mapper in let open Ast_helper in let expr mapper pexp = match pexp.Parsetree.pexp_desc with | Parsetree.Pexp_ident {Location.txt = Longident.Lident name; loc} -> begin match Hashtbl.find bindings name with | exception Not_found -> default_mapper.expr mapper pexp | expr' -> {expr' with Parsetree.pexp_loc = loc} end | _ -> default_mapper.expr mapper pexp in {default_mapper with expr} (********************) (* Registration *) let () = Driver.register ~name:"ppx_here" ~args:args_spec ~reset_args ocaml_version mapper ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/standalone.ml000066400000000000000000000001641356450464700255410ustar00rootroot00000000000000open Migrate_parsetree (* To run as a standalone binary, run the registered drivers *) let () = Driver.run_main () ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_define/test.ml000066400000000000000000000000331356450464700243630ustar00rootroot00000000000000let () = print_endline var ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_here/000077500000000000000000000000001356450464700225475ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_here/META000066400000000000000000000005571356450464700232270ustar00rootroot00000000000000description = "ocaml-migrate-parsetree example: replace __HERE__ by location" version = "1.0" requires(custom_ppx) = "ocaml-migrate-parsetree" ppx(-custom_ppx,-ppx_driver) = "./ppx_here --as-ppx" archive(byte,ppx_driver) = "ppx_here.cmo" archive(native,ppx_driver) = "ppx_here.cmx" plugin(byte,ppx_driver) = "ppx_here.cma" plugin(native,ppx_driver) = "ppx_here.cmxs" ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_here/Makefile000066400000000000000000000011231356450464700242040ustar00rootroot00000000000000PACKAGE=omp_ppx_here OCAMLC=ocamlfind c OCAMLOPT=ocamlfind opt FLAGS=-package ocaml-migrate-parsetree TARGETS=ppx_here ppx_here.cmo ppx_here.cmx ppx_here.cmxs all: build clean: rm -f *.o *.cm* $(TARGETS) build: $(TARGETS) install: build ocamlfind install $(PACKAGE) META $(TARGETS) uninstall: ocamlfind remove $(PACKAGE) reinstall: $(MAKE) uninstall $(MAKE) install %.cmo: %.ml $(OCAMLC) $(FLAGS) -c $^ %.cmx: %.ml $(OCAMLOPT) $(FLAGS) -c $^ ppx_here.cmxs: ppx_here.cmx $(OCAMLOPT) -o $@ -shared $^ ppx_here: ppx_here.cmx standalone.ml $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_here/ppx_here.ml000066400000000000000000000020611356450464700247120ustar00rootroot00000000000000open Migrate_parsetree (* Define the rewriter on OCaml 4.05 AST *) open Ast_405 let ocaml_version = Versions.ocaml_405 (* Action of the rewriter: replace __HERE__ expression by a tuple ("filename", line, col) *) let mapper _config _cookies = let open Ast_mapper in let open Ast_helper in let expr mapper pexp = match pexp.Parsetree.pexp_desc with | Parsetree.Pexp_ident {Location.txt = Longident.Lident "__HERE__"; loc} -> let {Lexing. pos_fname; pos_lnum; pos_cnum; pos_bol} = loc.Location.loc_start in let loc = {loc with Location.loc_ghost = true} in let fname = Exp.constant ~loc (Const.string pos_fname) in let line = Exp.constant ~loc (Const.int pos_lnum) in let col = Exp.constant ~loc (Const.int (pos_cnum - pos_bol)) in {pexp with Parsetree.pexp_desc = Parsetree.Pexp_tuple [fname; line; col]} | _ -> default_mapper.expr mapper pexp in {default_mapper with expr} (* Register the rewriter in the driver *) let () = Driver.register ~name:"ppx_here" ocaml_version mapper ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_here/standalone.ml000066400000000000000000000001641356450464700252320ustar00rootroot00000000000000open Migrate_parsetree (* To run as a standalone binary, run the registered drivers *) let () = Driver.run_main () ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/000077500000000000000000000000001356450464700227365ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/META000066400000000000000000000005351356450464700234120ustar00rootroot00000000000000description = "Parse strings into fragment of the AST" version = "1.0" requires(custom_ppx) = "ocaml-migrate-parsetree" ppx(-custom_ppx,-ppx_driver) = "./ppx_parse --as-ppx" archive(byte,ppx_driver) = "ppx_parse.cmo" archive(native,ppx_driver) = "ppx_parse.cmx" plugin(byte,ppx_driver) = "ppx_parse.cma" plugin(native,ppx_driver) = "ppx_parse.cmxs" ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/Makefile000066400000000000000000000011301356450464700243710ustar00rootroot00000000000000PACKAGE=ppx_parse OCAMLC=ocamlfind c OCAMLOPT=ocamlfind opt FLAGS=-package ocaml-migrate-parsetree TARGETS=ppx_parse ppx_parse.cmo ppx_parse.cmx ppx_parse.cmxs all: build clean: rm -f *.o *.cm* $(TARGETS) build: $(TARGETS) install: build ocamlfind install $(PACKAGE) META $(TARGETS) uninstall: ocamlfind remove $(PACKAGE) reinstall: $(MAKE) uninstall $(MAKE) install %.cmo: %.ml $(OCAMLC) $(FLAGS) -c $^ %.cmx: %.ml $(OCAMLOPT) $(FLAGS) -c $^ ppx_parse.cmxs: ppx_parse.cmx $(OCAMLOPT) -o $@ -shared $^ ppx_parse: ppx_parse.cmx standalone.ml $(OCAMLOPT) $(FLAGS) -o $@ -linkpkg $^ ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/ppx_parse.ml000066400000000000000000000021571356450464700252760ustar00rootroot00000000000000open Migrate_parsetree (* Define the rewriter on OCaml 4.04 AST *) open Ast_404 let ocaml_version = Versions.ocaml_404 let from_current = Versions.migrate Versions.ocaml_current ocaml_version let prepare_lexbuf pos source = let lexbuf = Lexing.from_string source in lexbuf.Lexing.lex_curr_p <- pos; lexbuf let prepare_for_parsing pexp = let open Parsetree in match pexp.pexp_desc with | Pexp_constant (Pconst_string (source, Some "quote")) -> let pos = let pos = pexp.pexp_loc.Location.loc_start in let pos_cnum = pos.Lexing.pos_cnum + String.length "{quote|" in {pos with Lexing.pos_cnum} in Some (prepare_lexbuf pos source) | _ -> None let mapper _config _cookies = let open Ast_mapper in let open Ast_helper in let expr mapper pexp = let pexp = default_mapper.expr mapper pexp in match prepare_for_parsing pexp with | Some lexbuf -> from_current.Versions.copy_expression (Parse.expression lexbuf) | None -> pexp in {default_mapper with expr} (* Register the rewriter in the driver *) let () = Driver.register ~name:"ppx_parse" ocaml_version mapper ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/standalone.ml000066400000000000000000000001641356450464700254210ustar00rootroot00000000000000open Migrate_parsetree (* To run as a standalone binary, run the registered drivers *) let () = Driver.run_main () ocaml-migrate-parsetree-1.5.0/examples/omp_ppx_parse/test.ml000066400000000000000000000000641356450464700242470ustar00rootroot00000000000000let _ = {quote| let x = 5 in () |quote} ocaml-migrate-parsetree-1.5.0/ocaml-migrate-parsetree.opam000066400000000000000000000017261356450464700236410ustar00rootroot00000000000000opam-version: "2.0" maintainer: "frederic.bour@lakaban.net" authors: [ "Frédéric Bour " "Jérémie Dimino " ] license: "LGPL-2.1 with OCaml linking exception" homepage: "https://github.com/ocaml-ppx/ocaml-migrate-parsetree" bug-reports: "https://github.com/ocaml-ppx/ocaml-migrate-parsetree/issues" dev-repo: "git+https://github.com/ocaml-ppx/ocaml-migrate-parsetree.git" doc: "https://ocaml-ppx.github.io/ocaml-migrate-parsetree/" tags: [ "syntax" "org:ocamllabs" ] build: [ ["dune" "build" "-p" name "-j" jobs] ] depends: [ "result" "ppx_derivers" "dune" {build & >= "1.9.0"} "ocaml" {>= "4.02.3"} ] synopsis: "Convert OCaml parsetrees between different versions" description: """ Convert OCaml parsetrees between different versions This library converts parsetrees, outcometree and ast mappers between different OCaml versions. High-level functions help making PPX rewriters independent of a compiler version. """ ocaml-migrate-parsetree-1.5.0/src/000077500000000000000000000000001356450464700170335ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/src/ast_402.ml000066400000000000000000003177121356450464700205540ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Location = Location module Longident = Longident module Asttypes = struct (* Auxiliary a.s.t. types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes (** {2 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {2 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of label * core_type * core_type (* T1 -> T2 (label = "") ~l:T1 -> T2 (label = "l") ?l:T1 -> T2 (label = "?l") *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of (string * attributes * core_type) list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of label * expression option * pattern * expression (* fun P -> E1 (lab = "", None) fun ~l:P -> E1 (lab = "l", None) fun ?l:P -> E1 (lab = "?l", None) fun ?l:(P = E0) -> E1 (lab = "?l", Some E0) Notes: - If E0 is provided, lab must start with '?'. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * string (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of string loc * expression (* x <- 2 *) | Pexp_override of (string loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) Note: when used under Pstr_primitive, prim cannot be empty *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list (* Invariant: non-empty list *) | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l [@id1] [@id2] : T *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: core_type list; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) } (* | C of T1 * ... * Tn (res = None) | C: T0 (args = [], res = Some T0) | C: T1 * ... * Tn -> T0 (res = Some T0) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C [@id1] [@id2] of ... *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of core_type list * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {2 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of label * core_type * class_type (* T -> CT (label = "") ~l:T -> CT (label = "l") ?l:T -> CT (label = "?l") *) | Pcty_extension of extension (* [%id] *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (string * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (string * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of label * expression option * pattern * class_expr (* fun P -> CE (lab = "", None) fun ~l:P -> CE (lab = "l", None) fun ?l:P -> CE (lab = "?l", None) fun ?l:(P = E0) -> CE (lab = "?l", Some E0) *) | Pcl_apply of class_expr * (label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (string loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (string loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {2 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of type_declaration (* with type t := ... *) | Pwith_modsubst of string loc * Longident.t loc (* with module X := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* external x: T = "s1" ... "sn" *) | Pstr_type of type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {2 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of int | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {3 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {3 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {3 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {3 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Asttypes in let open Parsetree in let exp = { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Asttypes in let open Parsetree in let exp = { pexp_desc = Pexp_constant (Const_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Parsetree open Asttypes open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {2 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {2 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> (string * attributes * core_type) list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:core_type list -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:core_type list -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {2 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (* Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (* Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {2 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc a = mk ?loc (Psig_type a) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc a = mk ?loc (Pstr_type a) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {2 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {2 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in object_ ~loc ~attrs (List.map f l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(List.map (sub.typ sub) ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type l -> type_ ~loc (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type l -> type_ ~loc (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(List.map (this.typ this) pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Asttypes.Const_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Asttypes.Const_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_name of out_ident * out_type list type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of string * out_type * string list and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status*) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M016" let ast_intf_magic_number = "Caml1999N015" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_403.ml000066400000000000000000003263531356450464700205560ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Location = Location module Longident = Longident module Asttypes = struct (* Auxiliary a.s.t. types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {2 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {2 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Otional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of (string * attributes * core_type) list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * string (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of string loc * expression (* x <- 2 *) | Pexp_override of (string loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list (* Invariant: non-empty list *) | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l [@id1] [@id2] : T *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C [@id1] [@id2] of ... *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {2 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (string * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (string * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (string loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (string loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {2 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of type_declaration (* with type t := ... *) | Pwith_modsubst of string loc * Longident.t loc (* with module X := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {2 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {3 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {3 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {3 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {3 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Asttypes open Docstrings open Parsetree type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {2 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {2 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {2 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> (string * attributes * core_type) list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {2 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (* Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (* Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {2 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (string_of_int i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {2 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {2 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in object_ ~loc ~attrs (List.map f l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_name of out_ident * out_type list type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M019" let ast_intf_magic_number = "Caml1999N018" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_404.ml000066400000000000000000003303701356450464700205510ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Location = Location module Longident = Longident module Asttypes = struct (** Auxiliary AST types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {2 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {2 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Otional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of (string * attributes * core_type) list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * string (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of string loc * expression (* x <- 2 *) | Pexp_override of (string loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list (* Invariant: non-empty list *) | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l [@id1] [@id2] : T *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C [@id1] [@id2] of ... *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {2 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (string * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (string * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (string loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (string loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {2 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of type_declaration (* with type t := ... *) | Pwith_modsubst of string loc * Longident.t loc (* with module X := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {2 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {3 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {3 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {3 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {3 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Asttypes open Docstrings open Parsetree type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {2 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {2 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {2 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> (string * attributes * core_type) list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> string list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> string -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> string -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {2 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {2 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> string -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> string -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> string option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (string_of_int i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {2 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {2 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> let f (s, a, t) = (s, sub.attributes sub a, sub.typ sub t) in object_ ~loc ~attrs (List.map f l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs sl (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs s p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) s | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs s (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_name of out_ident * out_type list type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M020" let ast_intf_magic_number = "Caml1999N018" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_405.ml000066400000000000000000003357251356450464700205630ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Location = Location module Longident = Longident module Asttypes = struct (** Auxiliary AST types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {2 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {2 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Otional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of (string loc * attributes * core_type) list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * string loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of string loc * expression (* x <- 2 *) | Pexp_override of (string loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* M.(E) let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list (* Invariant: non-empty list *) | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l [@id1] [@id2] : T *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C [@id1] [@id2] of ... *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C [@id1] [@id2] of ... *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {2 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (string loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (string loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (string loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (string loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {2 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of type_declaration (* with type t := ... *) | Pwith_modsubst of string loc * Longident.t loc (* with module X := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {2 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {3 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {3 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {3 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {3 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Asttypes open Docstrings open Parsetree type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {2 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {2 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {2 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> (str * attributes * core_type) list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {2 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {2 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (string_of_int i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s; _ }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map (fun (s, attrs, t) -> (s, attrs, loop t)) lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field = function | Rtag(label,attrs,flag,lst) -> Rtag(label,attrs,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {2 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {2 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> let f (s, a, t) = (map_loc sub s, sub.attributes sub a, sub.typ sub t) in object_ ~loc ~attrs (List.map f l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst d -> Pwith_typesubst (sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M020" let ast_intf_magic_number = "Caml1999N018" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_406.ml000066400000000000000000003411561356450464700205570ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Ast ported on Mon Oct 2 11:25:57 CEST 2017 OCaml trunk was: commit 65940a2c6be43c42f75c6c6b255974f7e6de03ca (HEAD -> 4.06, origin/4.06) Author: Christophe Raffalli Date: Sun Oct 1 18:27:07 2017 +0200 fixed position of last optional last semicolumn in sequence (#1387) *) module Location = Location module Longident = Longident module Asttypes = struct (** Auxiliary AST types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {2 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {2 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Optional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of object_field list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label loc * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) and object_field (*IF_CURRENT = Parsetree.object_field *) = | Otag of label loc * attributes * core_type | Oinherit of core_type (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * label loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of label loc * expression (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* M.(E) let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list (* Invariant: non-empty list *) | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l : T [@id1] [@id2] *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {2 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) | Pcty_open of override_flag * Longident.t loc * class_type (* let open M in CT *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (label loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) | Pcl_open of override_flag * Longident.t loc * class_expr (* let open M in CE *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (label loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (label loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {2 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc (* with module X.Y := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {2 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {3 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {3 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {3 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {3 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Asttypes open Docstrings open Parsetree type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {2 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {2 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {2 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {2 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {2 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (string_of_int i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s; _ }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field = function | Rtag(label,attrs,flag,lst) -> Rtag(label,attrs,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) and loop_object_field = function | Otag(label, attrs, t) -> Otag(label, attrs, loop t) | Oinherit t -> Oinherit (loop t) in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {2 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {2 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (map_loc sub l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let object_field sub = function | Otag (l, attrs, t) -> Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t) | Oinherit t -> Oinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (object_field sub) l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcty_open (ovf, lid, ct) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcl_open (ovf, lid, ce) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_string (*IF_CURRENT = Outcometree.out_string *) = | Ostr_string | Ostr_bytes type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string * int * out_string (* string, size-to-print, kind *) | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M022" let ast_intf_magic_number = "Caml1999N022" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_407.ml000066400000000000000000003432611356450464700205570ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour, Facebook *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2018 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Ast ported on Wed Apr 18 10:33:29 BST 2018 OCaml trunk was: commit c0bd6a27e138911560f43dc75d5fde2ade4d6cfe (HEAD, tag: 4.07.0+beta2) Author: Damien Doligez Date: Tue Apr 10 14:50:48 2018 +0200 change VERSION for 4.07.0+beta2 *) module Location = Location module Longident = Longident module Asttypes = struct (** Auxiliary AST types used by parsetree and typedtree. *) type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct (** Abstract syntax tree produced by parsing *) open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {1 Extension points} *) type attribute = string loc * payload (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {1 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Optional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of object_field list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = | Rtag of label loc * attributes * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 2nd field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) - TODO: switch to a record representation, and keep location *) | Rinherit of core_type (* [ T ] *) and object_field (*IF_CURRENT = Parsetree.object_field *) = | Otag of label loc * attributes * core_type | Oinherit of core_type (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * label loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of label loc * expression (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of override_flag * Longident.t loc * expression (* M.(E) let open M in E let! open M in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l : T [@id1] [@id2] *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {1 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) | Pcty_open of override_flag * Longident.t loc * class_type (* let open M in CT *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (label loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) | Pcl_open of override_flag * Longident.t loc * class_expr (* let open M in CE *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (label loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (label loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {1 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of extension_constructor (* exception C of T *) | Psig_module of module_declaration (* module X : MT *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and open_description (*IF_CURRENT = Parsetree.open_description *) = { popen_lid: Longident.t loc; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc (* with module X.Y := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of extension_constructor (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_description (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {1 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of string * directive_argument (* #use, #load ... *) and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = | Pdir_none | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** {2 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {2 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** {2 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** {2 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val empty_text_lazy : text Lazy.t val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes end = struct open Location (* Docstrings *) type docstring = { ds_body: string; ds_loc: Location.t; } (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; } in ds let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (doc_loc, PStr [item]) let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let empty_text_lazy = lazy [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in (text_loc, PStr [item]) let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs end module Ast_helper : sig (** Helpers to produce Parsetree fragments *) open Asttypes open Docstrings open Parsetree type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list (** {1 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {1 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {1 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {1 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> extension_constructor -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> extension_constructor -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_description -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> lid -> open_description end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {1 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_type -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr val open_: ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> class_expr -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end end = struct (**************************************************************************) (* *) (* OCaml *) (* *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2012 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Helpers to produce Parsetree fragments *) open Asttypes open Parsetree open Docstrings type lid = Longident.t loc type str = string loc type loc = Location.t type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = let old = !default_loc in default_loc := l; try let r = f () in default_loc := old; r with exn -> default_loc := old; raise exn module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (string_of_int i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s; _ }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field = function | Rtag(label,attrs,flag,lst) -> Rtag(label,attrs,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) and loop_object_field = function | Otag(label, attrs, t) -> Otag(label, attrs, loop t) | Oinherit t -> Oinherit (loop t) in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_open (a, b, c)) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_open (a, b, c)) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) lid = { popen_lid = lid; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end end module Ast_mapper : sig (** The interface of a -ppx rewriter A -ppx rewriter is a program that accepts a serialized abstract syntax tree and outputs another, possibly modified, abstract syntax tree. This module encapsulates the interface between the compiler and the -ppx rewriters, handling such details as the serialization format, forwarding of command-line flags, and storing state. {!mapper} allows to implement AST rewriting using open recursion. A typical mapper would be based on {!default_mapper}, a deep identity mapper, and will fall back on it for handling the syntax it does not modify. For example: {[ open Asttypes open Parsetree open Ast_mapper let test_mapper argv = { default_mapper with expr = fun mapper expr -> match expr with | { pexp_desc = Pexp_extension ({ txt = "test" }, PStr [])} -> Ast_helper.Exp.constant (Const_int 42) | other -> default_mapper.expr mapper other; } let () = register "ppx_test" test_mapper]} This -ppx rewriter, which replaces [[%test]] in expressions with the constant [42], can be compiled using [ocamlc -o ppx_test -I +compiler-libs ocamlcommon.cma ppx_test.ml]. *) open Parsetree (** {1 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {1 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf end = struct (* A generic Parsetree mapping class *) (* [@@@ocaml.warning "+9"] (* Ensure that record patterns don't miss any field. *) *) open Parsetree open Ast_helper open Location type mapper (*IF_CURRENT = Ast_mapper.mapper*) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub = function | Rtag (l, attrs, b, tl) -> Rtag (map_loc sub l, sub.attributes sub attrs, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) let object_field sub = function | Otag (l, attrs, t) -> Otag (map_loc sub l, sub.attributes sub attrs, sub.typ sub t) | Oinherit t -> Oinherit (sub.typ sub t) let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (object_field sub) l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = Type.mk (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) ~loc:(sub.location sub ptype_loc) ~attrs:(sub.attributes sub ptype_attributes) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_attributes} = Te.mk (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private ~attrs:(sub.attributes sub ptyext_attributes) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = Te.constructor (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) ~loc:(sub.location sub pext_loc) ~attrs:(sub.attributes sub pext_attributes) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcty_open (ovf, lid, ct) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> eval ~loc ~attrs:(sub.attributes sub attrs) (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.extension_constructor sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_description sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (ovf, lid, e) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcl_open (ovf, lid, ce) -> open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = Ci.mk ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) ~loc:(sub.location sub pci_loc) ~attrs:(sub.attributes sub pci_attributes) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_description = (fun this {popen_lid; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_lid) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this (s, e) -> (map_loc this s, this.payload this e)); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(function | x :: l -> PStr (x :: x :: l) | l -> PStr l) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = { loc; txt = "ocaml.ppwarning" }, PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))]) include Locations.Helpers_impl end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of string type out_string (*IF_CURRENT = Outcometree.out_string *) = | Ostr_string | Ostr_bytes type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string * int * out_string (* string, size-to-print, kind *) | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of string * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M023" let ast_intf_magic_number = "Caml1999N023" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_408.ml000066400000000000000000004377051356450464700205670ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour, Facebook *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2018 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Ast ported on Thu Mar 21 09:50:42 GMT 2019 OCaml was: commit 55c9ba466362f303eb4d5ed511f6fda142879137 (HEAD -> 4.08, origin/4.08) Author: Nicolás Ojeda Bär Date: Tue Mar 19 08:11:02 2019 +0100 Merge pull request #8521 from nojb/fix_unix_tests_408 Actually run all lib-unix tests [4.08] *) open Stdlib0 open Ast_408_helper module Location = Location module Longident = Longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {1 Extension points} *) type attribute (*IF_CURRENT = Parsetree.attribute *) = { attr_name : string loc; attr_payload : payload; attr_loc : Location.t; } (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {1 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_loc_stack: Location.t list; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and typ = core_type and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Optional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of object_field list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = { prf_desc : row_field_desc; prf_loc : Location.t; prf_attributes : attributes; } and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) = | Rtag of label loc * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 'bool' field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) *) | Rinherit of core_type (* [ T ] *) and object_field (*IF_CURRENT = Parsetree.object_field *) = { pof_desc : object_field_desc; pof_loc : Location.t; pof_attributes : attributes; } and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) = | Otag of label loc * core_type | Oinherit of core_type (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_loc_stack: Location.t list; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pat = pattern and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_loc_stack: Location.t list; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expr = expression and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of cases (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * cases (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * cases (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * label loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of label loc * expression (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of open_declaration * expression (* M.(E) let open M in E let! open M in E *) | Pexp_letop of letop (* let* P = E in E let* P = E and* P = E in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } and cases = case list and letop (*IF_CURRENT = Parsetree.letop *) = { let_ : binding_op; ands : binding_op list; body : expression; } and binding_op (*IF_CURRENT = Parsetree.binding_op *) = { pbop_op : string loc; pbop_pat : pattern; pbop_exp : expression; pbop_loc : Location.t; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l : T [@id1] [@id2] *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_loc: Location.t; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } (* exception E *) and type_exception (*IF_CURRENT = Parsetree.type_exception *) = { ptyexn_constructor: extension_constructor; ptyexn_loc: Location.t; ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {1 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) | Pcty_open of open_description * class_type (* let open M in CT *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (label loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) | Pcl_open of open_description * class_expr (* let open M in CE *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (label loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (label loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {1 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typesubst of type_declaration list (* type t1 := ... and ... and tn := ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of type_exception (* exception C of T *) | Psig_module of module_declaration (* module X = M module X : MT *) | Psig_modsubst of module_substitution (* module X := M *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) = { pms_name: string loc; pms_manifest: Longident.t loc; pms_attributes: attributes; (* ... [@@id1] [@@id2] *) pms_loc: Location.t; } and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) = { popen_expr: 'a; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and open_description = Longident.t loc open_infos (* open M.N open M(N).O *) and open_declaration = module_expr open_infos (* open M.N open M(N).O open struct ... end *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc (* with module X.Y := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of type_exception (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_declaration (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {1 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of toplevel_directive (* #use, #load ... *) and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) = { pdir_name : string loc; pdir_arg : directive_argument option; pdir_loc : Location.t; } and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = { pdira_desc : directive_argument_desc; pdira_loc : Location.t; } and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) = | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** (Re)Initialise all docstring state *) val init : unit -> unit (** Emit warnings for unattached and ambiguous docstrings *) val warn_bad_docstrings : unit -> unit (** {2 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Register a docstring *) val register : docstring -> unit (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {2 Set functions} These functions are used by the lexer to associate docstrings to the locations of tokens. *) (** Docstrings immediately preceding a token *) val set_pre_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following a token *) val set_post_docstrings : Lexing.position -> docstring list -> unit (** Docstrings not immediately adjacent to a token *) val set_floating_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following the token which precedes this one *) val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately preceding the token which follows this one *) val set_post_extra_docstrings : Lexing.position -> docstring list -> unit (** {2 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : unit -> docs val symbol_docs_lazy : unit -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : int -> int -> docs val rhs_docs_lazy : int -> int -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : unit -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : int -> int -> unit (** {2 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** Fetch the field info for the current symbol. *) val symbol_info : unit -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : int -> info (** {2 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val empty_text_lazy : text Lazy.t val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes (** Fetch the text preceding the current symbol. *) val symbol_text : unit -> text val symbol_text_lazy : unit -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : int -> text val rhs_text_lazy : int -> text Lazy.t (** {2 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : unit -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : unit -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : int -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : int -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : int -> text module WithMenhir: sig (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : Lexing.position * Lexing.position -> docs val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : Lexing.position -> Lexing.position -> docs val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : Lexing.position * Lexing.position -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : Lexing.position -> Lexing.position -> unit (** Fetch the field info for the current symbol. *) val symbol_info : Lexing.position -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : Lexing.position -> info (** Fetch the text preceding the current symbol. *) val symbol_text : Lexing.position -> text val symbol_text_lazy : Lexing.position -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : Lexing.position -> text val rhs_text_lazy : Lexing.position -> text Lazy.t (** {3 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : Lexing.position -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : Lexing.position -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : Lexing.position -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : Lexing.position -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : Lexing.position -> text end end = struct open Location (* Docstrings *) (* A docstring is "attached" if it has been inserted in the AST. This is used for generating unexpected docstring warnings. *) type ds_attached = | Unattached (* Not yet attached anything.*) | Info (* Attached to a field or constructor. *) | Docs (* Attached to an item or as floating text. *) (* A docstring is "associated" with an item if there are no blank lines between them. This is used for generating docstring ambiguity warnings. *) type ds_associated = | Zero (* Not associated with an item *) | One (* Associated with one item *) | Many (* Associated with multiple items (ambiguity) *) type docstring = { ds_body: string; ds_loc: Location.t; mutable ds_attached: ds_attached; mutable ds_associated: ds_associated; } (* List of docstrings *) let docstrings : docstring list ref = ref [] (* Warn for unused and ambiguous docstrings *) let warn_bad_docstrings () = if Warnings.is_active (Warnings.Bad_docstring true) then begin List.iter (fun ds -> match ds.ds_attached with | Info -> () | Unattached -> prerr_warning ds.ds_loc (Warnings.Bad_docstring true) | Docs -> match ds.ds_associated with | Zero | One -> () | Many -> prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) (List.rev !docstrings) end (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; ds_attached = Unattached; ds_associated = Zero; } in ds let register ds = docstrings := ds :: !docstrings let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = doc_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let empty_text_lazy = lazy [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = text_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs (* Find the first non-info docstring in a list, attach it and return it *) let get_docstring ~info dsl = let rec loop = function | [] -> None | {ds_attached = Info; _} :: rest -> loop rest | ds :: _ -> ds.ds_attached <- if info then Info else Docs; Some ds in loop dsl (* Find all the non-info docstrings in a list, attach them and return them *) let get_docstrings dsl = let rec loop acc = function | [] -> List.rev acc | {ds_attached = Info; _} :: rest -> loop acc rest | ds :: rest -> ds.ds_attached <- Docs; loop (ds :: acc) rest in loop [] dsl (* "Associate" all the docstrings in a list *) let associate_docstrings dsl = List.iter (fun ds -> match ds.ds_associated with | Zero -> ds.ds_associated <- One | (One | Many) -> ds.ds_associated <- Many) dsl (* Map from positions to pre docstrings *) let pre_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_table pos dsl let get_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl with Not_found -> () (* Map from positions to post docstrings *) let post_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_table pos dsl let get_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl with Not_found -> () let get_info pos = try let dsl = Hashtbl.find post_table pos in get_docstring ~info:true dsl with Not_found -> None (* Map from positions to floating docstrings *) let floating_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_floating_docstrings pos dsl = if dsl <> [] then Hashtbl.add floating_table pos dsl let get_text pos = try let dsl = Hashtbl.find floating_table pos in get_docstrings dsl with Not_found -> [] let get_post_text pos = try let dsl = Hashtbl.find post_table pos in get_docstrings dsl with Not_found -> [] (* Maps from positions to extra docstrings *) let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_extra_table pos dsl let get_pre_extra_text pos = try let dsl = Hashtbl.find pre_extra_table pos in get_docstrings dsl with Not_found -> [] let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_extra_table pos dsl let get_post_extra_text pos = try let dsl = Hashtbl.find post_extra_table pos in get_docstrings dsl with Not_found -> [] (* Docstrings from parser actions *) module WithParsing = struct let symbol_docs () = { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); docs_post = get_post_docs (Parsing.symbol_end_pos ()); } let symbol_docs_lazy () = let p1 = Parsing.symbol_start_pos () in let p2 = Parsing.symbol_end_pos () in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } let rhs_docs_lazy pos1 pos2 = let p1 = Parsing.rhs_start_pos pos1 in let p2 = Parsing.rhs_end_pos pos2 in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs () = mark_pre_docs (Parsing.symbol_start_pos ()); mark_post_docs (Parsing.symbol_end_pos ()) let mark_rhs_docs pos1 pos2 = mark_pre_docs (Parsing.rhs_start_pos pos1); mark_post_docs (Parsing.rhs_end_pos pos2) let symbol_info () = get_info (Parsing.symbol_end_pos ()) let rhs_info pos = get_info (Parsing.rhs_end_pos pos) let symbol_text () = get_text (Parsing.symbol_start_pos ()) let symbol_text_lazy () = let pos = Parsing.symbol_start_pos () in lazy (get_text pos) let rhs_text pos = get_text (Parsing.rhs_start_pos pos) let rhs_post_text pos = get_post_text (Parsing.rhs_end_pos pos) let rhs_text_lazy pos = let pos = Parsing.rhs_start_pos pos in lazy (get_text pos) let symbol_pre_extra_text () = get_pre_extra_text (Parsing.symbol_start_pos ()) let symbol_post_extra_text () = get_post_extra_text (Parsing.symbol_end_pos ()) let rhs_pre_extra_text pos = get_pre_extra_text (Parsing.rhs_start_pos pos) let rhs_post_extra_text pos = get_post_extra_text (Parsing.rhs_end_pos pos) end include WithParsing module WithMenhir = struct let symbol_docs (startpos, endpos) = { docs_pre = get_pre_docs startpos; docs_post = get_post_docs endpos; } let symbol_docs_lazy (p1, p2) = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs pos1; docs_post = get_post_docs pos2; } let rhs_docs_lazy p1 p2 = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs (startpos, endpos) = mark_pre_docs startpos; mark_post_docs endpos; () let mark_rhs_docs pos1 pos2 = mark_pre_docs pos1; mark_post_docs pos2; () let symbol_info endpos = get_info endpos let rhs_info endpos = get_info endpos let symbol_text startpos = get_text startpos let symbol_text_lazy startpos = lazy (get_text startpos) let rhs_text pos = get_text pos let rhs_post_text pos = get_post_text pos let rhs_text_lazy pos = lazy (get_text pos) let symbol_pre_extra_text startpos = get_pre_extra_text startpos let symbol_post_extra_text endpos = get_post_extra_text endpos let rhs_pre_extra_text pos = get_pre_extra_text pos let rhs_post_extra_text pos = get_post_extra_text pos end (* (Re)Initialise all comment state *) let init () = docstrings := []; Hashtbl.reset pre_table; Hashtbl.reset post_table; Hashtbl.reset floating_table; Hashtbl.reset pre_extra_table; Hashtbl.reset post_extra_table end module Ast_helper : sig open Asttypes open Docstrings open Parsetree type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type attrs = attribute list (** {1 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {1 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {1 Attributes} *) module Attr : sig val mk: ?loc:loc -> str -> payload -> attribute end (** {1 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> cases -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression -> expression val letop: ?loc:loc -> ?attrs:attrs -> binding_op -> binding_op list -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case val binding_op: str -> pattern -> expression -> loc -> binding_op end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> extension_constructor -> type_exception val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {1 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_subst: ?loc:loc -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> type_exception -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val mod_subst: ?loc:loc -> module_substitution -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> type_exception -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_declaration -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module substitutions *) module Ms: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> lid -> module_substitution end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> 'a -> 'a open_infos end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {1 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end (** Row fields *) module Rf: sig val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> bool -> core_type list -> row_field val inherit_: ?loc:loc -> core_type -> row_field end (** Object fields *) module Of: sig val mk: ?loc:loc -> ?attrs:attrs -> object_field_desc -> object_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> core_type -> object_field val inherit_: ?loc:loc -> core_type -> object_field end end = struct open Asttypes open Parsetree open Docstrings type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = Misc.protect_refs [Misc.R (default_loc, l)] f module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (Int.to_string i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Attr = struct let mk ?(loc= !default_loc) name payload = { attr_name = name; attr_payload = payload; attr_loc = loc } end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_loc_stack = []; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s; _ }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field field = let prf_desc = match field.prf_desc with | Rtag(label,flag,lst) -> Rtag(label,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) in { field with prf_desc; } and loop_object_field field = let pof_desc = match field.pof_desc with | Otag(label, t) -> Otag(label, loop t) | Oinherit t -> Oinherit (loop t) in { field with pof_desc; } in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_loc_stack = []; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_loc_stack = []; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) let letop ?loc ?attrs let_ ands body = mk ?loc ?attrs (Pexp_letop {let_; ands; body}) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } let binding_op op pat exp loc = { pbop_op = op; pbop_pat = pat; pbop_exp = exp; pbop_loc = loc; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_subst ?loc a = mk ?loc (Psig_typesubst a) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let mod_subst ?loc a = mk ?loc (Psig_modsubst a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Ms = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name syn = { pms_name = name; pms_manifest = syn; pms_attributes = add_text_attrs text (add_docs_attrs docs attrs); pms_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) expr = { popen_expr = expr; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_loc = loc; ptyext_attributes = add_docs_attrs docs attrs; } let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) constructor = { ptyexn_constructor = constructor; ptyexn_loc = loc; ptyexn_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end (** Row fields *) module Rf = struct let mk ?(loc = !default_loc) ?(attrs = []) desc = { prf_desc = desc; prf_loc = loc; prf_attributes = attrs; } let tag ?loc ?attrs label const tys = mk ?loc ?attrs (Rtag (label, const, tys)) let inherit_?loc ty = mk ?loc (Rinherit ty) end (** Object fields *) module Of = struct let mk ?(loc = !default_loc) ?(attrs=[]) desc = { pof_desc = desc; pof_loc = loc; pof_attributes = attrs; } let tag ?loc ?attrs label ty = mk ?loc ?attrs (Otag (label, ty)) let inherit_ ?loc ty = mk ?loc (Oinherit ty) end end module Ast_mapper : sig open Parsetree (** {1 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> cases -> cases; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {1 Apply mappers to compilation units} *) val tool_name: unit -> string (** Can be used within a ppx preprocessor to know which tool is calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], ["ocaml"], ... Some global variables that reflect command-line options are automatically synchronized between the calling tool and the ppx preprocessor: {!Clflags.include_dirs}, {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, {!Clflags.debug}. *) val apply: source:string -> target:string -> mapper -> unit (** Apply a mapper (parametrized by the unit name) to a dumped parsetree found in the [source] file and put the result in the [target] file. The [structure] or [signature] field of the mapper is applied to the implementation or interface. *) val run_main: (string list -> mapper) -> unit (** Entry point to call to implement a standalone -ppx rewriter from a mapper, parametrized by the command line arguments. The current unit name can be obtained from {!Location.input_name}. This function implements proper error reporting for uncaught exceptions. *) (** {1 Registration API} *) val register_function: (string -> (string list -> mapper) -> unit) ref val register: string -> (string list -> mapper) -> unit (** Apply the [register_function]. The default behavior is to run the mapper immediately, taking arguments from the process command line. This is to support a scenario where a mapper is linked as a stand-alone executable. It is possible to overwrite the [register_function] to define "-ppx drivers", which combine several mappers in a single process. Typically, a driver starts by defining [register_function] to a custom implementation, then lets ppx rewriters (linked statically or dynamically) register themselves, and then run all or some of them. It is also possible to have -ppx drivers apply rewriters to only specific parts of an AST. The first argument to [register] is a symbolic name to be used by the ppx driver. *) (** {1 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf (** {1 Helper functions to call external mappers} *) val add_ppx_context_str: tool_name:string -> Parsetree.structure -> Parsetree.structure (** Extract information from the current environment and encode it into an attribute which is prepended to the list of structure items in order to pass the information to an external processor. *) val add_ppx_context_sig: tool_name:string -> Parsetree.signature -> Parsetree.signature (** Same as [add_ppx_context_str], but for signatures. *) val drop_ppx_context_str: restore:bool -> Parsetree.structure -> Parsetree.structure (** Drop the ocaml.ppx.context attribute from a structure. If [restore] is true, also restore the associated data in the current process. *) val drop_ppx_context_sig: restore:bool -> Parsetree.signature -> Parsetree.signature (** Same as [drop_ppx_context_str], but for signatures. *) (** {1 Cookies} *) (** Cookies are used to pass information from a ppx processor to a further invocation of itself, when called from the OCaml toplevel (or other tools that support cookies). *) val set_cookie: string -> Parsetree.expression -> unit val get_cookie: string -> Parsetree.expression option end = struct open Parsetree open Ast_helper open Location module String = Misc.Stdlib.String type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> cases -> cases; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub { prf_desc; prf_loc; prf_attributes; } = let loc = sub.location sub prf_loc in let attrs = sub.attributes sub prf_attributes in let desc = match prf_desc with | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) in Rf.mk ~loc ~attrs desc let object_field sub { pof_desc; pof_loc; pof_attributes; } = let loc = sub.location sub pof_loc in let attrs = sub.attributes sub pof_attributes in let desc = match pof_desc with | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) | Oinherit t -> Oinherit (sub.typ sub t) in Of.mk ~loc ~attrs desc let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs; ptyp_loc_stack = _ } = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (object_field sub) l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = let loc = sub.location sub ptype_loc in let attrs = sub.attributes sub ptype_attributes in Type.mk ~loc ~attrs (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes} = let loc = sub.location sub ptyext_loc in let attrs = sub.attributes sub ptyext_attributes in Te.mk ~loc ~attrs (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private let map_type_exception sub {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = let loc = sub.location sub ptyexn_loc in let attrs = sub.attributes sub ptyexn_attributes in Te.mk_exception ~loc ~attrs (sub.extension_constructor sub ptyexn_constructor) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = let loc = sub.location sub pext_loc in let attrs = sub.attributes sub pext_attributes in Te.constructor ~loc ~attrs (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcty_open (o, ct) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typesubst l -> type_subst ~loc (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> let attrs = sub.attributes sub attrs in eval ~loc ~attrs (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs; pexp_loc_stack = _ } = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (o, e) -> open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) | Pexp_letop {let_; ands; body} -> letop ~loc ~attrs (sub.binding_op sub let_) (List.map (sub.binding_op sub) ands) (sub.expr sub body) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = let open Exp in let op = map_loc sub pbop_op in let pat = sub.pat sub pbop_pat in let exp = sub.expr sub pbop_exp in let loc = sub.location sub pbop_loc in binding_op op pat exp loc end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs; ppat_loc_stack = _ } = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcl_open (o, ce) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = let loc = sub.location sub pci_loc in let attrs = sub.attributes sub pci_attributes in Ci.mk ~loc ~attrs ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; type_exception = T.map_type_exception; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; binding_op = E.map_binding_op; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_substitution = (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> Ms.mk (map_loc this pms_name) (map_loc this pms_manifest) ~attrs:(this.attributes this pms_attributes) ~loc:(this.location this pms_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_declaration = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (this.module_expr this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); open_description = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this a -> { attr_name = map_loc this a.attr_name; attr_payload = this.payload this a.attr_payload; attr_loc = this.location this a.attr_loc } ); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(fun x -> PStr x) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = Attr.mk {loc; txt = "ocaml.ppwarning" } (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) include Locations.Helpers_impl let cookies = ref String.Map.empty let get_cookie k = try Some (String.Map.find k !cookies) with Not_found -> None let set_cookie k v = cookies := String.Map.add k v !cookies let tool_name_ref = ref "_none_" let tool_name () = !tool_name_ref module PpxContext = struct open Longident open Asttypes open Ast_helper let lid name = { txt = Lident name; loc = Location.none } let make_string x = Exp.constant (Pconst_string (x, None)) let make_bool x = if x then Exp.construct (lid "true") None else Exp.construct (lid "false") None let rec make_list f lst = match lst with | x :: rest -> Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) | [] -> Exp.construct (lid "[]") None let make_pair f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2] let make_option f opt = match opt with | Some x -> Exp.construct (lid "Some") (Some (f x)) | None -> Exp.construct (lid "None") None let get_cookies () = lid "cookies", make_list (make_pair make_string (fun x -> x)) (String.Map.bindings !cookies) let mk fields = { attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; attr_loc = Location.none } let make ~tool_name () = let fields = [ lid "tool_name", make_string tool_name; lid "include_dirs", make_list make_string !Clflags.include_dirs; lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); lid "open_modules", make_list make_string !Clflags.open_modules; lid "for_package", make_option make_string !Clflags.for_package; lid "debug", make_bool !Clflags.debug; lid "use_threads", make_bool !Clflags.use_threads; lid "recursive_types", make_bool !Clflags.recursive_types; lid "principal", make_bool !Clflags.principal; lid "transparent_modules", make_bool !Clflags.transparent_modules; lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); lid "unsafe_string", make_bool !Clflags.unsafe_string; get_cookies () ] in mk fields let get_fields = function | PStr [{pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (fields, None); _ }, []); _}] -> fields | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" let restore fields = let field name payload = let rec get_string = function | { pexp_desc = Pexp_constant (Pconst_string (str, None)); _ } -> str | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] string syntax" name and get_bool pexp = match pexp with | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"; _}, None); _} -> true | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"; _}, None); _} -> false | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] bool syntax" name and get_list elem = function | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"; _}, Some {pexp_desc = Pexp_tuple [exp; rest]; _}); _ } -> elem exp :: get_list elem rest | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"; _}, None); _ } -> [] | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] list syntax" name and get_pair f1 f2 = function | {pexp_desc = Pexp_tuple [e1; e2]; _} -> (f1 e1, f2 e2) | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] pair syntax" name and get_option elem = function | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "Some"; _ }, Some exp); _ } -> Some (elem exp) | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "None"; _ }, None); _ } -> None | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] option syntax" name in match name with | "tool_name" -> tool_name_ref := get_string payload | "include_dirs" -> Clflags.include_dirs := get_list get_string payload | "load_path" -> Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) | "open_modules" -> Clflags.open_modules := get_list get_string payload | "for_package" -> Clflags.for_package := get_option get_string payload | "debug" -> Clflags.debug := get_bool payload | "use_threads" -> Clflags.use_threads := get_bool payload | "recursive_types" -> Clflags.recursive_types := get_bool payload | "principal" -> Clflags.principal := get_bool payload | "transparent_modules" -> Clflags.transparent_modules := get_bool payload | "unboxed_types" -> Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) | "unsafe_string" -> Clflags.unsafe_string := get_bool payload | "cookies" -> let l = get_list (get_pair get_string (fun x -> x)) payload in cookies := List.fold_left (fun s (k, v) -> String.Map.add k v s) String.Map.empty l | _ -> () in List.iter (function ({txt=Lident name; _}, x) -> field name x | _ -> ()) fields let update_cookies fields = let fields = List.filter (function ({txt=Lident "cookies"; _}, _) -> false | _ -> true) fields in fields @ [get_cookies ()] end let ppx_context = PpxContext.make let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) let apply_lazy ~source ~target mapper = let implem ast = let fields, ast = match ast with | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; attr_payload = x; _}); _} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.structure mapper ast with exn -> [{pstr_desc = Pstr_extension (extension_of_exn exn, []); pstr_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Str.attribute (PpxContext.mk fields) :: ast in let iface ast = let fields, ast = match ast with | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; attr_payload = x; attr_loc = _}); _} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.signature mapper ast with exn -> [{psig_desc = Psig_extension (extension_of_exn exn, []); psig_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Sig.attribute (PpxContext.mk fields) :: ast in let ic = open_in_bin source in let magic = really_input_string ic (String.length Config.ast_impl_magic_number) in let rewrite transform = Location.input_name := input_value ic; let ast = input_value ic in close_in ic; let ast = transform ast in let oc = open_out_bin target in output_string oc magic; output_value oc !Location.input_name; output_value oc ast; close_out oc and fail () = close_in ic; failwith "Ast_mapper: OCaml version mismatch or malformed input"; in if magic = Config.ast_impl_magic_number then rewrite (implem : structure -> structure) else if magic = Config.ast_intf_magic_number then rewrite (iface : signature -> signature) else fail () let drop_ppx_context_str ~restore = function | {pstr_desc = Pstr_attribute {attr_name = {Location.txt = "ocaml.ppx.context"; _}; attr_payload = a; attr_loc = _}; _ } :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let drop_ppx_context_sig ~restore = function | {psig_desc = Psig_attribute {attr_name = {Location.txt = "ocaml.ppx.context"; _}; attr_payload = a; attr_loc = _}; _ } :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let add_ppx_context_str ~tool_name ast = Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast let add_ppx_context_sig ~tool_name ast = Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast let apply ~source ~target mapper = apply_lazy ~source ~target (fun () -> mapper) let run_main mapper = try let a = Sys.argv in let n = Array.length a in if n > 2 then let mapper () = try mapper (Array.to_list (Array.sub a 1 (n - 3))) with exn -> (* PR#6463 *) let f _ _ = raise exn in {default_mapper with structure = f; signature = f} in apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper else begin Printf.eprintf "Usage: %s [extra_args] \n%!" Sys.executable_name; exit 2 end with exn -> prerr_endline (Printexc.to_string exn); exit 2 let register_function = ref (fun _name f -> run_main f) let register name f = !register_function name f end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) (** An [out_name] is a string representation of an identifier which can be rewritten on the fly to avoid name collisions *) type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of out_name type out_string (*IF_CURRENT = Outcometree.out_string *) = | Ostr_string | Ostr_bytes type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string * int * out_string (* string, size-to-print, kind *) | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of out_ident * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M025" let ast_intf_magic_number = "Caml1999N025" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; binding_op = id; module_substitution = id; open_declaration = id; type_exception = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; binding_op = fail; module_substitution = fail; open_declaration = fail; type_exception = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_408_helper.ml000066400000000000000000000011731356450464700221100ustar00rootroot00000000000000module Misc = struct let find_in_path = Misc.find_in_path let find_in_path_uncap = Misc.find_in_path_uncap type ref_and_value = R : 'a ref * 'a -> ref_and_value let protect_refs = let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in fun refs f -> let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in set_refs refs; match f () with | x -> set_refs backup; x | exception e -> set_refs backup; raise e let may_map = Stdlib0.Option.map module Stdlib = struct module String = struct include String module Map = Map.Make (String) end end end ocaml-migrate-parsetree-1.5.0/src/ast_409.ml000066400000000000000000004371421356450464700205630ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour, Facebook *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2018 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Stdlib0 open Ast_409_helper module Location = Location module Longident = Longident module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) (** {1 Extension points} *) type attribute (*IF_CURRENT = Parsetree.attribute *) = { attr_name : string loc; attr_payload : payload; attr_loc : Location.t; } (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {1 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_loc_stack: Location.t list; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and typ = core_type and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Optional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of object_field list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = { prf_desc : row_field_desc; prf_loc : Location.t; prf_attributes : attributes; } and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) = | Rtag of label loc * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 'bool' field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) *) | Rinherit of core_type (* [ T ] *) and object_field (*IF_CURRENT = Parsetree.object_field *) = { pof_desc : object_field_desc; pof_loc : Location.t; pof_attributes : attributes; } and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) = | Otag of label loc * core_type | Oinherit of core_type (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_loc_stack: Location.t list; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pat = pattern and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string loc (* (module P) Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_loc_stack: Location.t list; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expr = expression and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of cases (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * cases (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * cases (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * label loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of label loc * expression (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of open_declaration * expression (* M.(E) let open M in E let! open M in E *) | Pexp_letop of letop (* let* P = E in E let* P = E and* P = E in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } and cases = case list and letop (*IF_CURRENT = Parsetree.letop *) = { let_ : binding_op; ands : binding_op list; body : expression; } and binding_op (*IF_CURRENT = Parsetree.binding_op *) = { pbop_op : string loc; pbop_pat : pattern; pbop_exp : expression; pbop_loc : Location.t; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l : T [@id1] [@id2] *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_loc: Location.t; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } (* exception E *) and type_exception (*IF_CURRENT = Parsetree.type_exception *) = { ptyexn_constructor: extension_constructor; ptyexn_loc: Location.t; ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {1 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) | Pcty_open of open_description * class_type (* let open M in CT *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (label loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) | Pcl_open of open_description * class_expr (* let open M in CE *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (label loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (label loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {1 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of string loc * module_type option * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typesubst of type_declaration list (* type t1 := ... and ... and tn := ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of type_exception (* exception C of T *) | Psig_module of module_declaration (* module X = M module X : MT *) | Psig_modsubst of module_substitution (* module X := M *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) = { pms_name: string loc; pms_manifest: Longident.t loc; pms_attributes: attributes; (* ... [@@id1] [@@id2] *) pms_loc: Location.t; } and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) = { popen_expr: 'a; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and open_description = Longident.t loc open_infos (* open M.N open M(N).O *) and open_declaration = module_expr open_infos (* open M.N open M(N).O open struct ... end *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc (* with module X.Y := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of string loc * module_type option * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of type_exception (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_declaration (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {1 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of toplevel_directive (* #use, #load ... *) and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) = { pdir_name : string loc; pdir_arg : directive_argument option; pdir_loc : Location.t; } and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = { pdira_desc : directive_argument_desc; pdira_loc : Location.t; } and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) = | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** (Re)Initialise all docstring state *) val init : unit -> unit (** Emit warnings for unattached and ambiguous docstrings *) val warn_bad_docstrings : unit -> unit (** {2 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Register a docstring *) val register : docstring -> unit (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {2 Set functions} These functions are used by the lexer to associate docstrings to the locations of tokens. *) (** Docstrings immediately preceding a token *) val set_pre_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following a token *) val set_post_docstrings : Lexing.position -> docstring list -> unit (** Docstrings not immediately adjacent to a token *) val set_floating_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following the token which precedes this one *) val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately preceding the token which follows this one *) val set_post_extra_docstrings : Lexing.position -> docstring list -> unit (** {2 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : unit -> docs val symbol_docs_lazy : unit -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : int -> int -> docs val rhs_docs_lazy : int -> int -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : unit -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : int -> int -> unit (** {2 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** Fetch the field info for the current symbol. *) val symbol_info : unit -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : int -> info (** {2 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val empty_text_lazy : text Lazy.t val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes (** Fetch the text preceding the current symbol. *) val symbol_text : unit -> text val symbol_text_lazy : unit -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : int -> text val rhs_text_lazy : int -> text Lazy.t (** {2 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : unit -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : unit -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : int -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : int -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : int -> text module WithMenhir: sig (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : Lexing.position * Lexing.position -> docs val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : Lexing.position -> Lexing.position -> docs val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : Lexing.position * Lexing.position -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : Lexing.position -> Lexing.position -> unit (** Fetch the field info for the current symbol. *) val symbol_info : Lexing.position -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : Lexing.position -> info (** Fetch the text preceding the current symbol. *) val symbol_text : Lexing.position -> text val symbol_text_lazy : Lexing.position -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : Lexing.position -> text val rhs_text_lazy : Lexing.position -> text Lazy.t (** {3 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : Lexing.position -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : Lexing.position -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : Lexing.position -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : Lexing.position -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : Lexing.position -> text end end = struct open Location (* Docstrings *) (* A docstring is "attached" if it has been inserted in the AST. This is used for generating unexpected docstring warnings. *) type ds_attached = | Unattached (* Not yet attached anything.*) | Info (* Attached to a field or constructor. *) | Docs (* Attached to an item or as floating text. *) (* A docstring is "associated" with an item if there are no blank lines between them. This is used for generating docstring ambiguity warnings. *) type ds_associated = | Zero (* Not associated with an item *) | One (* Associated with one item *) | Many (* Associated with multiple items (ambiguity) *) type docstring = { ds_body: string; ds_loc: Location.t; mutable ds_attached: ds_attached; mutable ds_associated: ds_associated; } (* List of docstrings *) let docstrings : docstring list ref = ref [] (* Warn for unused and ambiguous docstrings *) let warn_bad_docstrings () = if Warnings.is_active (Warnings.Bad_docstring true) then begin List.iter (fun ds -> match ds.ds_attached with | Info -> () | Unattached -> prerr_warning ds.ds_loc (Warnings.Bad_docstring true) | Docs -> match ds.ds_associated with | Zero | One -> () | Many -> prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) (List.rev !docstrings) end (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; ds_attached = Unattached; ds_associated = Zero; } in ds let register ds = docstrings := ds :: !docstrings let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = doc_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let empty_text_lazy = lazy [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = text_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""; _} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs (* Find the first non-info docstring in a list, attach it and return it *) let get_docstring ~info dsl = let rec loop = function | [] -> None | {ds_attached = Info; _} :: rest -> loop rest | ds :: _ -> ds.ds_attached <- if info then Info else Docs; Some ds in loop dsl (* Find all the non-info docstrings in a list, attach them and return them *) let get_docstrings dsl = let rec loop acc = function | [] -> List.rev acc | {ds_attached = Info; _} :: rest -> loop acc rest | ds :: rest -> ds.ds_attached <- Docs; loop (ds :: acc) rest in loop [] dsl (* "Associate" all the docstrings in a list *) let associate_docstrings dsl = List.iter (fun ds -> match ds.ds_associated with | Zero -> ds.ds_associated <- One | (One | Many) -> ds.ds_associated <- Many) dsl (* Map from positions to pre docstrings *) let pre_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_table pos dsl let get_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl with Not_found -> () (* Map from positions to post docstrings *) let post_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_table pos dsl let get_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl with Not_found -> () let get_info pos = try let dsl = Hashtbl.find post_table pos in get_docstring ~info:true dsl with Not_found -> None (* Map from positions to floating docstrings *) let floating_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_floating_docstrings pos dsl = if dsl <> [] then Hashtbl.add floating_table pos dsl let get_text pos = try let dsl = Hashtbl.find floating_table pos in get_docstrings dsl with Not_found -> [] let get_post_text pos = try let dsl = Hashtbl.find post_table pos in get_docstrings dsl with Not_found -> [] (* Maps from positions to extra docstrings *) let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_extra_table pos dsl let get_pre_extra_text pos = try let dsl = Hashtbl.find pre_extra_table pos in get_docstrings dsl with Not_found -> [] let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_extra_table pos dsl let get_post_extra_text pos = try let dsl = Hashtbl.find post_extra_table pos in get_docstrings dsl with Not_found -> [] (* Docstrings from parser actions *) module WithParsing = struct let symbol_docs () = { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); docs_post = get_post_docs (Parsing.symbol_end_pos ()); } let symbol_docs_lazy () = let p1 = Parsing.symbol_start_pos () in let p2 = Parsing.symbol_end_pos () in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } let rhs_docs_lazy pos1 pos2 = let p1 = Parsing.rhs_start_pos pos1 in let p2 = Parsing.rhs_end_pos pos2 in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs () = mark_pre_docs (Parsing.symbol_start_pos ()); mark_post_docs (Parsing.symbol_end_pos ()) let mark_rhs_docs pos1 pos2 = mark_pre_docs (Parsing.rhs_start_pos pos1); mark_post_docs (Parsing.rhs_end_pos pos2) let symbol_info () = get_info (Parsing.symbol_end_pos ()) let rhs_info pos = get_info (Parsing.rhs_end_pos pos) let symbol_text () = get_text (Parsing.symbol_start_pos ()) let symbol_text_lazy () = let pos = Parsing.symbol_start_pos () in lazy (get_text pos) let rhs_text pos = get_text (Parsing.rhs_start_pos pos) let rhs_post_text pos = get_post_text (Parsing.rhs_end_pos pos) let rhs_text_lazy pos = let pos = Parsing.rhs_start_pos pos in lazy (get_text pos) let symbol_pre_extra_text () = get_pre_extra_text (Parsing.symbol_start_pos ()) let symbol_post_extra_text () = get_post_extra_text (Parsing.symbol_end_pos ()) let rhs_pre_extra_text pos = get_pre_extra_text (Parsing.rhs_start_pos pos) let rhs_post_extra_text pos = get_post_extra_text (Parsing.rhs_end_pos pos) end include WithParsing module WithMenhir = struct let symbol_docs (startpos, endpos) = { docs_pre = get_pre_docs startpos; docs_post = get_post_docs endpos; } let symbol_docs_lazy (p1, p2) = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs pos1; docs_post = get_post_docs pos2; } let rhs_docs_lazy p1 p2 = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs (startpos, endpos) = mark_pre_docs startpos; mark_post_docs endpos; () let mark_rhs_docs pos1 pos2 = mark_pre_docs pos1; mark_post_docs pos2; () let symbol_info endpos = get_info endpos let rhs_info endpos = get_info endpos let symbol_text startpos = get_text startpos let symbol_text_lazy startpos = lazy (get_text startpos) let rhs_text pos = get_text pos let rhs_post_text pos = get_post_text pos let rhs_text_lazy pos = lazy (get_text pos) let symbol_pre_extra_text startpos = get_pre_extra_text startpos let symbol_post_extra_text endpos = get_post_extra_text endpos let rhs_pre_extra_text pos = get_pre_extra_text pos let rhs_post_extra_text pos = get_post_extra_text pos end (* (Re)Initialise all comment state *) let init () = docstrings := []; Hashtbl.reset pre_table; Hashtbl.reset post_table; Hashtbl.reset floating_table; Hashtbl.reset pre_extra_table; Hashtbl.reset post_extra_table end module Ast_helper : sig open Asttypes open Docstrings open Parsetree type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type attrs = attribute list (** {1 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {1 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {1 Attributes} *) module Attr : sig val mk: ?loc:loc -> str -> payload -> attribute end (** {1 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> cases -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> cases -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression -> expression val letop: ?loc:loc -> ?attrs:attrs -> binding_op -> binding_op list -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case val binding_op: str -> pattern -> expression -> loc -> binding_op end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> extension_constructor -> type_exception val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {1 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> str -> module_type option -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_subst: ?loc:loc -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> type_exception -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val mod_subst: ?loc:loc -> module_substitution -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> type_exception -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_declaration -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_type -> module_declaration end (** Module substitutions *) module Ms: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> lid -> module_substitution end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> 'a -> 'a open_infos end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {1 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end (** Row fields *) module Rf: sig val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> bool -> core_type list -> row_field val inherit_: ?loc:loc -> core_type -> row_field end (** Object fields *) module Of: sig val mk: ?loc:loc -> ?attrs:attrs -> object_field_desc -> object_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> core_type -> object_field val inherit_: ?loc:loc -> core_type -> object_field end end = struct open Asttypes open Parsetree open Docstrings type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = Misc.protect_refs [Misc.R (default_loc, l)] f module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (Int.to_string i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Attr = struct let mk ?(loc= !default_loc) name payload = { attr_name = name; attr_payload = payload; attr_loc = loc } end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_loc_stack = []; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s; _ }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field field = let prf_desc = match field.prf_desc with | Rtag(label,flag,lst) -> Rtag(label,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) in { field with prf_desc; } and loop_object_field field = let pof_desc = match field.pof_desc with | Otag(label, t) -> Otag(label, loop t) | Oinherit t -> Oinherit (loop t) in { field with pof_desc; } in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_loc_stack = []; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_loc_stack = []; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) let letop ?loc ?attrs let_ ands body = mk ?loc ?attrs (Pexp_letop {let_; ands; body}) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } let binding_op op pat exp loc = { pbop_op = op; pbop_pat = pat; pbop_exp = exp; pbop_loc = loc; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b c = mk ?loc ?attrs (Pmty_functor (a, b, c)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg arg_ty body = mk ?loc ?attrs (Pmod_functor (arg, arg_ty, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_subst ?loc a = mk ?loc (Psig_typesubst a) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let mod_subst ?loc a = mk ?loc (Psig_modsubst a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Ms = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name syn = { pms_name = name; pms_manifest = syn; pms_attributes = add_text_attrs text (add_docs_attrs docs attrs); pms_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) expr = { popen_expr = expr; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_loc = loc; ptyext_attributes = add_docs_attrs docs attrs; } let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) constructor = { ptyexn_constructor = constructor; ptyexn_loc = loc; ptyexn_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end (** Row fields *) module Rf = struct let mk ?(loc = !default_loc) ?(attrs = []) desc = { prf_desc = desc; prf_loc = loc; prf_attributes = attrs; } let tag ?loc ?attrs label const tys = mk ?loc ?attrs (Rtag (label, const, tys)) let inherit_?loc ty = mk ?loc (Rinherit ty) end (** Object fields *) module Of = struct let mk ?(loc = !default_loc) ?(attrs=[]) desc = { pof_desc = desc; pof_loc = loc; pof_attributes = attrs; } let tag ?loc ?attrs label ty = mk ?loc ?attrs (Otag (label, ty)) let inherit_ ?loc ty = mk ?loc (Oinherit ty) end end module Ast_mapper : sig open Parsetree (** {1 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> cases -> cases; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {1 Apply mappers to compilation units} *) val tool_name: unit -> string (** Can be used within a ppx preprocessor to know which tool is calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], ["ocaml"], ... Some global variables that reflect command-line options are automatically synchronized between the calling tool and the ppx preprocessor: {!Clflags.include_dirs}, {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, {!Clflags.debug}. *) val apply: source:string -> target:string -> mapper -> unit (** Apply a mapper (parametrized by the unit name) to a dumped parsetree found in the [source] file and put the result in the [target] file. The [structure] or [signature] field of the mapper is applied to the implementation or interface. *) val run_main: (string list -> mapper) -> unit (** Entry point to call to implement a standalone -ppx rewriter from a mapper, parametrized by the command line arguments. The current unit name can be obtained from {!Location.input_name}. This function implements proper error reporting for uncaught exceptions. *) (** {1 Registration API} *) val register_function: (string -> (string list -> mapper) -> unit) ref val register: string -> (string list -> mapper) -> unit (** Apply the [register_function]. The default behavior is to run the mapper immediately, taking arguments from the process command line. This is to support a scenario where a mapper is linked as a stand-alone executable. It is possible to overwrite the [register_function] to define "-ppx drivers", which combine several mappers in a single process. Typically, a driver starts by defining [register_function] to a custom implementation, then lets ppx rewriters (linked statically or dynamically) register themselves, and then run all or some of them. It is also possible to have -ppx drivers apply rewriters to only specific parts of an AST. The first argument to [register] is a symbolic name to be used by the ppx driver. *) (** {1 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf (** {1 Helper functions to call external mappers} *) val add_ppx_context_str: tool_name:string -> Parsetree.structure -> Parsetree.structure (** Extract information from the current environment and encode it into an attribute which is prepended to the list of structure items in order to pass the information to an external processor. *) val add_ppx_context_sig: tool_name:string -> Parsetree.signature -> Parsetree.signature (** Same as [add_ppx_context_str], but for signatures. *) val drop_ppx_context_str: restore:bool -> Parsetree.structure -> Parsetree.structure (** Drop the ocaml.ppx.context attribute from a structure. If [restore] is true, also restore the associated data in the current process. *) val drop_ppx_context_sig: restore:bool -> Parsetree.signature -> Parsetree.signature (** Same as [drop_ppx_context_str], but for signatures. *) (** {1 Cookies} *) (** Cookies are used to pass information from a ppx processor to a further invocation of itself, when called from the OCaml toplevel (or other tools that support cookies). *) val set_cookie: string -> Parsetree.expression -> unit val get_cookie: string -> Parsetree.expression option end = struct open Parsetree open Ast_helper open Location module String = Misc.Stdlib.String type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> cases -> cases; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub { prf_desc; prf_loc; prf_attributes; } = let loc = sub.location sub prf_loc in let attrs = sub.attributes sub prf_attributes in let desc = match prf_desc with | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) in Rf.mk ~loc ~attrs desc let object_field sub { pof_desc; pof_loc; pof_attributes; } = let loc = sub.location sub pof_loc in let attrs = sub.attributes sub pof_attributes in let desc = match pof_desc with | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) | Oinherit t -> Oinherit (sub.typ sub t) in Of.mk ~loc ~attrs desc let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs; ptyp_loc_stack = _ } = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (object_field sub) l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = let loc = sub.location sub ptype_loc in let attrs = sub.attributes sub ptype_attributes in Type.mk ~loc ~attrs (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes} = let loc = sub.location sub ptyext_loc in let attrs = sub.attributes sub ptyext_attributes in Te.mk ~loc ~attrs (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private let map_type_exception sub {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = let loc = sub.location sub ptyexn_loc in let attrs = sub.attributes sub ptyexn_attributes in Te.mk_exception ~loc ~attrs (sub.extension_constructor sub ptyexn_constructor) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = let loc = sub.location sub pext_loc in let attrs = sub.attributes sub pext_attributes in Te.constructor ~loc ~attrs (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcty_open (o, ct) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (s, mt1, mt2) -> functor_ ~loc ~attrs (map_loc sub s) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) mt1) (sub.module_type sub mt2) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typesubst l -> type_subst ~loc (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (arg, arg_ty, body) -> functor_ ~loc ~attrs (map_loc sub arg) (Migrate_parsetree_compiler_functions.may_map (sub.module_type sub) arg_ty) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> let attrs = sub.attributes sub attrs in eval ~loc ~attrs (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs; pexp_loc_stack = _ } = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (o, e) -> open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) | Pexp_letop {let_; ands; body} -> letop ~loc ~attrs (sub.binding_op sub let_) (List.map (sub.binding_op sub) ands) (sub.expr sub body) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = let open Exp in let op = map_loc sub pbop_op in let pat = sub.pat sub pbop_pat in let exp = sub.expr sub pbop_exp in let loc = sub.location sub pbop_loc in binding_op op pat exp loc end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs; ppat_loc_stack = _ } = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcl_open (o, ce) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = let loc = sub.location sub pci_loc in let attrs = sub.attributes sub pci_attributes in Ci.mk ~loc ~attrs ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; type_exception = T.map_type_exception; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; binding_op = E.map_binding_op; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_substitution = (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> Ms.mk (map_loc this pms_name) (map_loc this pms_manifest) ~attrs:(this.attributes this pms_attributes) ~loc:(this.location this pms_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_declaration = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (this.module_expr this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); open_description = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this a -> { attr_name = map_loc this a.attr_name; attr_payload = this.payload this a.attr_payload; attr_loc = this.location this a.attr_loc } ); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(fun x -> PStr x) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = Attr.mk {loc; txt = "ocaml.ppwarning" } (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) include Locations.Helpers_impl let cookies = ref String.Map.empty let get_cookie k = try Some (String.Map.find k !cookies) with Not_found -> None let set_cookie k v = cookies := String.Map.add k v !cookies let tool_name_ref = ref "_none_" let tool_name () = !tool_name_ref module PpxContext = struct open Longident open Asttypes open Ast_helper let lid name = { txt = Lident name; loc = Location.none } let make_string x = Exp.constant (Pconst_string (x, None)) let make_bool x = if x then Exp.construct (lid "true") None else Exp.construct (lid "false") None let rec make_list f lst = match lst with | x :: rest -> Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) | [] -> Exp.construct (lid "[]") None let make_pair f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2] let make_option f opt = match opt with | Some x -> Exp.construct (lid "Some") (Some (f x)) | None -> Exp.construct (lid "None") None let get_cookies () = lid "cookies", make_list (make_pair make_string (fun x -> x)) (String.Map.bindings !cookies) let mk fields = { attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; attr_loc = Location.none } let make ~tool_name () = let fields = [ lid "tool_name", make_string tool_name; lid "include_dirs", make_list make_string !Clflags.include_dirs; lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); lid "open_modules", make_list make_string !Clflags.open_modules; lid "for_package", make_option make_string !Clflags.for_package; lid "debug", make_bool !Clflags.debug; lid "use_threads", make_bool !Clflags.use_threads; lid "recursive_types", make_bool !Clflags.recursive_types; lid "principal", make_bool !Clflags.principal; lid "transparent_modules", make_bool !Clflags.transparent_modules; lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); lid "unsafe_string", make_bool !Clflags.unsafe_string; get_cookies () ] in mk fields let get_fields = function | PStr [{pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (fields, None); _ }, []); _}] -> fields | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" let restore fields = let field name payload = let rec get_string = function | { pexp_desc = Pexp_constant (Pconst_string (str, None)); _ } -> str | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] string syntax" name and get_bool pexp = match pexp with | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"; _}, None); _} -> true | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"; _}, None); _} -> false | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] bool syntax" name and get_list elem = function | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"; _}, Some {pexp_desc = Pexp_tuple [exp; rest]; _}); _ } -> elem exp :: get_list elem rest | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"; _}, None); _ } -> [] | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] list syntax" name and get_pair f1 f2 = function | {pexp_desc = Pexp_tuple [e1; e2]; _} -> (f1 e1, f2 e2) | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] pair syntax" name and get_option elem = function | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "Some"; _ }, Some exp); _ } -> Some (elem exp) | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "None"; _ }, None); _ } -> None | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] option syntax" name in match name with | "tool_name" -> tool_name_ref := get_string payload | "include_dirs" -> Clflags.include_dirs := get_list get_string payload | "load_path" -> Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) | "open_modules" -> Clflags.open_modules := get_list get_string payload | "for_package" -> Clflags.for_package := get_option get_string payload | "debug" -> Clflags.debug := get_bool payload | "use_threads" -> Clflags.use_threads := get_bool payload | "recursive_types" -> Clflags.recursive_types := get_bool payload | "principal" -> Clflags.principal := get_bool payload | "transparent_modules" -> Clflags.transparent_modules := get_bool payload | "unboxed_types" -> Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) | "unsafe_string" -> Clflags.unsafe_string := get_bool payload | "cookies" -> let l = get_list (get_pair get_string (fun x -> x)) payload in cookies := List.fold_left (fun s (k, v) -> String.Map.add k v s) String.Map.empty l | _ -> () in List.iter (function ({txt=Lident name; _}, x) -> field name x | _ -> ()) fields let update_cookies fields = let fields = List.filter (function ({txt=Lident "cookies"; _}, _) -> false | _ -> true) fields in fields @ [get_cookies ()] end let ppx_context = PpxContext.make let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) let apply_lazy ~source ~target mapper = let implem ast = let fields, ast = match ast with | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; attr_payload = x; _}); _} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.structure mapper ast with exn -> [{pstr_desc = Pstr_extension (extension_of_exn exn, []); pstr_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Str.attribute (PpxContext.mk fields) :: ast in let iface ast = let fields, ast = match ast with | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"; _}; attr_payload = x; attr_loc = _}); _} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.signature mapper ast with exn -> [{psig_desc = Psig_extension (extension_of_exn exn, []); psig_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Sig.attribute (PpxContext.mk fields) :: ast in let ic = open_in_bin source in let magic = really_input_string ic (String.length Config.ast_impl_magic_number) in let rewrite transform = Location.input_name := input_value ic; let ast = input_value ic in close_in ic; let ast = transform ast in let oc = open_out_bin target in output_string oc magic; output_value oc !Location.input_name; output_value oc ast; close_out oc and fail () = close_in ic; failwith "Ast_mapper: OCaml version mismatch or malformed input"; in if magic = Config.ast_impl_magic_number then rewrite (implem : structure -> structure) else if magic = Config.ast_intf_magic_number then rewrite (iface : signature -> signature) else fail () let drop_ppx_context_str ~restore = function | {pstr_desc = Pstr_attribute {attr_name = {Location.txt = "ocaml.ppx.context"; _}; attr_payload = a; attr_loc = _}; _ } :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let drop_ppx_context_sig ~restore = function | {psig_desc = Psig_attribute {attr_name = {Location.txt = "ocaml.ppx.context"; _}; attr_payload = a; attr_loc = _}; _ } :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let add_ppx_context_str ~tool_name ast = Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast let add_ppx_context_sig ~tool_name ast = Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast let apply ~source ~target mapper = apply_lazy ~source ~target (fun () -> mapper) let run_main mapper = try let a = Sys.argv in let n = Array.length a in if n > 2 then let mapper () = try mapper (Array.to_list (Array.sub a 1 (n - 3))) with exn -> (* PR#6463 *) let f _ _ = raise exn in {default_mapper with structure = f; signature = f} in apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper else begin Printf.eprintf "Usage: %s [extra_args] \n%!" Sys.executable_name; exit 2 end with exn -> prerr_endline (Printexc.to_string exn); exit 2 let register_function = ref (fun _name f -> run_main f) let register name f = !register_function name f end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) (** An [out_name] is a string representation of an identifier which can be rewritten on the fly to avoid name collisions *) type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of out_name type out_string (*IF_CURRENT = Outcometree.out_string *) = | Ostr_string | Ostr_bytes type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string * int * out_string (* string, size-to-print, kind *) | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of out_ident * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of string * out_module_type option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: bool; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M026" let ast_intf_magic_number = "Caml1999N026" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; binding_op = id; module_substitution = id; open_declaration = id; type_exception = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; binding_op = fail; module_substitution = fail; open_declaration = fail; type_exception = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/ast_409_helper.ml000066400000000000000000000011731356450464700221110ustar00rootroot00000000000000module Misc = struct let find_in_path = Misc.find_in_path let find_in_path_uncap = Misc.find_in_path_uncap type ref_and_value = R : 'a ref * 'a -> ref_and_value let protect_refs = let set_refs l = List.iter (fun (R (r, v)) -> r := v) l in fun refs f -> let backup = List.map (fun (R (r, _)) -> R (r, !r)) refs in set_refs refs; match f () with | x -> set_refs backup; x | exception e -> set_refs backup; raise e let may_map = Stdlib0.Option.map module Stdlib = struct module String = struct include String module Map = Map.Make (String) end end end ocaml-migrate-parsetree-1.5.0/src/ast_410.ml000066400000000000000000004405051356450464700205500ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour, Facebook *) (* Jérémie Dimino and Leo White, Jane Street Europe *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* Alain Frisch, LexiFi *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 2018 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Stdlib0 open Ast_409_helper module Location = Location module Longident = Longident [@@@warning "-9"] module Asttypes = struct type constant (*IF_CURRENT = Asttypes.constant *) = Const_int of int | Const_char of char | Const_string of string * string option | Const_float of string | Const_int32 of int32 | Const_int64 of int64 | Const_nativeint of nativeint type rec_flag (*IF_CURRENT = Asttypes.rec_flag *) = Nonrecursive | Recursive type direction_flag (*IF_CURRENT = Asttypes.direction_flag *) = Upto | Downto (* Order matters, used in polymorphic comparison *) type private_flag (*IF_CURRENT = Asttypes.private_flag *) = Private | Public type mutable_flag (*IF_CURRENT = Asttypes.mutable_flag *) = Immutable | Mutable type virtual_flag (*IF_CURRENT = Asttypes.virtual_flag *) = Virtual | Concrete type override_flag (*IF_CURRENT = Asttypes.override_flag *) = Override | Fresh type closed_flag (*IF_CURRENT = Asttypes.closed_flag *) = Closed | Open type label = string type arg_label (*IF_CURRENT = Asttypes.arg_label *) = Nolabel | Labelled of string (* label:T -> ... *) | Optional of string (* ?label:T -> ... *) type 'a loc = 'a Location.loc = { txt : 'a; loc : Location.t; } type variance (*IF_CURRENT = Asttypes.variance *) = | Covariant | Contravariant | Invariant end module Parsetree = struct open Asttypes type constant (*IF_CURRENT = Parsetree.constant *) = Pconst_integer of string * char option (* 3 3l 3L 3n Suffixes [g-z][G-Z] are accepted by the parser. Suffixes except 'l', 'L' and 'n' are rejected by the typechecker *) | Pconst_char of char (* 'c' *) | Pconst_string of string * string option (* "constant" {delim|other constant|delim} *) | Pconst_float of string * char option (* 3.4 2e5 1.4e-4 Suffixes [g-z][G-Z] are accepted by the parser. Suffixes are rejected by the typechecker. *) type location_stack = Location.t list (** {1 Extension points} *) type attribute (*IF_CURRENT = Parsetree.attribute *) = { attr_name : string loc; attr_payload : payload; attr_loc : Location.t; } (* [@id ARG] [@@id ARG] Metadata containers passed around within the AST. The compiler ignores unknown attributes. *) and extension = string loc * payload (* [%id ARG] [%%id ARG] Sub-language placeholder -- rejected by the typechecker. *) and attributes = attribute list and payload (*IF_CURRENT = Parsetree.payload *) = | PStr of structure | PSig of signature (* : SIG *) | PTyp of core_type (* : T *) | PPat of pattern * expression option (* ? P or ? P when E *) (** {1 Core language} *) (* Type expressions *) and core_type (*IF_CURRENT = Parsetree.core_type *) = { ptyp_desc: core_type_desc; ptyp_loc: Location.t; ptyp_loc_stack: location_stack; ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } and core_type_desc (*IF_CURRENT = Parsetree.core_type_desc *) = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of arg_label * core_type * core_type (* T1 -> T2 Simple ~l:T1 -> T2 Labelled ?l:T1 -> T2 Optional *) | Ptyp_tuple of core_type list (* T1 * ... * Tn Invariant: n >= 2 *) | Ptyp_constr of Longident.t loc * core_type list (* tconstr T tconstr (T1, ..., Tn) tconstr *) | Ptyp_object of object_field list * closed_flag (* < l1:T1; ...; ln:Tn > (flag = Closed) < l1:T1; ...; ln:Tn; .. > (flag = Open) *) | Ptyp_class of Longident.t loc * core_type list (* #tconstr T #tconstr (T1, ..., Tn) #tconstr *) | Ptyp_alias of core_type * string (* T as 'a *) | Ptyp_variant of row_field list * closed_flag * label list option (* [ `A|`B ] (flag = Closed; labels = None) [> `A|`B ] (flag = Open; labels = None) [< `A|`B ] (flag = Closed; labels = Some []) [< `A|`B > `X `Y ](flag = Closed; labels = Some ["X";"Y"]) *) | Ptyp_poly of string loc list * core_type (* 'a1 ... 'an. T Can only appear in the following context: - As the core_type of a Ppat_constraint node corresponding to a constraint on a let-binding: let x : 'a1 ... 'an. T = e ... - Under Cfk_virtual for methods (not values). - As the core_type of a Pctf_method node. - As the core_type of a Pexp_poly node. - As the pld_type field of a label_declaration. - As a core_type of a Ptyp_object node. *) | Ptyp_package of package_type (* (module S) *) | Ptyp_extension of extension (* [%id] *) and package_type = Longident.t loc * (Longident.t loc * core_type) list (* (module S) (module S with type t1 = T1 and ... and tn = Tn) *) and row_field (*IF_CURRENT = Parsetree.row_field *) = { prf_desc : row_field_desc; prf_loc : Location.t; prf_attributes : attributes; } and row_field_desc (*IF_CURRENT = Parsetree.row_field_desc *) = | Rtag of label loc * bool * core_type list (* [`A] ( true, [] ) [`A of T] ( false, [T] ) [`A of T1 & .. & Tn] ( false, [T1;...Tn] ) [`A of & T1 & .. & Tn] ( true, [T1;...Tn] ) - The 'bool' field is true if the tag contains a constant (empty) constructor. - '&' occurs when several types are used for the same constructor (see 4.2 in the manual) *) | Rinherit of core_type (* [ T ] *) and object_field (*IF_CURRENT = Parsetree.object_field *) = { pof_desc : object_field_desc; pof_loc : Location.t; pof_attributes : attributes; } and object_field_desc (*IF_CURRENT = Parsetree.object_field_desc *) = | Otag of label loc * core_type | Oinherit of core_type (* Patterns *) and pattern (*IF_CURRENT = Parsetree.pattern *) = { ppat_desc: pattern_desc; ppat_loc: Location.t; ppat_loc_stack: location_stack; ppat_attributes: attributes; (* ... [@id1] [@id2] *) } and pattern_desc (*IF_CURRENT = Parsetree.pattern_desc *) = | Ppat_any (* _ *) | Ppat_var of string loc (* x *) | Ppat_alias of pattern * string loc (* P as 'a *) | Ppat_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Ppat_interval of constant * constant (* 'a'..'z' Other forms of interval are recognized by the parser but rejected by the type-checker. *) | Ppat_tuple of pattern list (* (P1, ..., Pn) Invariant: n >= 2 *) | Ppat_construct of Longident.t loc * pattern option (* C None C P Some P C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn]) *) | Ppat_variant of label * pattern option (* `A (None) `A P (Some P) *) | Ppat_record of (Longident.t loc * pattern) list * closed_flag (* { l1=P1; ...; ln=Pn } (flag = Closed) { l1=P1; ...; ln=Pn; _} (flag = Open) Invariant: n > 0 *) | Ppat_array of pattern list (* [| P1; ...; Pn |] *) | Ppat_or of pattern * pattern (* P1 | P2 *) | Ppat_constraint of pattern * core_type (* (P : T) *) | Ppat_type of Longident.t loc (* #tconst *) | Ppat_lazy of pattern (* lazy P *) | Ppat_unpack of string option loc (* (module P) Some "P" (module _) None Note: (module P : S) is represented as Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_exception of pattern (* exception P *) | Ppat_extension of extension (* [%id] *) | Ppat_open of Longident.t loc * pattern (* M.(P) *) (* Value expressions *) and expression (*IF_CURRENT = Parsetree.expression *) = { pexp_desc: expression_desc; pexp_loc: Location.t; pexp_loc_stack: location_stack; pexp_attributes: attributes; (* ... [@id1] [@id2] *) } and expression_desc (*IF_CURRENT = Parsetree.expression_desc *) = | Pexp_ident of Longident.t loc (* x M.x *) | Pexp_constant of constant (* 1, 'a', "true", 1.0, 1l, 1L, 1n *) | Pexp_let of rec_flag * value_binding list * expression (* let P1 = E1 and ... and Pn = EN in E (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_function of case list (* function P1 -> E1 | ... | Pn -> En *) | Pexp_fun of arg_label * expression option * pattern * expression (* fun P -> E1 (Simple, None) fun ~l:P -> E1 (Labelled l, None) fun ?l:P -> E1 (Optional l, None) fun ?l:(P = E0) -> E1 (Optional l, Some E0) Notes: - If E0 is provided, only Optional is allowed. - "fun P1 P2 .. Pn -> E1" is represented as nested Pexp_fun. - "let f P = E" is represented using Pexp_fun. *) | Pexp_apply of expression * (arg_label * expression) list (* E0 ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pexp_match of expression * case list (* match E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_try of expression * case list (* try E0 with P1 -> E1 | ... | Pn -> En *) | Pexp_tuple of expression list (* (E1, ..., En) Invariant: n >= 2 *) | Pexp_construct of Longident.t loc * expression option (* C None C E Some E C (E1, ..., En) Some (Pexp_tuple[E1;...;En]) *) | Pexp_variant of label * expression option (* `A (None) `A E (Some E) *) | Pexp_record of (Longident.t loc * expression) list * expression option (* { l1=P1; ...; ln=Pn } (None) { E0 with l1=P1; ...; ln=Pn } (Some E0) Invariant: n > 0 *) | Pexp_field of expression * Longident.t loc (* E.l *) | Pexp_setfield of expression * Longident.t loc * expression (* E1.l <- E2 *) | Pexp_array of expression list (* [| E1; ...; En |] *) | Pexp_ifthenelse of expression * expression * expression option (* if E1 then E2 else E3 *) | Pexp_sequence of expression * expression (* E1; E2 *) | Pexp_while of expression * expression (* while E1 do E2 done *) | Pexp_for of pattern * expression * expression * direction_flag * expression (* for i = E1 to E2 do E3 done (flag = Upto) for i = E1 downto E2 do E3 done (flag = Downto) *) | Pexp_constraint of expression * core_type (* (E : T) *) | Pexp_coerce of expression * core_type option * core_type (* (E :> T) (None, T) (E : T0 :> T) (Some T0, T) *) | Pexp_send of expression * label loc (* E # m *) | Pexp_new of Longident.t loc (* new M.c *) | Pexp_setinstvar of label loc * expression (* x <- 2 *) | Pexp_override of (label loc * expression) list (* {< x1 = E1; ...; Xn = En >} *) | Pexp_letmodule of string option loc * module_expr * expression (* let module M = ME in E *) | Pexp_letexception of extension_constructor * expression (* let exception C in E *) | Pexp_assert of expression (* assert E Note: "assert false" is treated in a special way by the type-checker. *) | Pexp_lazy of expression (* lazy E *) | Pexp_poly of expression * core_type option (* Used for method bodies. Can only be used as the expression under Cfk_concrete for methods (not values). *) | Pexp_object of class_structure (* object ... end *) | Pexp_newtype of string loc * expression (* fun (type t) -> E *) | Pexp_pack of module_expr (* (module ME) (module ME : S) is represented as Pexp_constraint(Pexp_pack, Ptyp_package S) *) | Pexp_open of open_declaration * expression (* M.(E) let open M in E let! open M in E *) | Pexp_letop of letop (* let* P = E in E let* P = E and* P = E in E *) | Pexp_extension of extension (* [%id] *) | Pexp_unreachable (* . *) and case (*IF_CURRENT = Parsetree.case *) = (* (P -> E) or (P when E0 -> E) *) { pc_lhs: pattern; pc_guard: expression option; pc_rhs: expression; } and letop (*IF_CURRENT = Parsetree.letop *) = { let_ : binding_op; ands : binding_op list; body : expression; } and binding_op (*IF_CURRENT = Parsetree.binding_op *) = { pbop_op : string loc; pbop_pat : pattern; pbop_exp : expression; pbop_loc : Location.t; } (* Value descriptions *) and value_description (*IF_CURRENT = Parsetree.value_description *) = { pval_name: string loc; pval_type: core_type; pval_prim: string list; pval_attributes: attributes; (* ... [@@id1] [@@id2] *) pval_loc: Location.t; } (* val x: T (prim = []) external x: T = "s1" ... "sn" (prim = ["s1";..."sn"]) *) (* Type declarations *) and type_declaration (*IF_CURRENT = Parsetree.type_declaration *) = { ptype_name: string loc; ptype_params: (core_type * variance) list; (* ('a1,...'an) t; None represents _*) ptype_cstrs: (core_type * core_type * Location.t) list; (* ... constraint T1=T1' ... constraint Tn=Tn' *) ptype_kind: type_kind; ptype_private: private_flag; (* = private ... *) ptype_manifest: core_type option; (* = T *) ptype_attributes: attributes; (* ... [@@id1] [@@id2] *) ptype_loc: Location.t; } (* type t (abstract, no manifest) type t = T0 (abstract, manifest=T0) type t = C of T | ... (variant, no manifest) type t = T0 = C of T | ... (variant, manifest=T0) type t = {l: T; ...} (record, no manifest) type t = T0 = {l : T; ...} (record, manifest=T0) type t = .. (open, no manifest) *) and type_kind (*IF_CURRENT = Parsetree.type_kind *) = | Ptype_abstract | Ptype_variant of constructor_declaration list | Ptype_record of label_declaration list (* Invariant: non-empty list *) | Ptype_open and label_declaration (*IF_CURRENT = Parsetree.label_declaration *) = { pld_name: string loc; pld_mutable: mutable_flag; pld_type: core_type; pld_loc: Location.t; pld_attributes: attributes; (* l : T [@id1] [@id2] *) } (* { ...; l: T; ... } (mutable=Immutable) { ...; mutable l: T; ... } (mutable=Mutable) Note: T can be a Ptyp_poly. *) and constructor_declaration (*IF_CURRENT = Parsetree.constructor_declaration *) = { pcd_name: string loc; pcd_args: constructor_arguments; pcd_res: core_type option; pcd_loc: Location.t; pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) } and constructor_arguments (*IF_CURRENT = Parsetree.constructor_arguments *) = | Pcstr_tuple of core_type list | Pcstr_record of label_declaration list (* | C of T1 * ... * Tn (res = None, args = Pcstr_tuple []) | C: T0 (res = Some T0, args = []) | C: T1 * ... * Tn -> T0 (res = Some T0, args = Pcstr_tuple) | C of {...} (res = None, args = Pcstr_record) | C: {...} -> T0 (res = Some T0, args = Pcstr_record) | C of {...} as t (res = None, args = Pcstr_record) *) and type_extension (*IF_CURRENT = Parsetree.type_extension *) = { ptyext_path: Longident.t loc; ptyext_params: (core_type * variance) list; ptyext_constructors: extension_constructor list; ptyext_private: private_flag; ptyext_loc: Location.t; ptyext_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* type t += ... *) and extension_constructor (*IF_CURRENT = Parsetree.extension_constructor *) = { pext_name: string loc; pext_kind : extension_constructor_kind; pext_loc : Location.t; pext_attributes: attributes; (* C of ... [@id1] [@id2] *) } (* exception E *) and type_exception (*IF_CURRENT = Parsetree.type_exception *) = { ptyexn_constructor: extension_constructor; ptyexn_loc: Location.t; ptyexn_attributes: attributes; (* ... [@@id1] [@@id2] *) } and extension_constructor_kind (*IF_CURRENT = Parsetree.extension_constructor_kind *) = Pext_decl of constructor_arguments * core_type option (* | C of T1 * ... * Tn ([T1; ...; Tn], None) | C: T0 ([], Some T0) | C: T1 * ... * Tn -> T0 ([T1; ...; Tn], Some T0) *) | Pext_rebind of Longident.t loc (* | C = D *) (** {1 Class language} *) (* Type expressions for the class language *) and class_type (*IF_CURRENT = Parsetree.class_type *) = { pcty_desc: class_type_desc; pcty_loc: Location.t; pcty_attributes: attributes; (* ... [@id1] [@id2] *) } and class_type_desc (*IF_CURRENT = Parsetree.class_type_desc *) = | Pcty_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcty_signature of class_signature (* object ... end *) | Pcty_arrow of arg_label * core_type * class_type (* T -> CT Simple ~l:T -> CT Labelled l ?l:T -> CT Optional l *) | Pcty_extension of extension (* [%id] *) | Pcty_open of open_description * class_type (* let open M in CT *) and class_signature (*IF_CURRENT = Parsetree.class_signature *) = { pcsig_self: core_type; pcsig_fields: class_type_field list; } (* object('selfpat) ... end object ... end (self = Ptyp_any) *) and class_type_field (*IF_CURRENT = Parsetree.class_type_field *) = { pctf_desc: class_type_field_desc; pctf_loc: Location.t; pctf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_type_field_desc (*IF_CURRENT = Parsetree.class_type_field_desc *) = | Pctf_inherit of class_type (* inherit CT *) | Pctf_val of (label loc * mutable_flag * virtual_flag * core_type) (* val x: T *) | Pctf_method of (label loc * private_flag * virtual_flag * core_type) (* method x: T Note: T can be a Ptyp_poly. *) | Pctf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pctf_attribute of attribute (* [@@@id] *) | Pctf_extension of extension (* [%%id] *) and 'a class_infos (*IF_CURRENT = 'a Parsetree.class_infos *) = { pci_virt: virtual_flag; pci_params: (core_type * variance) list; pci_name: string loc; pci_expr: 'a; pci_loc: Location.t; pci_attributes: attributes; (* ... [@@id1] [@@id2] *) } (* class c = ... class ['a1,...,'an] c = ... class virtual c = ... Also used for "class type" declaration. *) and class_description = class_type class_infos and class_type_declaration = class_type class_infos (* Value expressions for the class language *) and class_expr (*IF_CURRENT = Parsetree.class_expr *) = { pcl_desc: class_expr_desc; pcl_loc: Location.t; pcl_attributes: attributes; (* ... [@id1] [@id2] *) } and class_expr_desc (*IF_CURRENT = Parsetree.class_expr_desc *) = | Pcl_constr of Longident.t loc * core_type list (* c ['a1, ..., 'an] c *) | Pcl_structure of class_structure (* object ... end *) | Pcl_fun of arg_label * expression option * pattern * class_expr (* fun P -> CE (Simple, None) fun ~l:P -> CE (Labelled l, None) fun ?l:P -> CE (Optional l, None) fun ?l:(P = E0) -> CE (Optional l, Some E0) *) | Pcl_apply of class_expr * (arg_label * expression) list (* CE ~l1:E1 ... ~ln:En li can be empty (non labeled argument) or start with '?' (optional argument). Invariant: n > 0 *) | Pcl_let of rec_flag * value_binding list * class_expr (* let P1 = E1 and ... and Pn = EN in CE (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN in CE (flag = Recursive) *) | Pcl_constraint of class_expr * class_type (* (CE : CT) *) | Pcl_extension of extension (* [%id] *) | Pcl_open of open_description * class_expr (* let open M in CE *) and class_structure (*IF_CURRENT = Parsetree.class_structure *) = { pcstr_self: pattern; pcstr_fields: class_field list; } (* object(selfpat) ... end object ... end (self = Ppat_any) *) and class_field (*IF_CURRENT = Parsetree.class_field *) = { pcf_desc: class_field_desc; pcf_loc: Location.t; pcf_attributes: attributes; (* ... [@@id1] [@@id2] *) } and class_field_desc (*IF_CURRENT = Parsetree.class_field_desc *) = | Pcf_inherit of override_flag * class_expr * string loc option (* inherit CE inherit CE as x inherit! CE inherit! CE as x *) | Pcf_val of (label loc * mutable_flag * class_field_kind) (* val x = E val virtual x: T *) | Pcf_method of (label loc * private_flag * class_field_kind) (* method x = E (E can be a Pexp_poly) method virtual x: T (T can be a Ptyp_poly) *) | Pcf_constraint of (core_type * core_type) (* constraint T1 = T2 *) | Pcf_initializer of expression (* initializer E *) | Pcf_attribute of attribute (* [@@@id] *) | Pcf_extension of extension (* [%%id] *) and class_field_kind (*IF_CURRENT = Parsetree.class_field_kind *) = | Cfk_virtual of core_type | Cfk_concrete of override_flag * expression and class_declaration = class_expr class_infos (** {1 Module language} *) (* Type expressions for the module language *) and module_type (*IF_CURRENT = Parsetree.module_type *) = { pmty_desc: module_type_desc; pmty_loc: Location.t; pmty_attributes: attributes; (* ... [@id1] [@id2] *) } and module_type_desc (*IF_CURRENT = Parsetree.module_type_desc *) = | Pmty_ident of Longident.t loc (* S *) | Pmty_signature of signature (* sig ... end *) | Pmty_functor of functor_parameter * module_type (* functor(X : MT1) -> MT2 *) | Pmty_with of module_type * with_constraint list (* MT with ... *) | Pmty_typeof of module_expr (* module type of ME *) | Pmty_extension of extension (* [%id] *) | Pmty_alias of Longident.t loc (* (module M) *) and functor_parameter (*IF_CURRENT = Parsetree.functor_parameter *) = | Unit (* () *) | Named of string option loc * module_type (* (X : MT) Some X, MT (_ : MT) None, MT *) and signature = signature_item list and signature_item (*IF_CURRENT = Parsetree.signature_item *) = { psig_desc: signature_item_desc; psig_loc: Location.t; } and signature_item_desc (*IF_CURRENT = Parsetree.signature_item_desc *) = | Psig_value of value_description (* val x: T external x: T = "s1" ... "sn" *) | Psig_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Psig_typesubst of type_declaration list (* type t1 := ... and ... and tn := ... *) | Psig_typext of type_extension (* type t1 += ... *) | Psig_exception of type_exception (* exception C of T *) | Psig_module of module_declaration (* module X = M module X : MT *) | Psig_modsubst of module_substitution (* module X := M *) | Psig_recmodule of module_declaration list (* module rec X1 : MT1 and ... and Xn : MTn *) | Psig_modtype of module_type_declaration (* module type S = MT module type S *) | Psig_open of open_description (* open X *) | Psig_include of include_description (* include MT *) | Psig_class of class_description list (* class c1 : ... and ... and cn : ... *) | Psig_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Psig_attribute of attribute (* [@@@id] *) | Psig_extension of extension * attributes (* [%%id] *) and module_declaration (*IF_CURRENT = Parsetree.module_declaration *) = { pmd_name: string option loc; pmd_type: module_type; pmd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmd_loc: Location.t; } (* S : MT *) and module_substitution (*IF_CURRENT = Parsetree.module_substitution *) = { pms_name: string loc; pms_manifest: Longident.t loc; pms_attributes: attributes; (* ... [@@id1] [@@id2] *) pms_loc: Location.t; } and module_type_declaration (*IF_CURRENT = Parsetree.module_type_declaration *) = { pmtd_name: string loc; pmtd_type: module_type option; pmtd_attributes: attributes; (* ... [@@id1] [@@id2] *) pmtd_loc: Location.t; } (* S = MT S (abstract module type declaration, pmtd_type = None) *) and 'a open_infos (*IF_CURRENT = 'a Parsetree.open_infos *) = { popen_expr: 'a; popen_override: override_flag; popen_loc: Location.t; popen_attributes: attributes; } (* open! X - popen_override = Override (silences the 'used identifier shadowing' warning) open X - popen_override = Fresh *) and open_description = Longident.t loc open_infos (* open M.N open M(N).O *) and open_declaration = module_expr open_infos (* open M.N open M(N).O open struct ... end *) and 'a include_infos (*IF_CURRENT = 'a Parsetree.include_infos *) = { pincl_mod: 'a; pincl_loc: Location.t; pincl_attributes: attributes; } and include_description = module_type include_infos (* include MT *) and include_declaration = module_expr include_infos (* include ME *) and with_constraint (*IF_CURRENT = Parsetree.with_constraint *) = | Pwith_type of Longident.t loc * type_declaration (* with type X.t = ... Note: the last component of the longident must match the name of the type_declaration. *) | Pwith_module of Longident.t loc * Longident.t loc (* with module X.Y = Z *) | Pwith_typesubst of Longident.t loc * type_declaration (* with type X.t := ..., same format as [Pwith_type] *) | Pwith_modsubst of Longident.t loc * Longident.t loc (* with module X.Y := Z *) (* Value expressions for the module language *) and module_expr (*IF_CURRENT = Parsetree.module_expr *) = { pmod_desc: module_expr_desc; pmod_loc: Location.t; pmod_attributes: attributes; (* ... [@id1] [@id2] *) } and module_expr_desc (*IF_CURRENT = Parsetree.module_expr_desc *) = | Pmod_ident of Longident.t loc (* X *) | Pmod_structure of structure (* struct ... end *) | Pmod_functor of functor_parameter * module_expr (* functor(X : MT1) -> ME *) | Pmod_apply of module_expr * module_expr (* ME1(ME2) *) | Pmod_constraint of module_expr * module_type (* (ME : MT) *) | Pmod_unpack of expression (* (val E) *) | Pmod_extension of extension (* [%id] *) and structure = structure_item list and structure_item (*IF_CURRENT = Parsetree.structure_item *) = { pstr_desc: structure_item_desc; pstr_loc: Location.t; } and structure_item_desc (*IF_CURRENT = Parsetree.structure_item_desc *) = | Pstr_eval of expression * attributes (* E *) | Pstr_value of rec_flag * value_binding list (* let P1 = E1 and ... and Pn = EN (flag = Nonrecursive) let rec P1 = E1 and ... and Pn = EN (flag = Recursive) *) | Pstr_primitive of value_description (* val x: T external x: T = "s1" ... "sn" *) | Pstr_type of rec_flag * type_declaration list (* type t1 = ... and ... and tn = ... *) | Pstr_typext of type_extension (* type t1 += ... *) | Pstr_exception of type_exception (* exception C of T exception C = M.X *) | Pstr_module of module_binding (* module X = ME *) | Pstr_recmodule of module_binding list (* module rec X1 = ME1 and ... and Xn = MEn *) | Pstr_modtype of module_type_declaration (* module type S = MT *) | Pstr_open of open_declaration (* open X *) | Pstr_class of class_declaration list (* class c1 = ... and ... and cn = ... *) | Pstr_class_type of class_type_declaration list (* class type ct1 = ... and ... and ctn = ... *) | Pstr_include of include_declaration (* include ME *) | Pstr_attribute of attribute (* [@@@id] *) | Pstr_extension of extension * attributes (* [%%id] *) and value_binding (*IF_CURRENT = Parsetree.value_binding *) = { pvb_pat: pattern; pvb_expr: expression; pvb_attributes: attributes; pvb_loc: Location.t; } and module_binding (*IF_CURRENT = Parsetree.module_binding *) = { pmb_name: string option loc; pmb_expr: module_expr; pmb_attributes: attributes; pmb_loc: Location.t; } (* X = ME *) (** {1 Toplevel} *) (* Toplevel phrases *) type toplevel_phrase (*IF_CURRENT = Parsetree.toplevel_phrase *) = | Ptop_def of structure | Ptop_dir of toplevel_directive (* #use, #load ... *) and toplevel_directive (*IF_CURRENT = Parsetree.toplevel_directive *) = { pdir_name : string loc; pdir_arg : directive_argument option; pdir_loc : Location.t; } and directive_argument (*IF_CURRENT = Parsetree.directive_argument *) = { pdira_desc : directive_argument_desc; pdira_loc : Location.t; } and directive_argument_desc (*IF_CURRENT = Parsetree.directive_argument_desc *) = | Pdir_string of string | Pdir_int of string * char option | Pdir_ident of Longident.t | Pdir_bool of bool end module Docstrings : sig (** (Re)Initialise all docstring state *) val init : unit -> unit (** Emit warnings for unattached and ambiguous docstrings *) val warn_bad_docstrings : unit -> unit (** {2 Docstrings} *) (** Documentation comments *) type docstring (** Create a docstring *) val docstring : string -> Location.t -> docstring (** Register a docstring *) val register : docstring -> unit (** Get the text of a docstring *) val docstring_body : docstring -> string (** Get the location of a docstring *) val docstring_loc : docstring -> Location.t (** {2 Set functions} These functions are used by the lexer to associate docstrings to the locations of tokens. *) (** Docstrings immediately preceding a token *) val set_pre_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following a token *) val set_post_docstrings : Lexing.position -> docstring list -> unit (** Docstrings not immediately adjacent to a token *) val set_floating_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately following the token which precedes this one *) val set_pre_extra_docstrings : Lexing.position -> docstring list -> unit (** Docstrings immediately preceding the token which follows this one *) val set_post_extra_docstrings : Lexing.position -> docstring list -> unit (** {2 Items} The {!docs} type represents documentation attached to an item. *) type docs = { docs_pre: docstring option; docs_post: docstring option; } val empty_docs : docs val docs_attr : docstring -> Parsetree.attribute (** Convert item documentation to attributes and add them to an attribute list *) val add_docs_attrs : docs -> Parsetree.attributes -> Parsetree.attributes (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : unit -> docs val symbol_docs_lazy : unit -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : int -> int -> docs val rhs_docs_lazy : int -> int -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : unit -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : int -> int -> unit (** {2 Fields and constructors} The {!info} type represents documentation attached to a field or constructor. *) type info = docstring option val empty_info : info val info_attr : docstring -> Parsetree.attribute (** Convert field info to attributes and add them to an attribute list *) val add_info_attrs : info -> Parsetree.attributes -> Parsetree.attributes (** Fetch the field info for the current symbol. *) val symbol_info : unit -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : int -> info (** {2 Unattached comments} The {!text} type represents documentation which is not attached to anything. *) type text = docstring list val empty_text : text val empty_text_lazy : text Lazy.t val text_attr : docstring -> Parsetree.attribute (** Convert text to attributes and add them to an attribute list *) val add_text_attrs : text -> Parsetree.attributes -> Parsetree.attributes (** Fetch the text preceding the current symbol. *) val symbol_text : unit -> text val symbol_text_lazy : unit -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : int -> text val rhs_text_lazy : int -> text Lazy.t (** {2 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : unit -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : unit -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : int -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : int -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : int -> text module WithMenhir: sig (** Fetch the item documentation for the current symbol. This also marks this documentation (for ambiguity warnings). *) val symbol_docs : Lexing.position * Lexing.position -> docs val symbol_docs_lazy : Lexing.position * Lexing.position -> docs Lazy.t (** Fetch the item documentation for the symbols between two positions. This also marks this documentation (for ambiguity warnings). *) val rhs_docs : Lexing.position -> Lexing.position -> docs val rhs_docs_lazy : Lexing.position -> Lexing.position -> docs Lazy.t (** Mark the item documentation for the current symbol (for ambiguity warnings). *) val mark_symbol_docs : Lexing.position * Lexing.position -> unit (** Mark as associated the item documentation for the symbols between two positions (for ambiguity warnings) *) val mark_rhs_docs : Lexing.position -> Lexing.position -> unit (** Fetch the field info for the current symbol. *) val symbol_info : Lexing.position -> info (** Fetch the field info following the symbol at a given position. *) val rhs_info : Lexing.position -> info (** Fetch the text preceding the current symbol. *) val symbol_text : Lexing.position -> text val symbol_text_lazy : Lexing.position -> text Lazy.t (** Fetch the text preceding the symbol at the given position. *) val rhs_text : Lexing.position -> text val rhs_text_lazy : Lexing.position -> text Lazy.t (** {3 Extra text} There may be additional text attached to the delimiters of a block (e.g. [struct] and [end]). This is fetched by the following functions, which are applied to the contents of the block rather than the delimiters. *) (** Fetch additional text preceding the current symbol *) val symbol_pre_extra_text : Lexing.position -> text (** Fetch additional text following the current symbol *) val symbol_post_extra_text : Lexing.position -> text (** Fetch additional text preceding the symbol at the given position *) val rhs_pre_extra_text : Lexing.position -> text (** Fetch additional text following the symbol at the given position *) val rhs_post_extra_text : Lexing.position -> text (** Fetch text following the symbol at the given position *) val rhs_post_text : Lexing.position -> text end end = struct open Location (* Docstrings *) (* A docstring is "attached" if it has been inserted in the AST. This is used for generating unexpected docstring warnings. *) type ds_attached = | Unattached (* Not yet attached anything.*) | Info (* Attached to a field or constructor. *) | Docs (* Attached to an item or as floating text. *) (* A docstring is "associated" with an item if there are no blank lines between them. This is used for generating docstring ambiguity warnings. *) type ds_associated = | Zero (* Not associated with an item *) | One (* Associated with one item *) | Many (* Associated with multiple items (ambiguity) *) type docstring = { ds_body: string; ds_loc: Location.t; mutable ds_attached: ds_attached; mutable ds_associated: ds_associated; } (* List of docstrings *) let docstrings : docstring list ref = ref [] (* Warn for unused and ambiguous docstrings *) let warn_bad_docstrings () = if Warnings.is_active (Warnings.Bad_docstring true) then begin List.iter (fun ds -> match ds.ds_attached with | Info -> () | Unattached -> prerr_warning ds.ds_loc (Warnings.Bad_docstring true) | Docs -> match ds.ds_associated with | Zero | One -> () | Many -> prerr_warning ds.ds_loc (Warnings.Bad_docstring false)) (List.rev !docstrings) end (* Docstring constructors and destructors *) let docstring body loc = let ds = { ds_body = body; ds_loc = loc; ds_attached = Unattached; ds_associated = Zero; } in ds let register ds = docstrings := ds :: !docstrings let docstring_body ds = ds.ds_body let docstring_loc ds = ds.ds_loc (* Docstrings attached to items *) type docs = { docs_pre: docstring option; docs_post: docstring option; } let empty_docs = { docs_pre = None; docs_post = None } let doc_loc = {txt = "ocaml.doc"; loc = Location.none} let docs_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = doc_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_docs_attrs docs attrs = let attrs = match docs.docs_pre with | None | Some { ds_body=""; _ } -> attrs | Some ds -> docs_attr ds :: attrs in let attrs = match docs.docs_post with | None | Some { ds_body=""; _ } -> attrs | Some ds -> attrs @ [docs_attr ds] in attrs (* Docstrings attached to constructors or fields *) type info = docstring option let empty_info = None let info_attr = docs_attr let add_info_attrs info attrs = match info with | None | Some {ds_body=""; _} -> attrs | Some ds -> attrs @ [info_attr ds] (* Docstrings not attached to a specific item *) type text = docstring list let empty_text = [] let empty_text_lazy = lazy [] let text_loc = {txt = "ocaml.text"; loc = Location.none} let text_attr ds = let open Parsetree in let exp = { pexp_desc = Pexp_constant (Pconst_string(ds.ds_body, None)); pexp_loc = ds.ds_loc; pexp_loc_stack = []; pexp_attributes = []; } in let item = { pstr_desc = Pstr_eval (exp, []); pstr_loc = exp.pexp_loc } in { attr_name = text_loc; attr_payload = PStr [item]; attr_loc = Location.none } let add_text_attrs dsl attrs = let fdsl = List.filter (function {ds_body=""} -> false| _ ->true) dsl in (List.map text_attr fdsl) @ attrs (* Find the first non-info docstring in a list, attach it and return it *) let get_docstring ~info dsl = let rec loop = function | [] -> None | {ds_attached = Info; _} :: rest -> loop rest | ds :: _ -> ds.ds_attached <- if info then Info else Docs; Some ds in loop dsl (* Find all the non-info docstrings in a list, attach them and return them *) let get_docstrings dsl = let rec loop acc = function | [] -> List.rev acc | {ds_attached = Info; _} :: rest -> loop acc rest | ds :: rest -> ds.ds_attached <- Docs; loop (ds :: acc) rest in loop [] dsl (* "Associate" all the docstrings in a list *) let associate_docstrings dsl = List.iter (fun ds -> match ds.ds_associated with | Zero -> ds.ds_associated <- One | (One | Many) -> ds.ds_associated <- Many) dsl (* Map from positions to pre docstrings *) let pre_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_table pos dsl let get_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_pre_docs pos = try let dsl = Hashtbl.find pre_table pos in associate_docstrings dsl with Not_found -> () (* Map from positions to post docstrings *) let post_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_table pos dsl let get_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl; get_docstring ~info:false dsl with Not_found -> None let mark_post_docs pos = try let dsl = Hashtbl.find post_table pos in associate_docstrings dsl with Not_found -> () let get_info pos = try let dsl = Hashtbl.find post_table pos in get_docstring ~info:true dsl with Not_found -> None (* Map from positions to floating docstrings *) let floating_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_floating_docstrings pos dsl = if dsl <> [] then Hashtbl.add floating_table pos dsl let get_text pos = try let dsl = Hashtbl.find floating_table pos in get_docstrings dsl with Not_found -> [] let get_post_text pos = try let dsl = Hashtbl.find post_table pos in get_docstrings dsl with Not_found -> [] (* Maps from positions to extra docstrings *) let pre_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_pre_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add pre_extra_table pos dsl let get_pre_extra_text pos = try let dsl = Hashtbl.find pre_extra_table pos in get_docstrings dsl with Not_found -> [] let post_extra_table : (Lexing.position, docstring list) Hashtbl.t = Hashtbl.create 50 let set_post_extra_docstrings pos dsl = if dsl <> [] then Hashtbl.add post_extra_table pos dsl let get_post_extra_text pos = try let dsl = Hashtbl.find post_extra_table pos in get_docstrings dsl with Not_found -> [] (* Docstrings from parser actions *) module WithParsing = struct let symbol_docs () = { docs_pre = get_pre_docs (Parsing.symbol_start_pos ()); docs_post = get_post_docs (Parsing.symbol_end_pos ()); } let symbol_docs_lazy () = let p1 = Parsing.symbol_start_pos () in let p2 = Parsing.symbol_end_pos () in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs (Parsing.rhs_start_pos pos1); docs_post = get_post_docs (Parsing.rhs_end_pos pos2); } let rhs_docs_lazy pos1 pos2 = let p1 = Parsing.rhs_start_pos pos1 in let p2 = Parsing.rhs_end_pos pos2 in lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs () = mark_pre_docs (Parsing.symbol_start_pos ()); mark_post_docs (Parsing.symbol_end_pos ()) let mark_rhs_docs pos1 pos2 = mark_pre_docs (Parsing.rhs_start_pos pos1); mark_post_docs (Parsing.rhs_end_pos pos2) let symbol_info () = get_info (Parsing.symbol_end_pos ()) let rhs_info pos = get_info (Parsing.rhs_end_pos pos) let symbol_text () = get_text (Parsing.symbol_start_pos ()) let symbol_text_lazy () = let pos = Parsing.symbol_start_pos () in lazy (get_text pos) let rhs_text pos = get_text (Parsing.rhs_start_pos pos) let rhs_post_text pos = get_post_text (Parsing.rhs_end_pos pos) let rhs_text_lazy pos = let pos = Parsing.rhs_start_pos pos in lazy (get_text pos) let symbol_pre_extra_text () = get_pre_extra_text (Parsing.symbol_start_pos ()) let symbol_post_extra_text () = get_post_extra_text (Parsing.symbol_end_pos ()) let rhs_pre_extra_text pos = get_pre_extra_text (Parsing.rhs_start_pos pos) let rhs_post_extra_text pos = get_post_extra_text (Parsing.rhs_end_pos pos) end include WithParsing module WithMenhir = struct let symbol_docs (startpos, endpos) = { docs_pre = get_pre_docs startpos; docs_post = get_post_docs endpos; } let symbol_docs_lazy (p1, p2) = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let rhs_docs pos1 pos2 = { docs_pre = get_pre_docs pos1; docs_post = get_post_docs pos2; } let rhs_docs_lazy p1 p2 = lazy { docs_pre = get_pre_docs p1; docs_post = get_post_docs p2; } let mark_symbol_docs (startpos, endpos) = mark_pre_docs startpos; mark_post_docs endpos; () let mark_rhs_docs pos1 pos2 = mark_pre_docs pos1; mark_post_docs pos2; () let symbol_info endpos = get_info endpos let rhs_info endpos = get_info endpos let symbol_text startpos = get_text startpos let symbol_text_lazy startpos = lazy (get_text startpos) let rhs_text pos = get_text pos let rhs_post_text pos = get_post_text pos let rhs_text_lazy pos = lazy (get_text pos) let symbol_pre_extra_text startpos = get_pre_extra_text startpos let symbol_post_extra_text endpos = get_post_extra_text endpos let rhs_pre_extra_text pos = get_pre_extra_text pos let rhs_post_extra_text pos = get_post_extra_text pos end (* (Re)Initialise all comment state *) let init () = docstrings := []; Hashtbl.reset pre_table; Hashtbl.reset post_table; Hashtbl.reset floating_table; Hashtbl.reset pre_extra_table; Hashtbl.reset post_extra_table end module Ast_helper : sig open Asttypes open Docstrings open Parsetree type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type str_opt = string option with_loc type attrs = attribute list (** {1 Default locations} *) val default_loc: loc ref (** Default value for all optional location arguments. *) val with_default_loc: loc -> (unit -> 'a) -> 'a (** Set the [default_loc] within the scope of the execution of the provided function. *) (** {1 Constants} *) module Const : sig val char : char -> constant val string : ?quotation_delimiter:string -> string -> constant val integer : ?suffix:char -> string -> constant val int : ?suffix:char -> int -> constant val int32 : ?suffix:char -> int32 -> constant val int64 : ?suffix:char -> int64 -> constant val nativeint : ?suffix:char -> nativeint -> constant val float : ?suffix:char -> string -> constant end (** {1 Attributes} *) module Attr : sig val mk: ?loc:loc -> str -> payload -> attribute end (** {1 Core language} *) (** Type expressions *) module Typ : sig val mk: ?loc:loc -> ?attrs:attrs -> core_type_desc -> core_type val attr: core_type -> attribute -> core_type val any: ?loc:loc -> ?attrs:attrs -> unit -> core_type val var: ?loc:loc -> ?attrs:attrs -> string -> core_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> core_type -> core_type val tuple: ?loc:loc -> ?attrs:attrs -> core_type list -> core_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val object_: ?loc:loc -> ?attrs:attrs -> object_field list -> closed_flag -> core_type val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag -> label list option -> core_type val poly: ?loc:loc -> ?attrs:attrs -> str list -> core_type -> core_type val package: ?loc:loc -> ?attrs:attrs -> lid -> (lid * core_type) list -> core_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> core_type val force_poly: core_type -> core_type val varify_constructors: str list -> core_type -> core_type (** [varify_constructors newtypes te] is type expression [te], of which any of nullary type constructor [tc] is replaced by type variable of the same name, if [tc]'s name appears in [newtypes]. Raise [Syntaxerr.Variable_in_scope] if any type variable inside [te] appears in [newtypes]. @since 4.05 *) end (** Patterns *) module Pat: sig val mk: ?loc:loc -> ?attrs:attrs -> pattern_desc -> pattern val attr:pattern -> attribute -> pattern val any: ?loc:loc -> ?attrs:attrs -> unit -> pattern val var: ?loc:loc -> ?attrs:attrs -> str -> pattern val alias: ?loc:loc -> ?attrs:attrs -> pattern -> str -> pattern val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag -> pattern val array: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern val or_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern -> pattern val constraint_: ?loc:loc -> ?attrs:attrs -> pattern -> core_type -> pattern val type_: ?loc:loc -> ?attrs:attrs -> lid -> pattern val lazy_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val unpack: ?loc:loc -> ?attrs:attrs -> str_opt -> pattern val open_: ?loc:loc -> ?attrs:attrs -> lid -> pattern -> pattern val exception_: ?loc:loc -> ?attrs:attrs -> pattern -> pattern val extension: ?loc:loc -> ?attrs:attrs -> extension -> pattern end (** Expressions *) module Exp: sig val mk: ?loc:loc -> ?attrs:attrs -> expression_desc -> expression val attr: expression -> attribute -> expression val ident: ?loc:loc -> ?attrs:attrs -> lid -> expression val constant: ?loc:loc -> ?attrs:attrs -> constant -> expression val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> expression -> expression val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> expression -> expression val function_: ?loc:loc -> ?attrs:attrs -> case list -> expression val apply: ?loc:loc -> ?attrs:attrs -> expression -> (arg_label * expression) list -> expression val match_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_: ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val tuple: ?loc:loc -> ?attrs:attrs -> expression list -> expression val construct: ?loc:loc -> ?attrs:attrs -> lid -> expression option -> expression val variant: ?loc:loc -> ?attrs:attrs -> label -> expression option -> expression val record: ?loc:loc -> ?attrs:attrs -> (lid * expression) list -> expression option -> expression val field: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression val setfield: ?loc:loc -> ?attrs:attrs -> expression -> lid -> expression -> expression val array: ?loc:loc -> ?attrs:attrs -> expression list -> expression val ifthenelse: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression option -> expression val sequence: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val while_: ?loc:loc -> ?attrs:attrs -> expression -> expression -> expression val for_: ?loc:loc -> ?attrs:attrs -> pattern -> expression -> expression -> direction_flag -> expression -> expression val coerce: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> core_type -> expression val constraint_: ?loc:loc -> ?attrs:attrs -> expression -> core_type -> expression val send: ?loc:loc -> ?attrs:attrs -> expression -> str -> expression val new_: ?loc:loc -> ?attrs:attrs -> lid -> expression val setinstvar: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val override: ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression val letmodule: ?loc:loc -> ?attrs:attrs -> str_opt -> module_expr -> expression -> expression val letexception: ?loc:loc -> ?attrs:attrs -> extension_constructor -> expression -> expression val assert_: ?loc:loc -> ?attrs:attrs -> expression -> expression val lazy_: ?loc:loc -> ?attrs:attrs -> expression -> expression val poly: ?loc:loc -> ?attrs:attrs -> expression -> core_type option -> expression val object_: ?loc:loc -> ?attrs:attrs -> class_structure -> expression val newtype: ?loc:loc -> ?attrs:attrs -> str -> expression -> expression val pack: ?loc:loc -> ?attrs:attrs -> module_expr -> expression val open_: ?loc:loc -> ?attrs:attrs -> open_declaration -> expression -> expression val letop: ?loc:loc -> ?attrs:attrs -> binding_op -> binding_op list -> expression -> expression val extension: ?loc:loc -> ?attrs:attrs -> extension -> expression val unreachable: ?loc:loc -> ?attrs:attrs -> unit -> expression val case: pattern -> ?guard:expression -> expression -> case val binding_op: str -> pattern -> expression -> loc -> binding_op end (** Value declarations *) module Val: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?prim:string list -> str -> core_type -> value_description end (** Type declarations *) module Type: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?params:(core_type * variance) list -> ?cstrs:(core_type * core_type * loc) list -> ?kind:type_kind -> ?priv:private_flag -> ?manifest:core_type -> str -> type_declaration val constructor: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> constructor_declaration val field: ?loc:loc -> ?attrs:attrs -> ?info:info -> ?mut:mutable_flag -> str -> core_type -> label_declaration end (** Type extensions *) module Te: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?params:(core_type * variance) list -> ?priv:private_flag -> lid -> extension_constructor list -> type_extension val mk_exception: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> extension_constructor -> type_exception val constructor: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> extension_constructor_kind -> extension_constructor val decl: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> ?args:constructor_arguments -> ?res:core_type -> str -> extension_constructor val rebind: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?info:info -> str -> lid -> extension_constructor end (** {1 Module language} *) (** Module type expressions *) module Mty: sig val mk: ?loc:loc -> ?attrs:attrs -> module_type_desc -> module_type val attr: module_type -> attribute -> module_type val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_type val alias: ?loc:loc -> ?attrs:attrs -> lid -> module_type val signature: ?loc:loc -> ?attrs:attrs -> signature -> module_type val functor_: ?loc:loc -> ?attrs:attrs -> functor_parameter -> module_type -> module_type val with_: ?loc:loc -> ?attrs:attrs -> module_type -> with_constraint list -> module_type val typeof_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_type end (** Module expressions *) module Mod: sig val mk: ?loc:loc -> ?attrs:attrs -> module_expr_desc -> module_expr val attr: module_expr -> attribute -> module_expr val ident: ?loc:loc -> ?attrs:attrs -> lid -> module_expr val structure: ?loc:loc -> ?attrs:attrs -> structure -> module_expr val functor_: ?loc:loc -> ?attrs:attrs -> functor_parameter -> module_expr -> module_expr val apply: ?loc:loc -> ?attrs:attrs -> module_expr -> module_expr -> module_expr val constraint_: ?loc:loc -> ?attrs:attrs -> module_expr -> module_type -> module_expr val unpack: ?loc:loc -> ?attrs:attrs -> expression -> module_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> module_expr end (** Signature items *) module Sig: sig val mk: ?loc:loc -> signature_item_desc -> signature_item val value: ?loc:loc -> value_description -> signature_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> signature_item val type_subst: ?loc:loc -> type_declaration list -> signature_item val type_extension: ?loc:loc -> type_extension -> signature_item val exception_: ?loc:loc -> type_exception -> signature_item val module_: ?loc:loc -> module_declaration -> signature_item val mod_subst: ?loc:loc -> module_substitution -> signature_item val rec_module: ?loc:loc -> module_declaration list -> signature_item val modtype: ?loc:loc -> module_type_declaration -> signature_item val open_: ?loc:loc -> open_description -> signature_item val include_: ?loc:loc -> include_description -> signature_item val class_: ?loc:loc -> class_description list -> signature_item val class_type: ?loc:loc -> class_type_declaration list -> signature_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item val attribute: ?loc:loc -> attribute -> signature_item val text: text -> signature_item list end (** Structure items *) module Str: sig val mk: ?loc:loc -> structure_item_desc -> structure_item val eval: ?loc:loc -> ?attrs:attributes -> expression -> structure_item val value: ?loc:loc -> rec_flag -> value_binding list -> structure_item val primitive: ?loc:loc -> value_description -> structure_item val type_: ?loc:loc -> rec_flag -> type_declaration list -> structure_item val type_extension: ?loc:loc -> type_extension -> structure_item val exception_: ?loc:loc -> type_exception -> structure_item val module_: ?loc:loc -> module_binding -> structure_item val rec_module: ?loc:loc -> module_binding list -> structure_item val modtype: ?loc:loc -> module_type_declaration -> structure_item val open_: ?loc:loc -> open_declaration -> structure_item val class_: ?loc:loc -> class_declaration list -> structure_item val class_type: ?loc:loc -> class_type_declaration list -> structure_item val include_: ?loc:loc -> include_declaration -> structure_item val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item val attribute: ?loc:loc -> attribute -> structure_item val text: text -> structure_item list end (** Module declarations *) module Md: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str_opt -> module_type -> module_declaration end (** Module substitutions *) module Ms: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str -> lid -> module_substitution end (** Module type declarations *) module Mtd: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?typ:module_type -> str -> module_type_declaration end (** Module bindings *) module Mb: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> str_opt -> module_expr -> module_binding end (** Opens *) module Opn: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?override:override_flag -> 'a -> 'a open_infos end (** Includes *) module Incl: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> 'a -> 'a include_infos end (** Value bindings *) module Vb: sig val mk: ?loc: loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> pattern -> expression -> value_binding end (** {1 Class language} *) (** Class type expressions *) module Cty: sig val mk: ?loc:loc -> ?attrs:attrs -> class_type_desc -> class_type val attr: class_type -> attribute -> class_type val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_type val signature: ?loc:loc -> ?attrs:attrs -> class_signature -> class_type val arrow: ?loc:loc -> ?attrs:attrs -> arg_label -> core_type -> class_type -> class_type val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_type -> class_type end (** Class type fields *) module Ctf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_type_field_desc -> class_type_field val attr: class_type_field -> attribute -> class_type_field val inherit_: ?loc:loc -> ?attrs:attrs -> class_type -> class_type_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> virtual_flag -> core_type -> class_type_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> virtual_flag -> core_type -> class_type_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_type_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_type_field val attribute: ?loc:loc -> attribute -> class_type_field val text: text -> class_type_field list end (** Class expressions *) module Cl: sig val mk: ?loc:loc -> ?attrs:attrs -> class_expr_desc -> class_expr val attr: class_expr -> attribute -> class_expr val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> class_expr val structure: ?loc:loc -> ?attrs:attrs -> class_structure -> class_expr val fun_: ?loc:loc -> ?attrs:attrs -> arg_label -> expression option -> pattern -> class_expr -> class_expr val apply: ?loc:loc -> ?attrs:attrs -> class_expr -> (arg_label * expression) list -> class_expr val let_: ?loc:loc -> ?attrs:attrs -> rec_flag -> value_binding list -> class_expr -> class_expr val constraint_: ?loc:loc -> ?attrs:attrs -> class_expr -> class_type -> class_expr val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_expr val open_: ?loc:loc -> ?attrs:attrs -> open_description -> class_expr -> class_expr end (** Class fields *) module Cf: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> class_field_desc -> class_field val attr: class_field -> attribute -> class_field val inherit_: ?loc:loc -> ?attrs:attrs -> override_flag -> class_expr -> str option -> class_field val val_: ?loc:loc -> ?attrs:attrs -> str -> mutable_flag -> class_field_kind -> class_field val method_: ?loc:loc -> ?attrs:attrs -> str -> private_flag -> class_field_kind -> class_field val constraint_: ?loc:loc -> ?attrs:attrs -> core_type -> core_type -> class_field val initializer_: ?loc:loc -> ?attrs:attrs -> expression -> class_field val extension: ?loc:loc -> ?attrs:attrs -> extension -> class_field val attribute: ?loc:loc -> attribute -> class_field val text: text -> class_field list val virtual_: core_type -> class_field_kind val concrete: override_flag -> expression -> class_field_kind end (** Classes *) module Ci: sig val mk: ?loc:loc -> ?attrs:attrs -> ?docs:docs -> ?text:text -> ?virt:virtual_flag -> ?params:(core_type * variance) list -> str -> 'a -> 'a class_infos end (** Class signatures *) module Csig: sig val mk: core_type -> class_type_field list -> class_signature end (** Class structures *) module Cstr: sig val mk: pattern -> class_field list -> class_structure end (** Row fields *) module Rf: sig val mk: ?loc:loc -> ?attrs:attrs -> row_field_desc -> row_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> bool -> core_type list -> row_field val inherit_: ?loc:loc -> core_type -> row_field end (** Object fields *) module Of: sig val mk: ?loc:loc -> ?attrs:attrs -> object_field_desc -> object_field val tag: ?loc:loc -> ?attrs:attrs -> label with_loc -> core_type -> object_field val inherit_: ?loc:loc -> core_type -> object_field end end = struct open Asttypes open Parsetree open Docstrings type 'a with_loc = 'a Location.loc type loc = Location.t type lid = Longident.t with_loc type str = string with_loc type str_opt = string option with_loc type attrs = attribute list let default_loc = ref Location.none let with_default_loc l f = Misc.protect_refs [Misc.R (default_loc, l)] f module Const = struct let integer ?suffix i = Pconst_integer (i, suffix) let int ?suffix i = integer ?suffix (Int.to_string i) let int32 ?(suffix='l') i = integer ~suffix (Int32.to_string i) let int64 ?(suffix='L') i = integer ~suffix (Int64.to_string i) let nativeint ?(suffix='n') i = integer ~suffix (Nativeint.to_string i) let float ?suffix f = Pconst_float (f, suffix) let char c = Pconst_char c let string ?quotation_delimiter s = Pconst_string (s, quotation_delimiter) end module Attr = struct let mk ?(loc= !default_loc) name payload = { attr_name = name; attr_payload = payload; attr_loc = loc } end module Typ = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ptyp_desc = d; ptyp_loc = loc; ptyp_loc_stack = []; ptyp_attributes = attrs} let attr d a = {d with ptyp_attributes = d.ptyp_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_arrow (a, b, c)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b)) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b)) let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c)) let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b)) let package ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_package (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Ptyp_extension a) let force_poly t = match t.ptyp_desc with | Ptyp_poly _ -> t | _ -> poly ~loc:t.ptyp_loc [] t (* -> ghost? *) let varify_constructors var_names t = let check_variable vl loc v = if List.mem v vl then raise Syntaxerr.(Error(Variable_in_scope(loc,v))) in let var_names = List.map (fun v -> v.txt) var_names in let rec loop t = let desc = match t.ptyp_desc with | Ptyp_any -> Ptyp_any | Ptyp_var x -> check_variable var_names t.ptyp_loc x; Ptyp_var x | Ptyp_arrow (label,core_type,core_type') -> Ptyp_arrow(label, loop core_type, loop core_type') | Ptyp_tuple lst -> Ptyp_tuple (List.map loop lst) | Ptyp_constr( { txt = Longident.Lident s }, []) when List.mem s var_names -> Ptyp_var s | Ptyp_constr(longident, lst) -> Ptyp_constr(longident, List.map loop lst) | Ptyp_object (lst, o) -> Ptyp_object (List.map loop_object_field lst, o) | Ptyp_class (longident, lst) -> Ptyp_class (longident, List.map loop lst) | Ptyp_alias(core_type, string) -> check_variable var_names t.ptyp_loc string; Ptyp_alias(loop core_type, string) | Ptyp_variant(row_field_list, flag, lbl_lst_option) -> Ptyp_variant(List.map loop_row_field row_field_list, flag, lbl_lst_option) | Ptyp_poly(string_lst, core_type) -> List.iter (fun v -> check_variable var_names t.ptyp_loc v.txt) string_lst; Ptyp_poly(string_lst, loop core_type) | Ptyp_package(longident,lst) -> Ptyp_package(longident,List.map (fun (n,typ) -> (n,loop typ) ) lst) | Ptyp_extension (s, arg) -> Ptyp_extension (s, arg) in {t with ptyp_desc = desc} and loop_row_field field = let prf_desc = match field.prf_desc with | Rtag(label,flag,lst) -> Rtag(label,flag,List.map loop lst) | Rinherit t -> Rinherit (loop t) in { field with prf_desc; } and loop_object_field field = let pof_desc = match field.pof_desc with | Otag(label, t) -> Otag(label, loop t) | Oinherit t -> Oinherit (loop t) in { field with pof_desc; } in loop t end module Pat = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {ppat_desc = d; ppat_loc = loc; ppat_loc_stack = []; ppat_attributes = attrs} let attr d a = {d with ppat_attributes = d.ppat_attributes @ [a]} let any ?loc ?attrs () = mk ?loc ?attrs Ppat_any let var ?loc ?attrs a = mk ?loc ?attrs (Ppat_var a) let alias ?loc ?attrs a b = mk ?loc ?attrs (Ppat_alias (a, b)) let constant ?loc ?attrs a = mk ?loc ?attrs (Ppat_constant a) let interval ?loc ?attrs a b = mk ?loc ?attrs (Ppat_interval (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ppat_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Ppat_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Ppat_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Ppat_record (a, b)) let array ?loc ?attrs a = mk ?loc ?attrs (Ppat_array a) let or_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_or (a, b)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_constraint (a, b)) let type_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_type a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_lazy a) let unpack ?loc ?attrs a = mk ?loc ?attrs (Ppat_unpack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Ppat_open (a, b)) let exception_ ?loc ?attrs a = mk ?loc ?attrs (Ppat_exception a) let extension ?loc ?attrs a = mk ?loc ?attrs (Ppat_extension a) end module Exp = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pexp_desc = d; pexp_loc = loc; pexp_loc_stack = []; pexp_attributes = attrs} let attr d a = {d with pexp_attributes = d.pexp_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pexp_fun (a, b, c, d)) let function_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_function a) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pexp_apply (a, b)) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) let try_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_try (a, b)) let tuple ?loc ?attrs a = mk ?loc ?attrs (Pexp_tuple a) let construct ?loc ?attrs a b = mk ?loc ?attrs (Pexp_construct (a, b)) let variant ?loc ?attrs a b = mk ?loc ?attrs (Pexp_variant (a, b)) let record ?loc ?attrs a b = mk ?loc ?attrs (Pexp_record (a, b)) let field ?loc ?attrs a b = mk ?loc ?attrs (Pexp_field (a, b)) let setfield ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_setfield (a, b, c)) let array ?loc ?attrs a = mk ?loc ?attrs (Pexp_array a) let ifthenelse ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_ifthenelse (a, b, c)) let sequence ?loc ?attrs a b = mk ?loc ?attrs (Pexp_sequence (a, b)) let while_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_while (a, b)) let for_ ?loc ?attrs a b c d e = mk ?loc ?attrs (Pexp_for (a, b, c, d, e)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_constraint (a, b)) let coerce ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_coerce (a, b, c)) let send ?loc ?attrs a b = mk ?loc ?attrs (Pexp_send (a, b)) let new_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_new a) let setinstvar ?loc ?attrs a b = mk ?loc ?attrs (Pexp_setinstvar (a, b)) let override ?loc ?attrs a = mk ?loc ?attrs (Pexp_override a) let letmodule ?loc ?attrs a b c= mk ?loc ?attrs (Pexp_letmodule (a, b, c)) let letexception ?loc ?attrs a b = mk ?loc ?attrs (Pexp_letexception (a, b)) let assert_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_assert a) let lazy_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_lazy a) let poly ?loc ?attrs a b = mk ?loc ?attrs (Pexp_poly (a, b)) let object_ ?loc ?attrs a = mk ?loc ?attrs (Pexp_object a) let newtype ?loc ?attrs a b = mk ?loc ?attrs (Pexp_newtype (a, b)) let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_open (a, b)) let letop ?loc ?attrs let_ ands body = mk ?loc ?attrs (Pexp_letop {let_; ands; body}) let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a) let unreachable ?loc ?attrs () = mk ?loc ?attrs Pexp_unreachable let case lhs ?guard rhs = { pc_lhs = lhs; pc_guard = guard; pc_rhs = rhs; } let binding_op op pat exp loc = { pbop_op = op; pbop_pat = pat; pbop_exp = exp; pbop_loc = loc; } end module Mty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmty_desc = d; pmty_loc = loc; pmty_attributes = attrs} let attr d a = {d with pmty_attributes = d.pmty_attributes @ [a]} let ident ?loc ?attrs a = mk ?loc ?attrs (Pmty_ident a) let alias ?loc ?attrs a = mk ?loc ?attrs (Pmty_alias a) let signature ?loc ?attrs a = mk ?loc ?attrs (Pmty_signature a) let functor_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_functor (a, b)) let with_ ?loc ?attrs a b = mk ?loc ?attrs (Pmty_with (a, b)) let typeof_ ?loc ?attrs a = mk ?loc ?attrs (Pmty_typeof a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmty_extension a) end module Mod = struct let mk ?(loc = !default_loc) ?(attrs = []) d = {pmod_desc = d; pmod_loc = loc; pmod_attributes = attrs} let attr d a = {d with pmod_attributes = d.pmod_attributes @ [a]} let ident ?loc ?attrs x = mk ?loc ?attrs (Pmod_ident x) let structure ?loc ?attrs x = mk ?loc ?attrs (Pmod_structure x) let functor_ ?loc ?attrs arg body = mk ?loc ?attrs (Pmod_functor (arg, body)) let apply ?loc ?attrs m1 m2 = mk ?loc ?attrs (Pmod_apply (m1, m2)) let constraint_ ?loc ?attrs m mty = mk ?loc ?attrs (Pmod_constraint (m, mty)) let unpack ?loc ?attrs e = mk ?loc ?attrs (Pmod_unpack e) let extension ?loc ?attrs a = mk ?loc ?attrs (Pmod_extension a) end module Sig = struct let mk ?(loc = !default_loc) d = {psig_desc = d; psig_loc = loc} let value ?loc a = mk ?loc (Psig_value a) let type_ ?loc rec_flag a = mk ?loc (Psig_type (rec_flag, a)) let type_subst ?loc a = mk ?loc (Psig_typesubst a) let type_extension ?loc a = mk ?loc (Psig_typext a) let exception_ ?loc a = mk ?loc (Psig_exception a) let module_ ?loc a = mk ?loc (Psig_module a) let mod_subst ?loc a = mk ?loc (Psig_modsubst a) let rec_module ?loc a = mk ?loc (Psig_recmodule a) let modtype ?loc a = mk ?loc (Psig_modtype a) let open_ ?loc a = mk ?loc (Psig_open a) let include_ ?loc a = mk ?loc (Psig_include a) let class_ ?loc a = mk ?loc (Psig_class a) let class_type ?loc a = mk ?loc (Psig_class_type a) let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs)) let attribute ?loc a = mk ?loc (Psig_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Str = struct let mk ?(loc = !default_loc) d = {pstr_desc = d; pstr_loc = loc} let eval ?loc ?(attrs = []) a = mk ?loc (Pstr_eval (a, attrs)) let value ?loc a b = mk ?loc (Pstr_value (a, b)) let primitive ?loc a = mk ?loc (Pstr_primitive a) let type_ ?loc rec_flag a = mk ?loc (Pstr_type (rec_flag, a)) let type_extension ?loc a = mk ?loc (Pstr_typext a) let exception_ ?loc a = mk ?loc (Pstr_exception a) let module_ ?loc a = mk ?loc (Pstr_module a) let rec_module ?loc a = mk ?loc (Pstr_recmodule a) let modtype ?loc a = mk ?loc (Pstr_modtype a) let open_ ?loc a = mk ?loc (Pstr_open a) let class_ ?loc a = mk ?loc (Pstr_class a) let class_type ?loc a = mk ?loc (Pstr_class_type a) let include_ ?loc a = mk ?loc (Pstr_include a) let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs)) let attribute ?loc a = mk ?loc (Pstr_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt end module Cl = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcl_desc = d; pcl_loc = loc; pcl_attributes = attrs; } let attr d a = {d with pcl_attributes = d.pcl_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constr (a, b)) let structure ?loc ?attrs a = mk ?loc ?attrs (Pcl_structure a) let fun_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pcl_fun (a, b, c, d)) let apply ?loc ?attrs a b = mk ?loc ?attrs (Pcl_apply (a, b)) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcl_let (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcl_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcl_open (a, b)) end module Cty = struct let mk ?(loc = !default_loc) ?(attrs = []) d = { pcty_desc = d; pcty_loc = loc; pcty_attributes = attrs; } let attr d a = {d with pcty_attributes = d.pcty_attributes @ [a]} let constr ?loc ?attrs a b = mk ?loc ?attrs (Pcty_constr (a, b)) let signature ?loc ?attrs a = mk ?loc ?attrs (Pcty_signature a) let arrow ?loc ?attrs a b c = mk ?loc ?attrs (Pcty_arrow (a, b, c)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcty_extension a) let open_ ?loc ?attrs a b = mk ?loc ?attrs (Pcty_open (a, b)) end module Ctf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pctf_desc = d; pctf_loc = loc; pctf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a = mk ?loc ?attrs (Pctf_inherit a) let val_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_val (a, b, c, d)) let method_ ?loc ?attrs a b c d = mk ?loc ?attrs (Pctf_method (a, b, c, d)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pctf_constraint (a, b)) let extension ?loc ?attrs a = mk ?loc ?attrs (Pctf_extension a) let attribute ?loc a = mk ?loc (Pctf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let attr d a = {d with pctf_attributes = d.pctf_attributes @ [a]} end module Cf = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) d = { pcf_desc = d; pcf_loc = loc; pcf_attributes = add_docs_attrs docs attrs; } let inherit_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_inherit (a, b, c)) let val_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_val (a, b, c)) let method_ ?loc ?attrs a b c = mk ?loc ?attrs (Pcf_method (a, b, c)) let constraint_ ?loc ?attrs a b = mk ?loc ?attrs (Pcf_constraint (a, b)) let initializer_ ?loc ?attrs a = mk ?loc ?attrs (Pcf_initializer a) let extension ?loc ?attrs a = mk ?loc ?attrs (Pcf_extension a) let attribute ?loc a = mk ?loc (Pcf_attribute a) let text txt = let f_txt = List.filter (fun ds -> docstring_body ds <> "") txt in List.map (fun ds -> attribute ~loc:(docstring_loc ds) (text_attr ds)) f_txt let virtual_ ct = Cfk_virtual ct let concrete o e = Cfk_concrete (o, e) let attr d a = {d with pcf_attributes = d.pcf_attributes @ [a]} end module Val = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(prim = []) name typ = { pval_name = name; pval_type = typ; pval_attributes = add_docs_attrs docs attrs; pval_loc = loc; pval_prim = prim; } end module Md = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name typ = { pmd_name = name; pmd_type = typ; pmd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmd_loc = loc; } end module Ms = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name syn = { pms_name = name; pms_manifest = syn; pms_attributes = add_text_attrs text (add_docs_attrs docs attrs); pms_loc = loc; } end module Mtd = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?typ name = { pmtd_name = name; pmtd_type = typ; pmtd_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmtd_loc = loc; } end module Mb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) name expr = { pmb_name = name; pmb_expr = expr; pmb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pmb_loc = loc; } end module Opn = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(override = Fresh) expr = { popen_expr = expr; popen_override = override; popen_loc = loc; popen_attributes = add_docs_attrs docs attrs; } end module Incl = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) mexpr = { pincl_mod = mexpr; pincl_loc = loc; pincl_attributes = add_docs_attrs docs attrs; } end module Vb = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) pat expr = { pvb_pat = pat; pvb_expr = expr; pvb_attributes = add_text_attrs text (add_docs_attrs docs attrs); pvb_loc = loc; } end module Ci = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(virt = Concrete) ?(params = []) name expr = { pci_virt = virt; pci_params = params; pci_name = name; pci_expr = expr; pci_attributes = add_text_attrs text (add_docs_attrs docs attrs); pci_loc = loc; } end module Type = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(text = []) ?(params = []) ?(cstrs = []) ?(kind = Ptype_abstract) ?(priv = Public) ?manifest name = { ptype_name = name; ptype_params = params; ptype_cstrs = cstrs; ptype_kind = kind; ptype_private = priv; ptype_manifest = manifest; ptype_attributes = add_text_attrs text (add_docs_attrs docs attrs); ptype_loc = loc; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pcd_name = name; pcd_args = args; pcd_res = res; pcd_loc = loc; pcd_attributes = add_info_attrs info attrs; } let field ?(loc = !default_loc) ?(attrs = []) ?(info = empty_info) ?(mut = Immutable) name typ = { pld_name = name; pld_mutable = mut; pld_type = typ; pld_loc = loc; pld_attributes = add_info_attrs info attrs; } end (** Type extensions *) module Te = struct let mk ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(params = []) ?(priv = Public) path constructors = { ptyext_path = path; ptyext_params = params; ptyext_constructors = constructors; ptyext_private = priv; ptyext_loc = loc; ptyext_attributes = add_docs_attrs docs attrs; } let mk_exception ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) constructor = { ptyexn_constructor = constructor; ptyexn_loc = loc; ptyexn_attributes = add_docs_attrs docs attrs; } let constructor ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name kind = { pext_name = name; pext_kind = kind; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let decl ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) ?(args = Pcstr_tuple []) ?res name = { pext_name = name; pext_kind = Pext_decl(args, res); pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } let rebind ?(loc = !default_loc) ?(attrs = []) ?(docs = empty_docs) ?(info = empty_info) name lid = { pext_name = name; pext_kind = Pext_rebind lid; pext_loc = loc; pext_attributes = add_docs_attrs docs (add_info_attrs info attrs); } end module Csig = struct let mk self fields = { pcsig_self = self; pcsig_fields = fields; } end module Cstr = struct let mk self fields = { pcstr_self = self; pcstr_fields = fields; } end (** Row fields *) module Rf = struct let mk ?(loc = !default_loc) ?(attrs = []) desc = { prf_desc = desc; prf_loc = loc; prf_attributes = attrs; } let tag ?loc ?attrs label const tys = mk ?loc ?attrs (Rtag (label, const, tys)) let inherit_?loc ty = mk ?loc (Rinherit ty) end (** Object fields *) module Of = struct let mk ?(loc = !default_loc) ?(attrs=[]) desc = { pof_desc = desc; pof_loc = loc; pof_attributes = attrs; } let tag ?loc ?attrs label ty = mk ?loc ?attrs (Otag (label, ty)) let inherit_ ?loc ty = mk ?loc (Oinherit ty) end end module Ast_mapper : sig open Parsetree (** {1 A generic Parsetree mapper} *) type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } (** A mapper record implements one "method" per syntactic category, using an open recursion style: each method takes as its first argument the mapper to be applied to children in the syntax tree. *) val default_mapper: mapper (** A default mapper, which implements a "deep identity" mapping. *) (** {1 Apply mappers to compilation units} *) val tool_name: unit -> string (** Can be used within a ppx preprocessor to know which tool is calling it ["ocamlc"], ["ocamlopt"], ["ocamldoc"], ["ocamldep"], ["ocaml"], ... Some global variables that reflect command-line options are automatically synchronized between the calling tool and the ppx preprocessor: {!Clflags.include_dirs}, {!Load_path}, {!Clflags.open_modules}, {!Clflags.for_package}, {!Clflags.debug}. *) val apply: source:string -> target:string -> mapper -> unit (** Apply a mapper (parametrized by the unit name) to a dumped parsetree found in the [source] file and put the result in the [target] file. The [structure] or [signature] field of the mapper is applied to the implementation or interface. *) val run_main: (string list -> mapper) -> unit (** Entry point to call to implement a standalone -ppx rewriter from a mapper, parametrized by the command line arguments. The current unit name can be obtained from {!Location.input_name}. This function implements proper error reporting for uncaught exceptions. *) (** {1 Registration API} *) val register_function: (string -> (string list -> mapper) -> unit) ref val register: string -> (string list -> mapper) -> unit (** Apply the [register_function]. The default behavior is to run the mapper immediately, taking arguments from the process command line. This is to support a scenario where a mapper is linked as a stand-alone executable. It is possible to overwrite the [register_function] to define "-ppx drivers", which combine several mappers in a single process. Typically, a driver starts by defining [register_function] to a custom implementation, then lets ppx rewriters (linked statically or dynamically) register themselves, and then run all or some of them. It is also possible to have -ppx drivers apply rewriters to only specific parts of an AST. The first argument to [register] is a symbolic name to be used by the ppx driver. *) (** {1 Convenience functions to write mappers} *) val map_opt: ('a -> 'b) -> 'a option -> 'b option val extension_of_error: Locations.location_error -> extension (** Encode an error into an 'ocaml.error' extension node which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the error. *) val attribute_of_warning: Location.t -> string -> attribute (** Encode a warning message into an 'ocaml.ppwarning' attribute which can be inserted in a generated Parsetree. The compiler will be responsible for reporting the warning. *) include Locations.Helpers_intf (** {1 Helper functions to call external mappers} *) val add_ppx_context_str: tool_name:string -> Parsetree.structure -> Parsetree.structure (** Extract information from the current environment and encode it into an attribute which is prepended to the list of structure items in order to pass the information to an external processor. *) val add_ppx_context_sig: tool_name:string -> Parsetree.signature -> Parsetree.signature (** Same as [add_ppx_context_str], but for signatures. *) val drop_ppx_context_str: restore:bool -> Parsetree.structure -> Parsetree.structure (** Drop the ocaml.ppx.context attribute from a structure. If [restore] is true, also restore the associated data in the current process. *) val drop_ppx_context_sig: restore:bool -> Parsetree.signature -> Parsetree.signature (** Same as [drop_ppx_context_str], but for signatures. *) (** {1 Cookies} *) (** Cookies are used to pass information from a ppx processor to a further invocation of itself, when called from the OCaml toplevel (or other tools that support cookies). *) val set_cookie: string -> Parsetree.expression -> unit val get_cookie: string -> Parsetree.expression option end = struct open Parsetree open Ast_helper open Location module String = Misc.Stdlib.String type mapper (*IF_CURRENT = Ast_mapper.mapper *) = { attribute: mapper -> attribute -> attribute; attributes: mapper -> attribute list -> attribute list; binding_op: mapper -> binding_op -> binding_op; case: mapper -> case -> case; cases: mapper -> case list -> case list; class_declaration: mapper -> class_declaration -> class_declaration; class_description: mapper -> class_description -> class_description; class_expr: mapper -> class_expr -> class_expr; class_field: mapper -> class_field -> class_field; class_signature: mapper -> class_signature -> class_signature; class_structure: mapper -> class_structure -> class_structure; class_type: mapper -> class_type -> class_type; class_type_declaration: mapper -> class_type_declaration -> class_type_declaration; class_type_field: mapper -> class_type_field -> class_type_field; constructor_declaration: mapper -> constructor_declaration -> constructor_declaration; expr: mapper -> expression -> expression; extension: mapper -> extension -> extension; extension_constructor: mapper -> extension_constructor -> extension_constructor; include_declaration: mapper -> include_declaration -> include_declaration; include_description: mapper -> include_description -> include_description; label_declaration: mapper -> label_declaration -> label_declaration; location: mapper -> Location.t -> Location.t; module_binding: mapper -> module_binding -> module_binding; module_declaration: mapper -> module_declaration -> module_declaration; module_substitution: mapper -> module_substitution -> module_substitution; module_expr: mapper -> module_expr -> module_expr; module_type: mapper -> module_type -> module_type; module_type_declaration: mapper -> module_type_declaration -> module_type_declaration; open_declaration: mapper -> open_declaration -> open_declaration; open_description: mapper -> open_description -> open_description; pat: mapper -> pattern -> pattern; payload: mapper -> payload -> payload; signature: mapper -> signature -> signature; signature_item: mapper -> signature_item -> signature_item; structure: mapper -> structure -> structure; structure_item: mapper -> structure_item -> structure_item; typ: mapper -> core_type -> core_type; type_declaration: mapper -> type_declaration -> type_declaration; type_extension: mapper -> type_extension -> type_extension; type_exception: mapper -> type_exception -> type_exception; type_kind: mapper -> type_kind -> type_kind; value_binding: mapper -> value_binding -> value_binding; value_description: mapper -> value_description -> value_description; with_constraint: mapper -> with_constraint -> with_constraint; } let map_fst f (x, y) = (f x, y) let map_snd f (x, y) = (x, f y) let map_tuple f1 f2 (x, y) = (f1 x, f2 y) let map_tuple3 f1 f2 f3 (x, y, z) = (f1 x, f2 y, f3 z) let map_opt f = function None -> None | Some x -> Some (f x) let map_loc sub {loc; txt} = {loc = sub.location sub loc; txt} module T = struct (* Type expressions for the core language *) let row_field sub { prf_desc; prf_loc; prf_attributes; } = let loc = sub.location sub prf_loc in let attrs = sub.attributes sub prf_attributes in let desc = match prf_desc with | Rtag (l, b, tl) -> Rtag (map_loc sub l, b, List.map (sub.typ sub) tl) | Rinherit t -> Rinherit (sub.typ sub t) in Rf.mk ~loc ~attrs desc let object_field sub { pof_desc; pof_loc; pof_attributes; } = let loc = sub.location sub pof_loc in let attrs = sub.attributes sub pof_attributes in let desc = match pof_desc with | Otag (l, t) -> Otag (map_loc sub l, sub.typ sub t) | Oinherit t -> Oinherit (sub.typ sub t) in Of.mk ~loc ~attrs desc let map sub {ptyp_desc = desc; ptyp_loc = loc; ptyp_attributes = attrs} = let open Typ in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> arrow ~loc ~attrs lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_object (l, o) -> object_ ~loc ~attrs (List.map (object_field sub) l) o | Ptyp_class (lid, tl) -> class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s | Ptyp_variant (rl, b, ll) -> variant ~loc ~attrs (List.map (row_field sub) rl) b ll | Ptyp_poly (sl, t) -> poly ~loc ~attrs (List.map (map_loc sub) sl) (sub.typ sub t) | Ptyp_package (lid, l) -> package ~loc ~attrs (map_loc sub lid) (List.map (map_tuple (map_loc sub) (sub.typ sub)) l) | Ptyp_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_type_declaration sub {ptype_name; ptype_params; ptype_cstrs; ptype_kind; ptype_private; ptype_manifest; ptype_attributes; ptype_loc} = let loc = sub.location sub ptype_loc in let attrs = sub.attributes sub ptype_attributes in Type.mk ~loc ~attrs (map_loc sub ptype_name) ~params:(List.map (map_fst (sub.typ sub)) ptype_params) ~priv:ptype_private ~cstrs:(List.map (map_tuple3 (sub.typ sub) (sub.typ sub) (sub.location sub)) ptype_cstrs) ~kind:(sub.type_kind sub ptype_kind) ?manifest:(map_opt (sub.typ sub) ptype_manifest) let map_type_kind sub = function | Ptype_abstract -> Ptype_abstract | Ptype_variant l -> Ptype_variant (List.map (sub.constructor_declaration sub) l) | Ptype_record l -> Ptype_record (List.map (sub.label_declaration sub) l) | Ptype_open -> Ptype_open let map_constructor_arguments sub = function | Pcstr_tuple l -> Pcstr_tuple (List.map (sub.typ sub) l) | Pcstr_record l -> Pcstr_record (List.map (sub.label_declaration sub) l) let map_type_extension sub {ptyext_path; ptyext_params; ptyext_constructors; ptyext_private; ptyext_loc; ptyext_attributes} = let loc = sub.location sub ptyext_loc in let attrs = sub.attributes sub ptyext_attributes in Te.mk ~loc ~attrs (map_loc sub ptyext_path) (List.map (sub.extension_constructor sub) ptyext_constructors) ~params:(List.map (map_fst (sub.typ sub)) ptyext_params) ~priv:ptyext_private let map_type_exception sub {ptyexn_constructor; ptyexn_loc; ptyexn_attributes} = let loc = sub.location sub ptyexn_loc in let attrs = sub.attributes sub ptyexn_attributes in Te.mk_exception ~loc ~attrs (sub.extension_constructor sub ptyexn_constructor) let map_extension_constructor_kind sub = function Pext_decl(ctl, cto) -> Pext_decl(map_constructor_arguments sub ctl, map_opt (sub.typ sub) cto) | Pext_rebind li -> Pext_rebind (map_loc sub li) let map_extension_constructor sub {pext_name; pext_kind; pext_loc; pext_attributes} = let loc = sub.location sub pext_loc in let attrs = sub.attributes sub pext_attributes in Te.constructor ~loc ~attrs (map_loc sub pext_name) (map_extension_constructor_kind sub pext_kind) end module CT = struct (* Type expressions for the class language *) let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x) | Pcty_arrow (lab, t, ct) -> arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct) | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcty_open (o, ct) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_type sub ct) let map_field sub {pctf_desc = desc; pctf_loc = loc; pctf_attributes = attrs} = let open Ctf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t) | Pctf_method (s, p, v, t) -> method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t) | Pctf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pctf_attribute x -> attribute ~loc (sub.attribute sub x) | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_signature sub {pcsig_self; pcsig_fields} = Csig.mk (sub.typ sub pcsig_self) (List.map (sub.class_type_field sub) pcsig_fields) end let map_functor_param sub = function | Unit -> Unit | Named (s, mt) -> Named (map_loc sub s, sub.module_type sub mt) module MT = struct (* Type expressions for the module language *) let map sub {pmty_desc = desc; pmty_loc = loc; pmty_attributes = attrs} = let open Mty in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmty_ident s -> ident ~loc ~attrs (map_loc sub s) | Pmty_alias s -> alias ~loc ~attrs (map_loc sub s) | Pmty_signature sg -> signature ~loc ~attrs (sub.signature sub sg) | Pmty_functor (param, mt) -> functor_ ~loc ~attrs (map_functor_param sub param) (sub.module_type sub mt) | Pmty_with (mt, l) -> with_ ~loc ~attrs (sub.module_type sub mt) (List.map (sub.with_constraint sub) l) | Pmty_typeof me -> typeof_ ~loc ~attrs (sub.module_expr sub me) | Pmty_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_with_constraint sub = function | Pwith_type (lid, d) -> Pwith_type (map_loc sub lid, sub.type_declaration sub d) | Pwith_module (lid, lid2) -> Pwith_module (map_loc sub lid, map_loc sub lid2) | Pwith_typesubst (lid, d) -> Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d) | Pwith_modsubst (s, lid) -> Pwith_modsubst (map_loc sub s, map_loc sub lid) let map_signature_item sub {psig_desc = desc; psig_loc = loc} = let open Sig in let loc = sub.location sub loc in match desc with | Psig_value vd -> value ~loc (sub.value_description sub vd) | Psig_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Psig_typesubst l -> type_subst ~loc (List.map (sub.type_declaration sub) l) | Psig_typext te -> type_extension ~loc (sub.type_extension sub te) | Psig_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Psig_module x -> module_ ~loc (sub.module_declaration sub x) | Psig_modsubst x -> mod_subst ~loc (sub.module_substitution sub x) | Psig_recmodule l -> rec_module ~loc (List.map (sub.module_declaration sub) l) | Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Psig_open x -> open_ ~loc (sub.open_description sub x) | Psig_include x -> include_ ~loc (sub.include_description sub x) | Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l) | Psig_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Psig_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Psig_attribute x -> attribute ~loc (sub.attribute sub x) end module M = struct (* Value expressions for the module language *) let map sub {pmod_loc = loc; pmod_desc = desc; pmod_attributes = attrs} = let open Mod in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pmod_ident x -> ident ~loc ~attrs (map_loc sub x) | Pmod_structure str -> structure ~loc ~attrs (sub.structure sub str) | Pmod_functor (param, body) -> functor_ ~loc ~attrs (map_functor_param sub param) (sub.module_expr sub body) | Pmod_apply (m1, m2) -> apply ~loc ~attrs (sub.module_expr sub m1) (sub.module_expr sub m2) | Pmod_constraint (m, mty) -> constraint_ ~loc ~attrs (sub.module_expr sub m) (sub.module_type sub mty) | Pmod_unpack e -> unpack ~loc ~attrs (sub.expr sub e) | Pmod_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure_item sub {pstr_loc = loc; pstr_desc = desc} = let open Str in let loc = sub.location sub loc in match desc with | Pstr_eval (x, attrs) -> let attrs = sub.attributes sub attrs in eval ~loc ~attrs (sub.expr sub x) | Pstr_value (r, vbs) -> value ~loc r (List.map (sub.value_binding sub) vbs) | Pstr_primitive vd -> primitive ~loc (sub.value_description sub vd) | Pstr_type (rf, l) -> type_ ~loc rf (List.map (sub.type_declaration sub) l) | Pstr_typext te -> type_extension ~loc (sub.type_extension sub te) | Pstr_exception ed -> exception_ ~loc (sub.type_exception sub ed) | Pstr_module x -> module_ ~loc (sub.module_binding sub x) | Pstr_recmodule l -> rec_module ~loc (List.map (sub.module_binding sub) l) | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x) | Pstr_open x -> open_ ~loc (sub.open_declaration sub x) | Pstr_class l -> class_ ~loc (List.map (sub.class_declaration sub) l) | Pstr_class_type l -> class_type ~loc (List.map (sub.class_type_declaration sub) l) | Pstr_include x -> include_ ~loc (sub.include_declaration sub x) | Pstr_extension (x, attrs) -> let attrs = sub.attributes sub attrs in extension ~loc ~attrs (sub.extension sub x) | Pstr_attribute x -> attribute ~loc (sub.attribute sub x) end module E = struct (* Value expressions for the core language *) let map sub {pexp_loc = loc; pexp_desc = desc; pexp_attributes = attrs} = let open Exp in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_function pel -> function_ ~loc ~attrs (sub.cases sub pel) | Pexp_apply (e, l) -> apply ~loc ~attrs (sub.expr sub e) (List.map (map_snd (sub.expr sub)) l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_tuple el -> tuple ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_construct (lid, arg) -> construct ~loc ~attrs (map_loc sub lid) (map_opt (sub.expr sub) arg) | Pexp_variant (lab, eo) -> variant ~loc ~attrs lab (map_opt (sub.expr sub) eo) | Pexp_record (l, eo) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) l) (map_opt (sub.expr sub) eo) | Pexp_field (e, lid) -> field ~loc ~attrs (sub.expr sub e) (map_loc sub lid) | Pexp_setfield (e1, lid, e2) -> setfield ~loc ~attrs (sub.expr sub e1) (map_loc sub lid) (sub.expr sub e2) | Pexp_array el -> array ~loc ~attrs (List.map (sub.expr sub) el) | Pexp_ifthenelse (e1, e2, e3) -> ifthenelse ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) (map_opt (sub.expr sub) e3) | Pexp_sequence (e1, e2) -> sequence ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_while (e1, e2) -> while_ ~loc ~attrs (sub.expr sub e1) (sub.expr sub e2) | Pexp_for (p, e1, e2, d, e3) -> for_ ~loc ~attrs (sub.pat sub p) (sub.expr sub e1) (sub.expr sub e2) d (sub.expr sub e3) | Pexp_coerce (e, t1, t2) -> coerce ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t1) (sub.typ sub t2) | Pexp_constraint (e, t) -> constraint_ ~loc ~attrs (sub.expr sub e) (sub.typ sub t) | Pexp_send (e, s) -> send ~loc ~attrs (sub.expr sub e) (map_loc sub s) | Pexp_new lid -> new_ ~loc ~attrs (map_loc sub lid) | Pexp_setinstvar (s, e) -> setinstvar ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_override sel -> override ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.expr sub)) sel) | Pexp_letmodule (s, me, e) -> letmodule ~loc ~attrs (map_loc sub s) (sub.module_expr sub me) (sub.expr sub e) | Pexp_letexception (cd, e) -> letexception ~loc ~attrs (sub.extension_constructor sub cd) (sub.expr sub e) | Pexp_assert e -> assert_ ~loc ~attrs (sub.expr sub e) | Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e) | Pexp_poly (e, t) -> poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t) | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls) | Pexp_newtype (s, e) -> newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e) | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me) | Pexp_open (o, e) -> open_ ~loc ~attrs (sub.open_declaration sub o) (sub.expr sub e) | Pexp_letop {let_; ands; body} -> letop ~loc ~attrs (sub.binding_op sub let_) (List.map (sub.binding_op sub) ands) (sub.expr sub body) | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pexp_unreachable -> unreachable ~loc ~attrs () let map_binding_op sub {pbop_op; pbop_pat; pbop_exp; pbop_loc} = let open Exp in let op = map_loc sub pbop_op in let pat = sub.pat sub pbop_pat in let exp = sub.expr sub pbop_exp in let loc = sub.location sub pbop_loc in binding_op op pat exp loc end module P = struct (* Patterns *) let map sub {ppat_desc = desc; ppat_loc = loc; ppat_attributes = attrs} = let open Pat in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Ppat_any -> any ~loc ~attrs () | Ppat_var s -> var ~loc ~attrs (map_loc sub s) | Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s) | Ppat_constant c -> constant ~loc ~attrs c | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2 | Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_construct (l, p) -> construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p) | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p) | Ppat_record (lpl, cf) -> record ~loc ~attrs (List.map (map_tuple (map_loc sub) (sub.pat sub)) lpl) cf | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl) | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2) | Ppat_constraint (p, t) -> constraint_ ~loc ~attrs (sub.pat sub p) (sub.typ sub t) | Ppat_type s -> type_ ~loc ~attrs (map_loc sub s) | Ppat_lazy p -> lazy_ ~loc ~attrs (sub.pat sub p) | Ppat_unpack s -> unpack ~loc ~attrs (map_loc sub s) | Ppat_open (lid,p) -> open_ ~loc ~attrs (map_loc sub lid) (sub.pat sub p) | Ppat_exception p -> exception_ ~loc ~attrs (sub.pat sub p) | Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x) end module CE = struct (* Value expressions for the class language *) let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s) | Pcl_fun (lab, e, p, ce) -> fun_ ~loc ~attrs lab (map_opt (sub.expr sub) e) (sub.pat sub p) (sub.class_expr sub ce) | Pcl_apply (ce, l) -> apply ~loc ~attrs (sub.class_expr sub ce) (List.map (map_snd (sub.expr sub)) l) | Pcl_let (r, vbs, ce) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.class_expr sub ce) | Pcl_constraint (ce, ct) -> constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct) | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x) | Pcl_open (o, ce) -> open_ ~loc ~attrs (sub.open_description sub o) (sub.class_expr sub ce) let map_kind sub = function | Cfk_concrete (o, e) -> Cfk_concrete (o, sub.expr sub e) | Cfk_virtual t -> Cfk_virtual (sub.typ sub t) let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) (map_opt (map_loc sub) s) | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) | Pcf_method (s, p, k) -> method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k) | Pcf_constraint (t1, t2) -> constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2) | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e) | Pcf_attribute x -> attribute ~loc (sub.attribute sub x) | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x) let map_structure sub {pcstr_self; pcstr_fields} = { pcstr_self = sub.pat sub pcstr_self; pcstr_fields = List.map (sub.class_field sub) pcstr_fields; } let class_infos sub f {pci_virt; pci_params = pl; pci_name; pci_expr; pci_loc; pci_attributes} = let loc = sub.location sub pci_loc in let attrs = sub.attributes sub pci_attributes in Ci.mk ~loc ~attrs ~virt:pci_virt ~params:(List.map (map_fst (sub.typ sub)) pl) (map_loc sub pci_name) (f pci_expr) end (* Now, a generic AST mapper, to be extended to cover all kinds and cases of the OCaml grammar. The default behavior of the mapper is the identity. *) let default_mapper = { structure = (fun this l -> List.map (this.structure_item this) l); structure_item = M.map_structure_item; module_expr = M.map; signature = (fun this l -> List.map (this.signature_item this) l); signature_item = MT.map_signature_item; module_type = MT.map; with_constraint = MT.map_with_constraint; class_declaration = (fun this -> CE.class_infos this (this.class_expr this)); class_expr = CE.map; class_field = CE.map_field; class_structure = CE.map_structure; class_type = CT.map; class_type_field = CT.map_field; class_signature = CT.map_signature; class_type_declaration = (fun this -> CE.class_infos this (this.class_type this)); class_description = (fun this -> CE.class_infos this (this.class_type this)); type_declaration = T.map_type_declaration; type_kind = T.map_type_kind; typ = T.map; type_extension = T.map_type_extension; type_exception = T.map_type_exception; extension_constructor = T.map_extension_constructor; value_description = (fun this {pval_name; pval_type; pval_prim; pval_loc; pval_attributes} -> Val.mk (map_loc this pval_name) (this.typ this pval_type) ~attrs:(this.attributes this pval_attributes) ~loc:(this.location this pval_loc) ~prim:pval_prim ); pat = P.map; expr = E.map; binding_op = E.map_binding_op; module_declaration = (fun this {pmd_name; pmd_type; pmd_attributes; pmd_loc} -> Md.mk (map_loc this pmd_name) (this.module_type this pmd_type) ~attrs:(this.attributes this pmd_attributes) ~loc:(this.location this pmd_loc) ); module_substitution = (fun this {pms_name; pms_manifest; pms_attributes; pms_loc} -> Ms.mk (map_loc this pms_name) (map_loc this pms_manifest) ~attrs:(this.attributes this pms_attributes) ~loc:(this.location this pms_loc) ); module_type_declaration = (fun this {pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} -> Mtd.mk (map_loc this pmtd_name) ?typ:(map_opt (this.module_type this) pmtd_type) ~attrs:(this.attributes this pmtd_attributes) ~loc:(this.location this pmtd_loc) ); module_binding = (fun this {pmb_name; pmb_expr; pmb_attributes; pmb_loc} -> Mb.mk (map_loc this pmb_name) (this.module_expr this pmb_expr) ~attrs:(this.attributes this pmb_attributes) ~loc:(this.location this pmb_loc) ); open_declaration = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (this.module_expr this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); open_description = (fun this {popen_expr; popen_override; popen_attributes; popen_loc} -> Opn.mk (map_loc this popen_expr) ~override:popen_override ~loc:(this.location this popen_loc) ~attrs:(this.attributes this popen_attributes) ); include_description = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_type this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); include_declaration = (fun this {pincl_mod; pincl_attributes; pincl_loc} -> Incl.mk (this.module_expr this pincl_mod) ~loc:(this.location this pincl_loc) ~attrs:(this.attributes this pincl_attributes) ); value_binding = (fun this {pvb_pat; pvb_expr; pvb_attributes; pvb_loc} -> Vb.mk (this.pat this pvb_pat) (this.expr this pvb_expr) ~loc:(this.location this pvb_loc) ~attrs:(this.attributes this pvb_attributes) ); constructor_declaration = (fun this {pcd_name; pcd_args; pcd_res; pcd_loc; pcd_attributes} -> Type.constructor (map_loc this pcd_name) ~args:(T.map_constructor_arguments this pcd_args) ?res:(map_opt (this.typ this) pcd_res) ~loc:(this.location this pcd_loc) ~attrs:(this.attributes this pcd_attributes) ); label_declaration = (fun this {pld_name; pld_type; pld_loc; pld_mutable; pld_attributes} -> Type.field (map_loc this pld_name) (this.typ this pld_type) ~mut:pld_mutable ~loc:(this.location this pld_loc) ~attrs:(this.attributes this pld_attributes) ); cases = (fun this l -> List.map (this.case this) l); case = (fun this {pc_lhs; pc_guard; pc_rhs} -> { pc_lhs = this.pat this pc_lhs; pc_guard = map_opt (this.expr this) pc_guard; pc_rhs = this.expr this pc_rhs; } ); location = (fun _this l -> l); extension = (fun this (s, e) -> (map_loc this s, this.payload this e)); attribute = (fun this a -> { attr_name = map_loc this a.attr_name; attr_payload = this.payload this a.attr_payload; attr_loc = this.location this a.attr_loc } ); attributes = (fun this l -> List.map (this.attribute this) l); payload = (fun this -> function | PStr x -> PStr (this.structure this x) | PSig x -> PSig (this.signature this x) | PTyp x -> PTyp (this.typ this x) | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g) ); } let extension_of_error (error : Locations.location_error) : extension = Locations.extension_of_error ~mk_pstr:(fun x -> PStr x) ~mk_extension:(fun x -> Str.extension x) ~mk_string_constant:(fun x -> Str.eval (Exp.constant (Pconst_string (x, None)))) error let attribute_of_warning loc s = Attr.mk {loc; txt = "ocaml.ppwarning" } (PStr ([Str.eval ~loc (Exp.constant (Pconst_string (s, None)))])) include Locations.Helpers_impl let cookies = ref String.Map.empty let get_cookie k = try Some (String.Map.find k !cookies) with Not_found -> None let set_cookie k v = cookies := String.Map.add k v !cookies let tool_name_ref = ref "_none_" let tool_name () = !tool_name_ref module PpxContext = struct open Longident open Asttypes open Ast_helper let lid name = { txt = Lident name; loc = Location.none } let make_string x = Exp.constant (Pconst_string (x, None)) let make_bool x = if x then Exp.construct (lid "true") None else Exp.construct (lid "false") None let rec make_list f lst = match lst with | x :: rest -> Exp.construct (lid "::") (Some (Exp.tuple [f x; make_list f rest])) | [] -> Exp.construct (lid "[]") None let make_pair f1 f2 (x1, x2) = Exp.tuple [f1 x1; f2 x2] let make_option f opt = match opt with | Some x -> Exp.construct (lid "Some") (Some (f x)) | None -> Exp.construct (lid "None") None let get_cookies () = lid "cookies", make_list (make_pair make_string (fun x -> x)) (String.Map.bindings !cookies) let mk fields = { attr_name = { txt = "ocaml.ppx.context"; loc = Location.none }; attr_payload = Parsetree.PStr [Str.eval (Exp.record fields None)]; attr_loc = Location.none } let make ~tool_name () = let fields = [ lid "tool_name", make_string tool_name; lid "include_dirs", make_list make_string !Clflags.include_dirs; lid "load_path", make_list make_string (Migrate_parsetree_compiler_functions.get_load_paths ()); lid "open_modules", make_list make_string !Clflags.open_modules; lid "for_package", make_option make_string !Clflags.for_package; lid "debug", make_bool !Clflags.debug; lid "use_threads", make_bool !Clflags.use_threads; lid "use_vmthreads", make_bool false; lid "recursive_types", make_bool !Clflags.recursive_types; lid "principal", make_bool !Clflags.principal; lid "transparent_modules", make_bool !Clflags.transparent_modules; lid "unboxed_types", make_bool (Migrate_parsetree_compiler_functions.get_unboxed_types ()); lid "unsafe_string", make_bool !Clflags.unsafe_string; get_cookies () ] in mk fields let get_fields = function | PStr [{pstr_desc = Pstr_eval ({ pexp_desc = Pexp_record (fields, None) }, [])}] -> fields | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context] syntax" let restore fields = let field name payload = let rec get_string = function | { pexp_desc = Pexp_constant (Pconst_string (str, None)) } -> str | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] string syntax" name and get_bool pexp = match pexp with | {pexp_desc = Pexp_construct ({txt = Longident.Lident "true"}, None)} -> true | {pexp_desc = Pexp_construct ({txt = Longident.Lident "false"}, None)} -> false | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] bool syntax" name and get_list elem = function | {pexp_desc = Pexp_construct ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [exp; rest]}) } -> elem exp :: get_list elem rest | {pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)} -> [] | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] list syntax" name and get_pair f1 f2 = function | {pexp_desc = Pexp_tuple [e1; e2]} -> (f1 e1, f2 e2) | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] pair syntax" name and get_option elem = function | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "Some" }, Some exp) } -> Some (elem exp) | { pexp_desc = Pexp_construct ({ txt = Longident.Lident "None" }, None) } -> None | _ -> raise_errorf "Internal error: invalid [@@@ocaml.ppx.context \ { %s }] option syntax" name in match name with | "tool_name" -> tool_name_ref := get_string payload | "include_dirs" -> Clflags.include_dirs := get_list get_string payload | "load_path" -> Migrate_parsetree_compiler_functions.load_path_init (get_list get_string payload) | "open_modules" -> Clflags.open_modules := get_list get_string payload | "for_package" -> Clflags.for_package := get_option get_string payload | "debug" -> Clflags.debug := get_bool payload | "use_threads" -> Clflags.use_threads := get_bool payload | "use_vmthreads" -> if get_bool payload then raise_errorf "Internal error: vmthreads not supported after 4.09.0" | "recursive_types" -> Clflags.recursive_types := get_bool payload | "principal" -> Clflags.principal := get_bool payload | "transparent_modules" -> Clflags.transparent_modules := get_bool payload | "unboxed_types" -> Migrate_parsetree_compiler_functions.set_unboxed_types (get_bool payload) | "unsafe_string" -> Clflags.unsafe_string := get_bool payload | "cookies" -> let l = get_list (get_pair get_string (fun x -> x)) payload in cookies := List.fold_left (fun s (k, v) -> String.Map.add k v s) String.Map.empty l | _ -> () in List.iter (function ({txt=Lident name}, x) -> field name x | _ -> ()) fields let update_cookies fields = let fields = List.filter (function ({txt=Lident "cookies"}, _) -> false | _ -> true) fields in fields @ [get_cookies ()] end let ppx_context = PpxContext.make let extension_of_exn exn = extension_of_error (Locations.location_error_of_exn exn) let apply_lazy ~source ~target mapper = let implem ast = let fields, ast = match ast with | {pstr_desc = Pstr_attribute ({attr_name = {txt = "ocaml.ppx.context"}; attr_payload = x})} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.structure mapper ast with exn -> [{pstr_desc = Pstr_extension (extension_of_exn exn, []); pstr_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Str.attribute (PpxContext.mk fields) :: ast in let iface ast = let fields, ast = match ast with | {psig_desc = Psig_attribute ({attr_name = {txt = "ocaml.ppx.context"}; attr_payload = x; attr_loc = _})} :: l -> PpxContext.get_fields x, l | _ -> [], ast in PpxContext.restore fields; let ast = try let mapper = mapper () in mapper.signature mapper ast with exn -> [{psig_desc = Psig_extension (extension_of_exn exn, []); psig_loc = Location.none}] in let fields = PpxContext.update_cookies fields in Sig.attribute (PpxContext.mk fields) :: ast in let ic = open_in_bin source in let magic = really_input_string ic (String.length Config.ast_impl_magic_number) in let rewrite transform = Location.input_name := input_value ic; let ast = input_value ic in close_in ic; let ast = transform ast in let oc = open_out_bin target in output_string oc magic; output_value oc !Location.input_name; output_value oc ast; close_out oc and fail () = close_in ic; failwith "Ast_mapper: OCaml version mismatch or malformed input"; in if magic = Config.ast_impl_magic_number then rewrite (implem : structure -> structure) else if magic = Config.ast_intf_magic_number then rewrite (iface : signature -> signature) else fail () let drop_ppx_context_str ~restore = function | {pstr_desc = Pstr_attribute {attr_name = {Location.txt = "ocaml.ppx.context"}; attr_payload = a; attr_loc = _}} :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let drop_ppx_context_sig ~restore = function | {psig_desc = Psig_attribute {attr_name = {Location.txt = "ocaml.ppx.context"}; attr_payload = a; attr_loc = _}} :: items -> if restore then PpxContext.restore (PpxContext.get_fields a); items | items -> items let add_ppx_context_str ~tool_name ast = Ast_helper.Str.attribute (ppx_context ~tool_name ()) :: ast let add_ppx_context_sig ~tool_name ast = Ast_helper.Sig.attribute (ppx_context ~tool_name ()) :: ast let apply ~source ~target mapper = apply_lazy ~source ~target (fun () -> mapper) let run_main mapper = try let a = Sys.argv in let n = Array.length a in if n > 2 then let mapper () = try mapper (Array.to_list (Array.sub a 1 (n - 3))) with exn -> (* PR#6463 *) let f _ _ = raise exn in {default_mapper with structure = f; signature = f} in apply_lazy ~source:a.(n - 2) ~target:a.(n - 1) mapper else begin Printf.eprintf "Usage: %s [extra_args] \n%!" Sys.executable_name; exit 2 end with exn -> prerr_endline (Printexc.to_string exn); exit 2 let register_function = ref (fun _name f -> run_main f) let register name f = !register_function name f end module Type_immediacy = struct type t (*IF_CURRENT = Type_immediacy.t *) = | Unknown | Always | Always_on_64bits end module Outcometree = struct (* Module [Outcometree]: results displayed by the toplevel *) (* These types represent messages that the toplevel displays as normal results or errors. The real displaying is customisable using the hooks: [Toploop.print_out_value] [Toploop.print_out_type] [Toploop.print_out_sig_item] [Toploop.print_out_phrase] *) (** An [out_name] is a string representation of an identifier which can be rewritten on the fly to avoid name collisions *) type out_name (*IF_CURRENT = Outcometree.out_name *) = { mutable printed_name: string } type out_ident (*IF_CURRENT = Outcometree.out_ident *) = | Oide_apply of out_ident * out_ident | Oide_dot of out_ident * string | Oide_ident of out_name type out_string (*IF_CURRENT = Outcometree.out_string *) = | Ostr_string | Ostr_bytes type out_attribute (*IF_CURRENT = Outcometree.out_attribute *) = { oattr_name: string } type out_value (*IF_CURRENT = Outcometree.out_value *) = | Oval_array of out_value list | Oval_char of char | Oval_constr of out_ident * out_value list | Oval_ellipsis | Oval_float of float | Oval_int of int | Oval_int32 of int32 | Oval_int64 of int64 | Oval_nativeint of nativeint | Oval_list of out_value list | Oval_printer of (Format.formatter -> unit) | Oval_record of (out_ident * out_value) list | Oval_string of string * int * out_string (* string, size-to-print, kind *) | Oval_stuff of string | Oval_tuple of out_value list | Oval_variant of string * out_value option type out_type (*IF_CURRENT = Outcometree.out_type *) = | Otyp_abstract | Otyp_open | Otyp_alias of out_type * string | Otyp_arrow of string * out_type * out_type | Otyp_class of bool * out_ident * out_type list | Otyp_constr of out_ident * out_type list | Otyp_manifest of out_type * out_type | Otyp_object of (string * out_type) list * bool option | Otyp_record of (string * bool * out_type) list | Otyp_stuff of string | Otyp_sum of (string * out_type list * out_type option) list | Otyp_tuple of out_type list | Otyp_var of bool * string | Otyp_variant of bool * out_variant * bool * (string list) option | Otyp_poly of string list * out_type | Otyp_module of out_ident * string list * out_type list | Otyp_attribute of out_type * out_attribute and out_variant (*IF_CURRENT = Outcometree.out_variant *) = | Ovar_fields of (string * bool * out_type list) list | Ovar_typ of out_type type out_class_type (*IF_CURRENT = Outcometree.out_class_type *) = | Octy_constr of out_ident * out_type list | Octy_arrow of string * out_type * out_class_type | Octy_signature of out_type option * out_class_sig_item list and out_class_sig_item (*IF_CURRENT = Outcometree.out_class_sig_item *) = | Ocsg_constraint of out_type * out_type | Ocsg_method of string * bool * bool * out_type | Ocsg_value of string * bool * bool * out_type type out_module_type (*IF_CURRENT = Outcometree.out_module_type *) = | Omty_abstract | Omty_functor of (string option * out_module_type) option * out_module_type | Omty_ident of out_ident | Omty_signature of out_sig_item list | Omty_alias of out_ident and out_sig_item (*IF_CURRENT = Outcometree.out_sig_item *) = | Osig_class of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_class_type of bool * string * (string * (bool * bool)) list * out_class_type * out_rec_status | Osig_typext of out_extension_constructor * out_ext_status | Osig_modtype of string * out_module_type | Osig_module of string * out_module_type * out_rec_status | Osig_type of out_type_decl * out_rec_status | Osig_value of out_val_decl | Osig_ellipsis and out_type_decl (*IF_CURRENT = Outcometree.out_type_decl *) = { otype_name: string; otype_params: (string * (bool * bool)) list; otype_type: out_type; otype_private: Asttypes.private_flag; otype_immediate: Type_immediacy.t; otype_unboxed: bool; otype_cstrs: (out_type * out_type) list } and out_extension_constructor (*IF_CURRENT = Outcometree.out_extension_constructor *) = { oext_name: string; oext_type_name: string; oext_type_params: string list; oext_args: out_type list; oext_ret_type: out_type option; oext_private: Asttypes.private_flag } and out_type_extension (*IF_CURRENT = Outcometree.out_type_extension *) = { otyext_name: string; otyext_params: string list; otyext_constructors: (string * out_type list * out_type option) list; otyext_private: Asttypes.private_flag } and out_val_decl (*IF_CURRENT = Outcometree.out_val_decl *) = { oval_name: string; oval_type: out_type; oval_prims: string list; oval_attributes: out_attribute list } and out_rec_status (*IF_CURRENT = Outcometree.out_rec_status *) = | Orec_not | Orec_first | Orec_next and out_ext_status (*IF_CURRENT = Outcometree.out_ext_status *) = | Oext_first | Oext_next | Oext_exception type out_phrase (*IF_CURRENT = Outcometree.out_phrase *) = | Ophr_eval of out_value * out_type | Ophr_signature of (out_sig_item * out_value option) list | Ophr_exception of (exn * out_value) end module Config = struct let ast_impl_magic_number = "Caml1999M027" let ast_intf_magic_number = "Caml1999N027" end let map_signature mapper = mapper.Ast_mapper.signature mapper let map_structure mapper = mapper.Ast_mapper.structure mapper let shallow_identity = let id _ x = x in { Ast_mapper. structure = id; structure_item = id; module_expr = id; signature = id; signature_item = id; module_type = id; with_constraint = id; class_declaration = id; class_expr = id; class_field = id; class_structure = id; class_type = id; class_type_field = id; class_signature = id; class_type_declaration = id; class_description = id; type_declaration = id; type_kind = id; typ = id; type_extension = id; extension_constructor = id; value_description = id; pat = id; expr = id; module_declaration = id; module_type_declaration = id; module_binding = id; open_description = id; include_description = id; include_declaration = id; value_binding = id; constructor_declaration = id; label_declaration = id; cases = id; case = id; location = id; extension = id; attribute = id; attributes = id; payload = id; binding_op = id; module_substitution = id; open_declaration = id; type_exception = id; } let failing_mapper = let fail _ _ = invalid_arg "failing_mapper: this mapper function should never get called" in { Ast_mapper. structure = fail; structure_item = fail; module_expr = fail; signature = fail; signature_item = fail; module_type = fail; with_constraint = fail; class_declaration = fail; class_expr = fail; class_field = fail; class_structure = fail; class_type = fail; class_type_field = fail; class_signature = fail; class_type_declaration = fail; class_description = fail; type_declaration = fail; type_kind = fail; typ = fail; type_extension = fail; extension_constructor = fail; value_description = fail; pat = fail; expr = fail; module_declaration = fail; module_type_declaration = fail; module_binding = fail; open_description = fail; include_description = fail; include_declaration = fail; value_binding = fail; constructor_declaration = fail; label_declaration = fail; cases = fail; case = fail; location = fail; extension = fail; attribute = fail; attributes = fail; payload = fail; binding_op = fail; module_substitution = fail; open_declaration = fail; type_exception = fail; } let make_top_mapper ~signature ~structure = {failing_mapper with Ast_mapper. signature = (fun _ x -> signature x); structure = (fun _ x -> structure x) } ocaml-migrate-parsetree-1.5.0/src/cinaps_helpers000066400000000000000000000024771356450464700217670ustar00rootroot00000000000000(* -*- tuareg -*- *) open StdLabels open Printf let nl () = printf "\n" let supported_versions = [ ("402", "4.02"); ("403", "4.03"); ("404", "4.04"); ("405", "4.05"); ("406", "4.06"); ("407", "4.07"); ("408", "4.08"); ("409", "4.09"); ("410", "4.10"); ] let qualified_types = [ "Parsetree", [ "structure" ; "signature" ; "toplevel_phrase" ; "core_type" ; "expression" ; "pattern" ; "case" ; "type_declaration" ; "type_extension" ; "extension_constructor" ]; "Outcometree", [ "out_value" ; "out_type" ; "out_class_type" ; "out_module_type" ; "out_sig_item" ; "out_type_extension" ; "out_phrase" ]; "Ast_mapper", [ "mapper" ]; ] let all_types = List.concat (List.map ~f:snd qualified_types) let foreach_module f = nl (); List.iter qualified_types ~f:(fun (m, types) -> f m types) let foreach_type f = foreach_module (fun m -> List.iter ~f:(f m)) let foreach_version f = nl (); List.iter supported_versions ~f:(fun (suffix, version) -> f suffix version) let foreach_version_pair f = nl (); let rec aux = function | (x,_) :: ((y,_) :: _ as tail) -> f x y; aux tail | [_] | [] -> () in aux supported_versions let with_then_and () = let first = ref true in fun oc -> output_string oc (if !first then "with" else "and"); first := false ocaml-migrate-parsetree-1.5.0/src/compiler-functions/000077500000000000000000000000001356450464700226535ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/src/compiler-functions/ge_406_and_lt_408.ml000066400000000000000000000005701356450464700261070ustar00rootroot00000000000000let error_of_exn exn = match Location.error_of_exn exn with | Some (`Ok exn) -> Some exn | Some `Already_displayed -> None | None -> None let get_load_paths () = !Config.load_path let load_path_init l = Config.load_path := l let get_unboxed_types () = !Clflags.unboxed_types let set_unboxed_types b = Clflags.unboxed_types := b let may_map = Misc.may_map ocaml-migrate-parsetree-1.5.0/src/compiler-functions/ge_408_and_lt_410.ml000066400000000000000000000005701356450464700261020ustar00rootroot00000000000000let error_of_exn exn = match Location.error_of_exn exn with | Some (`Ok exn) -> Some exn | Some `Already_displayed -> None | None -> None let get_load_paths () = Load_path.get_paths () let load_path_init l = Load_path.init l let get_unboxed_types () = !Clflags.unboxed_types let set_unboxed_types b = Clflags.unboxed_types := b let may_map = Misc.may_map ocaml-migrate-parsetree-1.5.0/src/compiler-functions/ge_410.ml000066400000000000000000000005661356450464700241730ustar00rootroot00000000000000let error_of_exn exn = match Location.error_of_exn exn with | Some (`Ok exn) -> Some exn | Some `Already_displayed -> None | None -> None let get_load_paths () = Load_path.get_paths () let load_path_init l = Load_path.init l let get_unboxed_types () = !Clflags.unboxed_types let set_unboxed_types b = Clflags.unboxed_types := b let may_map = Option.map ocaml-migrate-parsetree-1.5.0/src/compiler-functions/lt_406.ml000066400000000000000000000003471356450464700242210ustar00rootroot00000000000000let error_of_exn = Location.error_of_exn let get_load_paths () = !Config.load_path let load_path_init l = Config.load_path := l let get_unboxed_types () = false let set_unboxed_types _b = () let may_map = Misc.may_map ocaml-migrate-parsetree-1.5.0/src/config/000077500000000000000000000000001356450464700203005ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/src/config/gen.ml000066400000000000000000000015231356450464700214040ustar00rootroot00000000000000let write fn s = let oc = open_out fn in output_string oc s; close_out oc let () = let ocaml_version_str = Sys.argv.(1) in let ocaml_version = Scanf.sscanf ocaml_version_str "%u.%u" (fun a b -> (a, b)) in write "ast-version" (match ocaml_version with | (4, 02) -> "402" | (4, 03) -> "403" | (4, 04) -> "404" | (4, 05) -> "405" | (4, 06) -> "406" | (4, 07) -> "407" | (4, 08) -> "408" | (4, 09) -> "409" | (4, 10) -> "410" | _ -> Printf.eprintf "Unkown OCaml version %s\n" ocaml_version_str; exit 1); write "compiler-functions-file" (if ocaml_version < (4, 06) then "lt_406.ml" else if ocaml_version < (4, 08) then "ge_406_and_lt_408.ml" else if ocaml_version < (4, 10) then "ge_408_and_lt_410.ml" else "ge_410.ml") ocaml-migrate-parsetree-1.5.0/src/dune000066400000000000000000000015751356450464700177210ustar00rootroot00000000000000(library (name migrate_parsetree) (public_name ocaml-migrate-parsetree) (wrapped (transition "Access modules via the Migrate_parsetree toplevel module")) (libraries compiler-libs.common result ppx_derivers) (modules :standard \ migrate_parsetree_driver_main) (preprocess (action (run %{exe:../tools/pp.exe} %{read:ast-version} %{input-file}))) (ppx.driver (main Migrate_parsetree.Driver.run_main) (flags --dump-ast) (lint_flags --null))) (library (name migrate_parsetree_driver_main) (public_name ocaml-migrate-parsetree.driver-main) (modules migrate_parsetree_driver_main) (library_flags -linkall) (libraries migrate_parsetree)) (rule (copy# compiler-functions/%{read:compiler-functions-file} migrate_parsetree_compiler_functions.ml)) (rule (targets ast-version compiler-functions-file) (action (run %{ocaml} %{dep:config/gen.ml} %{ocaml_version}))) ocaml-migrate-parsetree-1.5.0/src/locations.ml000066400000000000000000000124151356450464700213630ustar00rootroot00000000000000type old_location_error (*IF_NOT_AT_LEAST 408 = Location.error *) = { loc: Location.t; msg: string; sub: old_location_error list; if_highlight: string; } type location_msg = (Format.formatter -> unit) Location.loc type location_report_kind (*IF_AT_LEAST 408 = Location.report_kind *) = | Report_error | Report_warning of string | Report_warning_as_error of string | Report_alert of string | Report_alert_as_error of string type location_report (*IF_AT_LEAST 408 = Location.report *) = { kind : location_report_kind; main : location_msg; sub : location_msg list; } type location_error (*IF_AT_LEAST 408 = Location.error *) (*IF_NOT_AT_LEAST 408 = old_location_error *) type error_type = [`Report of location_report | `Old_error of old_location_error] let error_type_of_location_error : location_error -> error_type = fun x -> (*IF_AT_LEAST 408 `Report x *) (*IF_NOT_AT_LEAST 408 `Old_error x *) let location_error_of_exn : exn -> location_error = fun exn -> (*IF_AT_LEAST 408 match Location.error_of_exn exn with None | Some `Already_displayed -> raise exn | Some (`Ok e) -> e *) (*IF_NOT_AT_LEAST 408 match Migrate_parsetree_compiler_functions.error_of_exn exn with None -> raise exn | Some e -> e*) let extension_of_error ~mk_pstr ~mk_extension ~mk_string_constant (error : location_error) = match error_type_of_location_error error with | `Old_error old_error -> let rec extension_of_old_error ({loc; msg; if_highlight = _; sub} : old_location_error) = { Location.loc; txt = "ocaml.error" }, mk_pstr ((mk_string_constant msg) :: (List.map (fun ext -> mk_extension (extension_of_old_error ext)) sub)) in extension_of_old_error old_error | `Report report -> let extension_of_report ({kind; main; sub} : location_report) = if kind <> Report_error then raise (Invalid_argument "extension_of_error: expected kind Report_error"); let str_of_pp pp_msg = Format.asprintf "%t" pp_msg in let extension_of_sub (sub : location_msg) = { Location.loc = sub.loc; txt = "ocaml.error" }, mk_pstr ([mk_string_constant (str_of_pp sub.txt)]) in { Location.loc = main.loc; txt = "ocaml.error" }, mk_pstr (mk_string_constant (str_of_pp main.txt) :: List.map (fun msg -> mk_extension (extension_of_sub msg)) sub) in extension_of_report report let error_of_exn exn = try Some (location_error_of_exn exn) with _ -> None let register_error_of_exn f = Location.register_error_of_exn f let report_exception ppf exn = Location.report_exception ppf exn let errorf ~loc fmt = Location.errorf ~loc ~sub:[] fmt let raise_errorf ?(loc = Location.none) fmt = Location.raise_errorf ~loc ~sub:[] fmt let _get_error_message_old location_error = location_error.msg let _get_error_message_new location_error = let buff = Buffer.create 128 in let ppf = Format.formatter_of_buffer buff in location_error.main.txt ppf; Format.pp_print_flush ppf (); Buffer.contents buff let get_error_message location_error = (*IF_NOT_AT_LEAST 408 _get_error_message_old location_error*) (*IF_AT_LEAST 408 _get_error_message_new location_error*) let _set_error_message_old location_error msg = { location_error with msg; } let _set_error_message_new location_error msg = let txt ppf = Format.pp_print_string ppf msg in let main = { location_error.main with txt; } in { location_error with main } let set_error_message location_error msg = (*IF_NOT_AT_LEAST 408 _set_error_message_old location_error msg*) (*IF_AT_LEAST 408 _set_error_message_new location_error msg*) let make_error_of_message_old ~loc msg ~sub = let sub = List.map (fun (loc, msg) -> { loc; msg; sub = []; if_highlight = msg; }) sub in { loc; msg; sub; if_highlight = msg; } let make_error_of_message_new ~loc msg ~sub = let mk_txt x ppf = Format.pp_print_string ppf x in let mk loc x = { Location.loc; txt = mk_txt x; } in { kind = Report_error; main = mk loc msg; sub = List.map (fun (loc, msg) -> mk loc msg) sub; } let make_error_of_message ~loc msg ~sub = (*IF_NOT_AT_LEAST 408 make_error_of_message_old ~loc msg ~sub*) (*IF_AT_LEAST 408 make_error_of_message_new ~loc msg ~sub*) let print_error ppf err = (*IF_NOT_AT_LEAST 408 Location.report_error ppf err*) (*IF_AT_LEAST 408 Location.print_report ppf err*) module type Helpers_intf = sig type nonrec location_error = location_error val error_of_exn : exn -> location_error option val register_error_of_exn : (exn -> location_error option) -> unit val report_exception : Format.formatter -> exn -> unit val get_error_message : location_error -> string val set_error_message : location_error -> string -> location_error val make_error_of_message : loc:Location.t -> string -> sub:(Location.t * string) list -> location_error val print_error : Format.formatter -> location_error -> unit val raise_error : location_error -> 'a end module Helpers_impl = struct type nonrec location_error = location_error let error_of_exn = error_of_exn let register_error_of_exn = register_error_of_exn let report_exception = report_exception let get_error_message = get_error_message let set_error_message = set_error_message let make_error_of_message = make_error_of_message let print_error = print_error let raise_error err = raise (Location.Error err) end ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree.ml000066400000000000000000000104551356450464700230740ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino, Jane Street Europe *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (*$ #use "src/cinaps_helpers" $*) (* Shared definitions. Mostly errors about features missing in older versions. *) module Def = Migrate_parsetree_def (* Copy of OCaml parsetrees *) (*$foreach_version (fun suffix _ -> printf "module Ast_%s = Ast_%s\n" suffix suffix )*) module Ast_402 = Ast_402 module Ast_403 = Ast_403 module Ast_404 = Ast_404 module Ast_405 = Ast_405 module Ast_406 = Ast_406 module Ast_407 = Ast_407 module Ast_408 = Ast_408 module Ast_409 = Ast_409 module Ast_410 = Ast_410 (*$*) (* A module for marshalling/unmarshalling arbitrary versions of Asts *) module Ast_io = Migrate_parsetree_ast_io (* Manual migration between versions *) (*$foreach_version_pair (fun x y -> printf "module Migrate_%s_%s = Migrate_parsetree_%s_%s\n" x y x y; printf "module Migrate_%s_%s = Migrate_parsetree_%s_%s\n" y x y x; )*) module Migrate_402_403 = Migrate_parsetree_402_403 module Migrate_403_402 = Migrate_parsetree_403_402 module Migrate_403_404 = Migrate_parsetree_403_404 module Migrate_404_403 = Migrate_parsetree_404_403 module Migrate_404_405 = Migrate_parsetree_404_405 module Migrate_405_404 = Migrate_parsetree_405_404 module Migrate_405_406 = Migrate_parsetree_405_406 module Migrate_406_405 = Migrate_parsetree_406_405 module Migrate_406_407 = Migrate_parsetree_406_407 module Migrate_407_406 = Migrate_parsetree_407_406 module Migrate_407_408 = Migrate_parsetree_407_408 module Migrate_408_407 = Migrate_parsetree_408_407 module Migrate_408_409 = Migrate_parsetree_408_409 module Migrate_409_408 = Migrate_parsetree_409_408 module Migrate_409_410 = Migrate_parsetree_409_410 module Migrate_410_409 = Migrate_parsetree_410_409 (*$*) (* An abstraction of OCaml compiler versions *) module Versions = Migrate_parsetree_versions (* All versions are compatible with this signature *) module type OCaml_version = Versions.OCaml_version (*$foreach_version (fun suffix _ -> printf "module OCaml_%s = Versions.OCaml_%s\n" suffix suffix )*) module OCaml_402 = Versions.OCaml_402 module OCaml_403 = Versions.OCaml_403 module OCaml_404 = Versions.OCaml_404 module OCaml_405 = Versions.OCaml_405 module OCaml_406 = Versions.OCaml_406 module OCaml_407 = Versions.OCaml_407 module OCaml_408 = Versions.OCaml_408 module OCaml_409 = Versions.OCaml_409 module OCaml_410 = Versions.OCaml_410 (*$*) module OCaml_current = Versions.OCaml_current (* A Functor taking two OCaml versions and producing a module of functions migrating from one to the other. *) module Convert = Versions.Convert (* A [Parse] module that migrate ASTs to the desired version of an AST *) module Parse = Migrate_parsetree_parse (* Entrypoints for registering rewriters and making a ppx binary *) module Driver = Migrate_parsetree_driver (* Aliases for compiler-libs modules that might be shadowed *) module Compiler_libs = struct module Location = Location module Longident = Longident module type Asttypes = module type of struct include Asttypes end module rec Asttypes : Asttypes = Asttypes module type Parsetree = module type of struct include Parsetree end module rec Parsetree : Parsetree = Parsetree module Docstrings = Docstrings module Ast_helper = Ast_helper module Ast_mapper = Ast_mapper end ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_402_403.ml000066400000000000000000000157151356450464700240530ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_402_403_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; (*$*) payload } as mapper) -> let module R = Migrate_parsetree_403_402_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); (*$*) payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload Location.none x))) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_402_403_migrate.ml000066400000000000000000001634411356450464700255630ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_402 module To = Ast_403 let extract_predef_option label typ = let open From in let open Longident in match label, typ.Parsetree.ptyp_desc with | To.Asttypes.Optional _, From.Parsetree.Ptyp_constr ( {Location.txt = Ldot (Lident "*predef*", "option"); _}, [d]) -> d | _ -> typ let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), x1) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (x0, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> let label = copy_arg_label x0 in To.Parsetree.Ptyp_arrow (label, copy_core_type (extract_predef_option label x1), copy_core_type x2) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type x0 -> let recflag, types = type_declarations x0 in To.Parsetree.Pstr_type (recflag, types) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type x0 -> let recflag, types = type_declarations x0 in To.Parsetree.Psig_type (recflag, types) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> let label = copy_arg_label x0 in To.Parsetree.Pcty_arrow (label, copy_core_type (extract_predef_option label x1), copy_class_type x2) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl (To.Parsetree.Pcstr_tuple (List.map copy_core_type x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = To.Parsetree.Pcstr_tuple (List.map copy_core_type pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_arg_label : From.Asttypes.label -> To.Asttypes.arg_label = fun x -> if x <> "" then if x.[0] = '?' then To.Asttypes.Optional (String.sub x 1 (String.length x - 1)) else To.Asttypes.Labelled x else To.Asttypes.Nolabel and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Asttypes.constant -> To.Parsetree.constant = function | From.Asttypes.Const_int x0 -> To.Parsetree.Pconst_integer (string_of_int x0, None) | From.Asttypes.Const_char x0 -> To.Parsetree.Pconst_char x0 | From.Asttypes.Const_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Asttypes.Const_float x0 -> To.Parsetree.Pconst_float (x0, None) | From.Asttypes.Const_int32 x0 -> To.Parsetree.Pconst_integer (Int32.to_string x0, Some 'l') | From.Asttypes.Const_int64 x0 -> To.Parsetree.Pconst_integer (Int64.to_string x0, Some 'L') | From.Asttypes.Const_nativeint x0 -> To.Parsetree.Pconst_integer (Nativeint.to_string x0, Some 'n') and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } and type_declarations types = let is_nonrec (attr,_) = attr.To.Location.txt = "nonrec" in match List.map copy_type_declaration types with | (x :: xs) when List.exists is_nonrec x.To.Parsetree.ptype_attributes -> let ptype_attributes = List.filter (fun x -> not (is_nonrec x)) x.To.Parsetree.ptype_attributes in (To.Asttypes.Nonrecursive, {x with To.Parsetree.ptype_attributes} :: xs) | types -> (To.Asttypes.Recursive, types) let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value (x0,x1,x2) -> To.Outcometree.Osig_value { To.Outcometree. oval_name = x0; oval_type = copy_out_type x1; oval_prims = List.map (fun x -> x) x2; oval_attributes = [] } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_private_flag otype_private); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs); To.Outcometree.otype_immediate = false; } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_private_flag oext_private) } and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_name (x0,x1) -> To.Outcometree.Ovar_name ((copy_out_ident x0), (List.map copy_out_type x1)) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int x0 -> To.Parsetree.Pdir_int (string_of_int x0, None) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_403_402.ml000066400000000000000000000157151356450464700240530ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_403_402_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; (*$*) payload } as mapper) -> let module R = Migrate_parsetree_402_403_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); (*$*) payload = (fun _ x -> copy_payload Location.none (payload mapper (R.copy_payload x))) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_403_402_migrate.ml000066400000000000000000001671161356450464700255660ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Def = Migrate_parsetree_def module From = Ast_403 module To = Ast_402 let inject_predef_option label d = let open To in let open Parsetree in match label with | From.Asttypes.Optional _ -> let loc = {d.ptyp_loc with Location.loc_ghost = true} in let txt = Longident.Ldot (Longident.Lident "*predef*", "option") in let ident = {Location. txt; loc} in { ptyp_desc = Ptyp_constr(ident,[d]); ptyp_loc = loc; ptyp_attributes = []} | _ -> d let from_loc {From.Location. txt = _; loc} = loc let migration_error location feature = raise (Def.Migration_error (feature, location)) let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_loc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc loc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant loc x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), x1) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (x0, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> migration_error loc Def.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_loc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc loc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant loc x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant loc x0), (copy_constant loc x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), inject_predef_option x0 (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload (from_loc x0) x1)) and copy_payload loc : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig _x0 -> migration_error loc Def.PSig | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type (type_declarations x0 x1) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type (type_declarations x0 x1) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), inject_predef_option x0 (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload (from_loc x0) x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind (from_loc pext_name) pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind loc : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments loc x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments (from_loc pcd_name) pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments loc : From.Parsetree.constructor_arguments -> To.Parsetree.core_type list = function | From.Parsetree.Pcstr_tuple x0 -> List.map copy_core_type x0 | From.Parsetree.Pcstr_record _x0 -> migration_error loc Def.Pcstr_record and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> string = function | From.Asttypes.Nolabel -> "" | From.Asttypes.Labelled x0 -> x0 | From.Asttypes.Optional x0 -> "?" ^ x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant loc : From.Parsetree.constant -> To.Asttypes.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> begin match x1 with | None -> To.Asttypes.Const_int (int_of_string x0) | Some 'l' -> To.Asttypes.Const_int32 (Int32.of_string x0) | Some 'L' -> To.Asttypes.Const_int64 (Int64.of_string x0) | Some 'n' -> To.Asttypes.Const_nativeint (Nativeint.of_string x0) | Some _ -> migration_error loc Def.Pconst_integer end | From.Parsetree.Pconst_char x0 -> To.Asttypes.Const_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Asttypes.Const_string (x0,x1) | From.Parsetree.Pconst_float (x0,x1) -> begin match x1 with | None -> To.Asttypes.Const_float x0 | Some _ -> migration_error loc Def.Pconst_float end and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = copy_location loc } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } and type_declarations recflag types = match (recflag, List.map copy_type_declaration types) with | From.Asttypes.Recursive, types -> types | From.Asttypes.Nonrecursive, [] -> [] | From.Asttypes.Nonrecursive, (x :: xs) -> let pos = {Lexing. pos_fname = "_none_"; pos_lnum = 1; pos_bol = 0; pos_cnum = -1} in let loc = {To.Location. loc_start = pos; loc_end = pos; loc_ghost = true} in let ptype_attributes = ({To.Asttypes.txt = "nonrec"; loc}, To.Parsetree.PStr []) :: x.To.Parsetree.ptype_attributes in {x with To.Parsetree.ptype_attributes} :: xs let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> copy_out_val_decl x0 | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_value ("...", To.Outcometree.Otyp_abstract, []) and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_sig_item = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = _ } -> To.Outcometree.Osig_value ( oval_name, copy_out_type oval_type, List.map (fun x -> x) oval_prims ) and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = _; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); (*To.Outcometree.otype_immediate = (copy_bool otype_immediate);*) To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (_x0,_x1) -> To.Outcometree.Otyp_abstract (*To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1))*) (*and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name }*) and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_name (x0,x1) -> To.Outcometree.Ovar_name ((copy_out_ident x0), (List.map copy_out_type x1)) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,_x1) -> To.Parsetree.Pdir_int (int_of_string x0) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_403_404.ml000066400000000000000000000157141356450464700240540ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_403_404_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_404_403_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_403_404_migrate.ml000066400000000000000000001645031356450464700255650ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_403 module To = Ast_404 let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), x1) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (x0, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = false; To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_name (x0,x1) -> To.Outcometree.Ovar_name ((copy_out_ident x0), (List.map copy_out_type x1)) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, copy_directive_argument x1) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, copy_option (fun x -> x) x1) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_404_403.ml000066400000000000000000000157141356450464700240540ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_404_403_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_403_404_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_404_403_migrate.ml000066400000000000000000001652761356450464700255750ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Def = Migrate_parsetree_def module From = Ast_404 module To = Ast_403 let from_loc {From.Location. txt = _; loc} = loc let migration_error location feature = raise (Def.Migration_error (feature, location)) let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_loc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc loc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), x1) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception _ -> migration_error loc Def.Pexp_letexception | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (x0, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_loc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc loc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open _ -> migration_error loc Def.Ppat_open and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = _otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_name (x0,x1) -> To.Outcometree.Ovar_name ((copy_out_ident x0), (List.map copy_out_type x1)) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_404_405.ml000066400000000000000000000157141356450464700240560ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_404_405_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_405_404_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_404_405_migrate.ml000066400000000000000000001631261356450464700255670ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_404 module To = Ast_405 let noloc x = { Location. txt = x; loc = Location.none } let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), noloc x1) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (noloc x0, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (noloc x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> noloc x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> noloc x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (noloc x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (noloc x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_name (x0,x1) -> To.Outcometree.Ovar_typ (To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1))) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_405_404.ml000066400000000000000000000157141356450464700240560ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_405_404_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_404_405_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_405_404_migrate.ml000066400000000000000000001633371356450464700255730ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_405 module To = Ast_404 let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), x1.From.Asttypes.txt) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype (x0.From.Asttypes.txt, (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in (x0.From.Asttypes.txt, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> x.From.Asttypes.txt) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> x.From.Asttypes.txt) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc (fun x -> x) x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (x0.From.Asttypes.txt, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (x0.From.Asttypes.txt, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ (From.Outcometree.Otyp_constr (id,tyl)) -> To.Outcometree.Ovar_name (copy_out_ident id, List.map copy_out_type tyl) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_name (To.Outcometree.Oide_ident "", [copy_out_type x0]) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_405_406.ml000066400000000000000000000157141356450464700240600ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_405_406_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_406_405_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_405_406_migrate.ml000066400000000000000000001633441356450464700255730ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_405 module To = Ast_406 let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (fun x -> let (x0,x1,x2) = x in To.Parsetree.Otag (copy_loc (fun x -> x) x0, (copy_attributes x1), (copy_core_type x2))) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag (({ txt = copy_label x0; loc = Location.none; }), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (copy_loc (fun x -> x)) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst x0 -> To.Parsetree.Pwith_typesubst (copy_loc (fun x -> Longident.Lident x) x0.From.Parsetree.ptype_name, copy_type_declaration x0) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst (copy_loc (fun x -> Longident.Lident x) x0, copy_loc copy_longident x1) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string x0 -> To.Outcometree.Oval_string (x0, max_int, Ostr_string) | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_406_405.ml000066400000000000000000000157141356450464700240600ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_406_405_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_405_406_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_406_405_migrate.ml000066400000000000000000001643621356450464700255740ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Def = Migrate_parsetree_def module From = Ast_406 module To = Ast_405 let migration_error location feature = raise (Def.Migration_error (feature, location)) let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map (function | From.Parsetree.Otag (x0,x1,x2) -> (copy_loc (fun x -> x) x0, (copy_attributes x1), (copy_core_type x2)) | From.Parsetree.Oinherit _ -> migration_error Location.none Def.Oinherit) x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag ((copy_label x0.txt), (copy_attributes x1), (copy_bool x2), (List.map copy_core_type x3)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) | From.Parsetree.Pcl_open (_, loc, _) -> migration_error loc.From.Location.loc Def.Pcl_open and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (copy_loc (fun x -> x)) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst ({ txt = Longident.Lident _; _ }, x0) -> To.Parsetree.Pwith_typesubst (copy_type_declaration x0) | From.Parsetree.Pwith_modsubst ({ txt = Longident.Lident x0; loc },x1) -> To.Parsetree.Pwith_modsubst ({ txt = x0; loc }, (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst ({ loc; _ }, _x0) -> migration_error loc Pwith_typesubst_longident | From.Parsetree.Pwith_modsubst ({ loc; _ },_x1) -> migration_error loc Pwith_modsubst_longident and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) | From.Parsetree.Pcty_open (_, loc, _) -> migration_error loc.From.Location.loc Def.Pcty_open and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string (x0, _, _) -> To.Outcometree.Oval_string x0 | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_406_407.ml000066400000000000000000000157141356450464700240620ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_406_407_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_407_406_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_406_407_migrate.ml000066400000000000000000001650511356450464700255720ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module Def = Migrate_parsetree_def module From = Ast_406 module To = Ast_407 let migration_error location feature = raise (Def.Migration_error (feature, location)) let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object (List.map copy_object_field x0, copy_closed_flag x1) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag (copy_loc copy_label x0, copy_attributes x1, copy_bool x2, List.map copy_core_type x3) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : From.Parsetree.object_field -> To.Parsetree.object_field = function | From.Parsetree.Otag (x0,x1,x2) -> To.Parsetree.Otag (copy_loc (fun x -> x) x0, copy_attributes x1, copy_core_type x2) | From.Parsetree.Oinherit x -> To.Parsetree.Oinherit (copy_core_type x) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) | From.Parsetree.Pcl_open (ovf, loc, ce) -> To.Parsetree.Pcl_open (copy_override_flag ovf, copy_loc copy_longident loc, copy_class_expr ce) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (copy_loc (fun x -> x)) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst (x0, x1) -> To.Parsetree.Pwith_typesubst (copy_loc copy_longident x0, copy_type_declaration x1) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst (copy_loc copy_longident x0, copy_loc copy_longident x1) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) | From.Parsetree.Pcty_open (ovf, loc, cty) -> To.Parsetree.Pcty_open (copy_override_flag ovf, copy_loc copy_longident loc, copy_class_type cty) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_string : From.Outcometree.out_string -> To.Outcometree.out_string = function | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string (x0, x1, x2) -> To.Outcometree.Oval_string (x0, x1, copy_out_string x2) | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_407_406.ml000066400000000000000000000157141356450464700240620ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_407_406_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module R = Migrate_parsetree_406_407_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_407_406_migrate.ml000066400000000000000000001646541356450464700256020ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Alain Frisch, LexiFi *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) module From = Ast_407 module To = Ast_406 let rec copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ((copy_override_flag x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object (List.map copy_object_field x0, copy_closed_flag x1) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> To.Parsetree.Rtag (copy_loc copy_label x0, copy_attributes x1, copy_bool x2, List.map copy_core_type x3) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : From.Parsetree.object_field -> To.Parsetree.object_field = function | From.Parsetree.Otag (x0,x1,x2) -> To.Parsetree.Otag (copy_loc (fun x -> x) x0, copy_attributes x1, copy_core_type x2) | From.Parsetree.Oinherit x -> To.Parsetree.Oinherit (copy_core_type x) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (copy_extension_constructor x0) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> To.Parsetree.Pstr_open (copy_open_description x0) | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) | From.Parsetree.Pcl_open (ovf, loc, ce) -> To.Parsetree.Pcl_open (copy_override_flag ovf, copy_loc copy_longident loc, copy_class_expr ce) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (copy_loc (fun x -> x)) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc (fun x -> x) x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst (x0, x1) -> To.Parsetree.Pwith_typesubst (copy_loc copy_longident x0, copy_type_declaration x1) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst (copy_loc copy_longident x0, copy_loc copy_longident x1) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (copy_extension_constructor x0) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) | From.Parsetree.Pcty_open (ovf, loc, cty) -> To.Parsetree.Pcty_open (copy_override_flag ovf, copy_loc copy_longident loc, copy_class_type cty) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in (copy_loc (fun x -> x) x0, (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module (x0, (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_string : From.Outcometree.out_string -> To.Outcometree.out_string = function | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string (x0, x1, x2) -> To.Outcometree.Oval_string (x0, x1, copy_out_string x2) | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir (x0, (copy_directive_argument x1)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_none -> To.Parsetree.Pdir_none | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_407_408.ml000066400000000000000000000167311356450464700240640ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_407_408_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) } as mapper) -> let module Def = Migrate_parsetree_def in let migration_error location feature = raise (Def.Migration_error (feature, location)) in let module R = Migrate_parsetree_408_407_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) (* The following ones were introduced in 4.08. *) binding_op = (fun _ x -> migration_error x.pbop_op.Location.loc Def.Pexp_letop); module_substitution = (fun _ x -> migration_error x.pms_loc Def.Psig_modsubst); open_declaration = (fun _ x -> migration_error x.popen_loc Def.Pexp_open); type_exception = (fun _ x -> migration_error x.ptyexn_loc Def.Psig_typesubst); } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_407_408_migrate.ml000066400000000000000000001721051356450464700255720ustar00rootroot00000000000000module From = Ast_407 module To = Ast_408 let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir (x0,x1) -> To.Parsetree.Ptop_dir { To.Parsetree.pdir_name = { To.Location.txt = x0; To.Location.loc = Location.none; }; To.Parsetree.pdir_arg = copy_directive_argument x1; To.Parsetree.pdir_loc = Location.none; } and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument option = let wrap pdira_desc = Some { To.Parsetree.pdira_desc; To.Parsetree.pdira_loc = Location.none; } in function | From.Parsetree.Pdir_none -> None | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 |> wrap | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) |> wrap | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) |> wrap | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) |> wrap and copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_loc_stack = []; To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1,x2) -> To.Parsetree.Pexp_open ({ To.Parsetree.popen_expr = { To.Parsetree.pmod_desc = To.Parsetree.Pmod_ident (copy_loc copy_longident x1); To.Parsetree.pmod_loc = x1.Location.loc; To.Parsetree.pmod_attributes = []; }; To.Parsetree.popen_override = (copy_override_flag x0); To.Parsetree.popen_loc = x1.Location.loc; To.Parsetree.popen_attributes = []; }, (copy_expression x2)) | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_loc_stack = []; To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_loc_stack = []; To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = function | From.Parsetree.Rtag (x0,x1,x2,x3) -> { To.Parsetree.prf_desc = (To.Parsetree.Rtag ((copy_loc copy_label x0), (copy_bool x2), (List.map copy_core_type x3))); To.Parsetree.prf_loc = x0.Location.loc; To.Parsetree.prf_attributes = (copy_attributes x1); } | From.Parsetree.Rinherit x0 -> { To.Parsetree.prf_desc = (To.Parsetree.Rinherit (copy_core_type x0)); To.Parsetree.prf_loc = x0.From.Parsetree.ptyp_loc; To.Parsetree.prf_attributes = []; } and copy_object_field : From.Parsetree.object_field -> To.Parsetree.object_field = function | From.Parsetree.Otag (x0,x1,x2) -> { To.Parsetree.pof_desc = (To.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x2))); To.Parsetree.pof_loc = x0.Location.loc; To.Parsetree.pof_attributes = (copy_attributes x1); } | From.Parsetree.Oinherit x0 -> { To.Parsetree.pof_desc = (To.Parsetree.Oinherit (copy_core_type x0)); To.Parsetree.pof_loc = x0.From.Parsetree.ptyp_loc; To.Parsetree.pof_attributes = []; } and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun x -> let (x0,x1) = x in { To.Parsetree.attr_name = copy_loc (fun x -> x) x0; To.Parsetree.attr_payload = copy_payload x1; To.Parsetree.attr_loc = x0.Location.loc; } and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> let atat, at = List.partition (function | {Location.txt=("ocaml.deprecated"|"deprecated");_},_ -> false | _ -> true) x0.pext_attributes in let x0 = { x0 with pext_attributes = at } in To.Parsetree.Pstr_exception { To.Parsetree.ptyexn_constructor = (copy_extension_constructor x0); To.Parsetree.ptyexn_loc = x0.From.Parsetree.pext_loc; To.Parsetree.ptyexn_attributes = copy_attributes atat } | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open { From.Parsetree.popen_lid; From.Parsetree.popen_override; From.Parsetree.popen_loc; From.Parsetree.popen_attributes; } -> To.Parsetree.Pstr_open { To.Parsetree.popen_expr = { To.Parsetree.pmod_desc = To.Parsetree.Pmod_ident (copy_loc copy_longident popen_lid); To.Parsetree.pmod_loc = popen_loc; To.Parsetree.pmod_attributes = []; }; To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes); } | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) | From.Parsetree.Pcl_open (x0,x1,x2) -> To.Parsetree.Pcl_open ({ To.Parsetree.popen_expr = (copy_loc copy_longident x1); To.Parsetree.popen_override = (copy_override_flag x0); To.Parsetree.popen_loc = x1.Location.loc; To.Parsetree.popen_attributes = []; }, (copy_class_expr x2)) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> let fields = List.sort (fun (a : From.Parsetree.class_field) (b : From.Parsetree.class_field) -> compare a.pcf_loc.loc_start.pos_cnum b.pcf_loc.loc_start.pos_cnum) pcstr_fields in { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> copy_loc (fun x -> x) x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst (x0,x1) -> To.Parsetree.Pwith_typesubst ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> let atat, at = List.partition (function | {Location.txt=("ocaml.deprecated"|"deprecated");_},_ -> false | _ -> true) x0.pext_attributes in let x0 = { x0 with pext_attributes = at } in To.Parsetree.Psig_exception { To.Parsetree.ptyexn_constructor = (copy_extension_constructor x0); To.Parsetree.ptyexn_loc = x0.From.Parsetree.pext_loc; To.Parsetree.ptyexn_attributes = copy_attributes atat; } | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) | From.Parsetree.Pcty_open (x0,x1,x2) -> To.Parsetree.Pcty_open ({ To.Parsetree.popen_expr = (copy_loc copy_longident x1); To.Parsetree.popen_override = (copy_override_flag x0); To.Parsetree.popen_loc = x1.Location.loc; To.Parsetree.popen_attributes = []; }, (copy_class_type x2)) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> let fields = List.sort (fun (a : From.Parsetree.class_type_field) (b : From.Parsetree.class_type_field) -> compare a.pctf_loc.loc_start.pos_cnum b.pctf_loc.loc_start.pos_cnum) pcsig_fields in { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in let x1 = match x0.txt with | "ocaml.error" | "error" -> begin match x1 with | PStr (hd :: _ :: tl) -> From.Parsetree.PStr (hd :: tl) | _ -> x1 end | _ -> x1 in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_lid = popen_lid; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_expr = (copy_loc copy_longident popen_lid); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_loc = ptyext_path.Location.loc; To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module ((To.Outcometree.Oide_ident { To.Outcometree.printed_name = x0; }), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_string : From.Outcometree.out_string -> To.Outcometree.out_string = function | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string (x0, x1, x2) -> To.Outcometree.Oval_string (x0, x1, copy_out_string x2) | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident ({ To.Outcometree.printed_name = x0; }) let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_408_407.ml000066400000000000000000000161521356450464700240610ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_408_407_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; (*$*) (* The following ones were introduced in 4.08. *) binding_op = _; module_substitution = _; open_declaration = _; type_exception = _; } as mapper) -> let module R = Migrate_parsetree_407_408_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_408_407_migrate.ml000066400000000000000000001724401356450464700255740ustar00rootroot00000000000000module From = Ast_408 module To = Ast_407 module Def = Migrate_parsetree_def let migration_error location feature = raise (Def.Migration_error (feature, location)) let rec copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase = function | From.Parsetree.Ptop_def x0 -> To.Parsetree.Ptop_def (copy_structure x0) | From.Parsetree.Ptop_dir { From.Parsetree.pdir_name; From.Parsetree.pdir_arg; From.Parsetree.pdir_loc = _; } -> To.Parsetree.Ptop_dir (pdir_name.Location.txt, (match pdir_arg with | None -> To.Parsetree.Pdir_none | Some arg -> copy_directive_argument arg)) and copy_directive_argument : From.Parsetree.directive_argument -> To.Parsetree.directive_argument = fun { From.Parsetree.pdira_desc = pdira_desc; From.Parsetree.pdira_loc = _pdira_loc } -> (copy_directive_argument_desc pdira_desc) and copy_directive_argument_desc : From.Parsetree.directive_argument_desc -> To.Parsetree.directive_argument = function | From.Parsetree.Pdir_string x0 -> To.Parsetree.Pdir_string x0 | From.Parsetree.Pdir_int (x0,x1) -> To.Parsetree.Pdir_int (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pdir_ident x0 -> To.Parsetree.Pdir_ident (copy_longident x0) | From.Parsetree.Pdir_bool x0 -> To.Parsetree.Pdir_bool (copy_bool x0) and copy_expression : From.Parsetree.expression -> To.Parsetree.expression = fun { From.Parsetree.pexp_desc = pexp_desc; From.Parsetree.pexp_loc = pexp_loc; From.Parsetree.pexp_loc_stack = _; From.Parsetree.pexp_attributes = pexp_attributes } -> { To.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); To.Parsetree.pexp_loc = (copy_location pexp_loc); To.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : From.Parsetree.expression_desc -> To.Parsetree.expression_desc = function | From.Parsetree.Pexp_ident x0 -> To.Parsetree.Pexp_ident (copy_loc copy_longident x0) | From.Parsetree.Pexp_constant x0 -> To.Parsetree.Pexp_constant (copy_constant x0) | From.Parsetree.Pexp_let (x0,x1,x2) -> To.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | From.Parsetree.Pexp_function x0 -> To.Parsetree.Pexp_function (List.map copy_case x0) | From.Parsetree.Pexp_fun (x0,x1,x2,x3) -> To.Parsetree.Pexp_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | From.Parsetree.Pexp_apply (x0,x1) -> To.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pexp_match (x0,x1) -> To.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_try (x0,x1) -> To.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | From.Parsetree.Pexp_tuple x0 -> To.Parsetree.Pexp_tuple (List.map copy_expression x0) | From.Parsetree.Pexp_construct (x0,x1) -> To.Parsetree.Pexp_construct ((copy_loc copy_longident x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_variant (x0,x1) -> To.Parsetree.Pexp_variant ((copy_label x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_record (x0,x1) -> To.Parsetree.Pexp_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_expression x1))) x0), (copy_option copy_expression x1)) | From.Parsetree.Pexp_field (x0,x1) -> To.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_longident x1)) | From.Parsetree.Pexp_setfield (x0,x1,x2) -> To.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_longident x1), (copy_expression x2)) | From.Parsetree.Pexp_array x0 -> To.Parsetree.Pexp_array (List.map copy_expression x0) | From.Parsetree.Pexp_ifthenelse (x0,x1,x2) -> To.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (copy_option copy_expression x2)) | From.Parsetree.Pexp_sequence (x0,x1) -> To.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_while (x0,x1) -> To.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | From.Parsetree.Pexp_for (x0,x1,x2,x3,x4) -> To.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | From.Parsetree.Pexp_constraint (x0,x1) -> To.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | From.Parsetree.Pexp_coerce (x0,x1,x2) -> To.Parsetree.Pexp_coerce ((copy_expression x0), (copy_option copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Pexp_send (x0,x1) -> To.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | From.Parsetree.Pexp_new x0 -> To.Parsetree.Pexp_new (copy_loc copy_longident x0) | From.Parsetree.Pexp_setinstvar (x0,x1) -> To.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | From.Parsetree.Pexp_override x0 -> To.Parsetree.Pexp_override (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | From.Parsetree.Pexp_letmodule (x0,x1,x2) -> To.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | From.Parsetree.Pexp_letexception (x0,x1) -> To.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | From.Parsetree.Pexp_assert x0 -> To.Parsetree.Pexp_assert (copy_expression x0) | From.Parsetree.Pexp_lazy x0 -> To.Parsetree.Pexp_lazy (copy_expression x0) | From.Parsetree.Pexp_poly (x0,x1) -> To.Parsetree.Pexp_poly ((copy_expression x0), (copy_option copy_core_type x1)) | From.Parsetree.Pexp_object x0 -> To.Parsetree.Pexp_object (copy_class_structure x0) | From.Parsetree.Pexp_newtype (x0,x1) -> To.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | From.Parsetree.Pexp_pack x0 -> To.Parsetree.Pexp_pack (copy_module_expr x0) | From.Parsetree.Pexp_open (x0,x1) -> begin match x0.From.Parsetree.popen_expr.From.Parsetree.pmod_desc with | Pmod_ident lid -> To.Parsetree.Pexp_open (copy_override_flag x0.From.Parsetree.popen_override, (copy_loc copy_longident lid), (copy_expression x1)) | Pmod_structure _ | Pmod_functor _ | Pmod_apply _ | Pmod_constraint _ | Pmod_unpack _ | Pmod_extension _ -> migration_error x0.From.Parsetree.popen_loc Def.Pexp_open end | From.Parsetree.Pexp_letop { let_; ands = _; body = _; } -> migration_error let_.pbop_op.loc Def.Pexp_letop | From.Parsetree.Pexp_extension x0 -> To.Parsetree.Pexp_extension (copy_extension x0) | From.Parsetree.Pexp_unreachable -> To.Parsetree.Pexp_unreachable and copy_direction_flag : From.Asttypes.direction_flag -> To.Asttypes.direction_flag = function | From.Asttypes.Upto -> To.Asttypes.Upto | From.Asttypes.Downto -> To.Asttypes.Downto and copy_case : From.Parsetree.case -> To.Parsetree.case = fun { From.Parsetree.pc_lhs = pc_lhs; From.Parsetree.pc_guard = pc_guard; From.Parsetree.pc_rhs = pc_rhs } -> { To.Parsetree.pc_lhs = (copy_pattern pc_lhs); To.Parsetree.pc_guard = (copy_option copy_expression pc_guard); To.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : From.Parsetree.value_binding -> To.Parsetree.value_binding = fun { From.Parsetree.pvb_pat = pvb_pat; From.Parsetree.pvb_expr = pvb_expr; From.Parsetree.pvb_attributes = pvb_attributes; From.Parsetree.pvb_loc = pvb_loc } -> { To.Parsetree.pvb_pat = (copy_pattern pvb_pat); To.Parsetree.pvb_expr = (copy_expression pvb_expr); To.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); To.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern = fun { From.Parsetree.ppat_desc = ppat_desc; From.Parsetree.ppat_loc = ppat_loc; From.Parsetree.ppat_loc_stack = _; From.Parsetree.ppat_attributes = ppat_attributes } -> { To.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); To.Parsetree.ppat_loc = (copy_location ppat_loc); To.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : From.Parsetree.pattern_desc -> To.Parsetree.pattern_desc = function | From.Parsetree.Ppat_any -> To.Parsetree.Ppat_any | From.Parsetree.Ppat_var x0 -> To.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_alias (x0,x1) -> To.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | From.Parsetree.Ppat_constant x0 -> To.Parsetree.Ppat_constant (copy_constant x0) | From.Parsetree.Ppat_interval (x0,x1) -> To.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | From.Parsetree.Ppat_tuple x0 -> To.Parsetree.Ppat_tuple (List.map copy_pattern x0) | From.Parsetree.Ppat_construct (x0,x1) -> To.Parsetree.Ppat_construct ((copy_loc copy_longident x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_variant (x0,x1) -> To.Parsetree.Ppat_variant ((copy_label x0), (copy_option copy_pattern x1)) | From.Parsetree.Ppat_record (x0,x1) -> To.Parsetree.Ppat_record ((List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | From.Parsetree.Ppat_array x0 -> To.Parsetree.Ppat_array (List.map copy_pattern x0) | From.Parsetree.Ppat_or (x0,x1) -> To.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | From.Parsetree.Ppat_constraint (x0,x1) -> To.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | From.Parsetree.Ppat_type x0 -> To.Parsetree.Ppat_type (copy_loc copy_longident x0) | From.Parsetree.Ppat_lazy x0 -> To.Parsetree.Ppat_lazy (copy_pattern x0) | From.Parsetree.Ppat_unpack x0 -> To.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | From.Parsetree.Ppat_exception x0 -> To.Parsetree.Ppat_exception (copy_pattern x0) | From.Parsetree.Ppat_extension x0 -> To.Parsetree.Ppat_extension (copy_extension x0) | From.Parsetree.Ppat_open (x0,x1) -> To.Parsetree.Ppat_open ((copy_loc copy_longident x0), (copy_pattern x1)) and copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type = fun { From.Parsetree.ptyp_desc = ptyp_desc; From.Parsetree.ptyp_loc = ptyp_loc; From.Parsetree.ptyp_loc_stack = _; From.Parsetree.ptyp_attributes = ptyp_attributes } -> { To.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); To.Parsetree.ptyp_loc = (copy_location ptyp_loc); To.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : From.Parsetree.core_type_desc -> To.Parsetree.core_type_desc = function | From.Parsetree.Ptyp_any -> To.Parsetree.Ptyp_any | From.Parsetree.Ptyp_var x0 -> To.Parsetree.Ptyp_var x0 | From.Parsetree.Ptyp_arrow (x0,x1,x2) -> To.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | From.Parsetree.Ptyp_tuple x0 -> To.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | From.Parsetree.Ptyp_constr (x0,x1) -> To.Parsetree.Ptyp_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_object (x0,x1) -> To.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | From.Parsetree.Ptyp_class (x0,x1) -> To.Parsetree.Ptyp_class ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Ptyp_alias (x0,x1) -> To.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | From.Parsetree.Ptyp_variant (x0,x1,x2) -> To.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (copy_option (fun x -> List.map copy_label x) x2)) | From.Parsetree.Ptyp_poly (x0,x1) -> To.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | From.Parsetree.Ptyp_package x0 -> To.Parsetree.Ptyp_package (copy_package_type x0) | From.Parsetree.Ptyp_extension x0 -> To.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : From.Parsetree.package_type -> To.Parsetree.package_type = fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (List.map (fun x -> let (x0,x1) = x in ((copy_loc copy_longident x0), (copy_core_type x1))) x1)) and copy_row_field : From.Parsetree.row_field -> To.Parsetree.row_field = fun { From.Parsetree.prf_desc = prf_desc; From.Parsetree.prf_loc = _; From.Parsetree.prf_attributes = prf_attributes } -> match prf_desc with | From.Parsetree.Rtag (x0, x1, x2) -> To.Parsetree.Rtag ((copy_loc copy_label x0), (copy_attributes prf_attributes), (copy_bool x1), (List.map copy_core_type x2)) | From.Parsetree.Rinherit x0 -> To.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : From.Parsetree.object_field -> To.Parsetree.object_field = fun { From.Parsetree.pof_desc = pof_desc; From.Parsetree.pof_loc = _; From.Parsetree.pof_attributes = pof_attributes } -> match pof_desc with | From.Parsetree.Otag (x0, x1) -> To.Parsetree.Otag ((copy_loc copy_label x0), (copy_attributes pof_attributes), (copy_core_type x1)) | From.Parsetree.Oinherit x0 -> To.Parsetree.Oinherit (copy_core_type x0) and copy_attributes : From.Parsetree.attributes -> To.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : From.Parsetree.attribute -> To.Parsetree.attribute = fun { From.Parsetree.attr_name = attr_name; From.Parsetree.attr_payload = attr_payload; From.Parsetree.attr_loc = _ } -> ((copy_loc (fun x -> x) attr_name), (copy_payload attr_payload)) and copy_payload : From.Parsetree.payload -> To.Parsetree.payload = function | From.Parsetree.PStr x0 -> To.Parsetree.PStr (copy_structure x0) | From.Parsetree.PSig x0 -> To.Parsetree.PSig (copy_signature x0) | From.Parsetree.PTyp x0 -> To.Parsetree.PTyp (copy_core_type x0) | From.Parsetree.PPat (x0,x1) -> To.Parsetree.PPat ((copy_pattern x0), (copy_option copy_expression x1)) and copy_structure : From.Parsetree.structure -> To.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : From.Parsetree.structure_item -> To.Parsetree.structure_item = fun { From.Parsetree.pstr_desc = pstr_desc; From.Parsetree.pstr_loc = pstr_loc } -> { To.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); To.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : From.Parsetree.structure_item_desc -> To.Parsetree.structure_item_desc = function | From.Parsetree.Pstr_eval (x0,x1) -> To.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | From.Parsetree.Pstr_value (x0,x1) -> To.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | From.Parsetree.Pstr_primitive x0 -> To.Parsetree.Pstr_primitive (copy_value_description x0) | From.Parsetree.Pstr_type (x0,x1) -> To.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Pstr_typext x0 -> To.Parsetree.Pstr_typext (copy_type_extension x0) | From.Parsetree.Pstr_exception x0 -> To.Parsetree.Pstr_exception (let e = copy_extension_constructor x0.From.Parsetree.ptyexn_constructor in { e with pext_attributes = e.pext_attributes @ (copy_attributes x0.ptyexn_attributes) } ) | From.Parsetree.Pstr_module x0 -> To.Parsetree.Pstr_module (copy_module_binding x0) | From.Parsetree.Pstr_recmodule x0 -> To.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | From.Parsetree.Pstr_modtype x0 -> To.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | From.Parsetree.Pstr_open x0 -> begin match x0.From.Parsetree.popen_expr.From.Parsetree.pmod_desc with | Pmod_ident lid -> To.Parsetree.Pstr_open { To.Parsetree.popen_lid = (copy_loc copy_longident lid); To.Parsetree.popen_override = (copy_override_flag x0.From.Parsetree.popen_override); To.Parsetree.popen_loc = (copy_location x0.From.Parsetree.popen_loc); To.Parsetree.popen_attributes = (copy_attributes x0.From.Parsetree.popen_attributes); } | Pmod_structure _ | Pmod_functor _ | Pmod_apply _ | Pmod_constraint _ | Pmod_unpack _ | Pmod_extension _ -> migration_error x0.From.Parsetree.popen_loc Def.Pexp_open end | From.Parsetree.Pstr_class x0 -> To.Parsetree.Pstr_class (List.map copy_class_declaration x0) | From.Parsetree.Pstr_class_type x0 -> To.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Pstr_include x0 -> To.Parsetree.Pstr_include (copy_include_declaration x0) | From.Parsetree.Pstr_attribute x0 -> To.Parsetree.Pstr_attribute (copy_attribute x0) | From.Parsetree.Pstr_extension (x0,x1) -> To.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : From.Parsetree.include_declaration -> To.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : From.Parsetree.class_declaration -> To.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : From.Parsetree.class_expr -> To.Parsetree.class_expr = fun { From.Parsetree.pcl_desc = pcl_desc; From.Parsetree.pcl_loc = pcl_loc; From.Parsetree.pcl_attributes = pcl_attributes } -> { To.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); To.Parsetree.pcl_loc = (copy_location pcl_loc); To.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : From.Parsetree.class_expr_desc -> To.Parsetree.class_expr_desc = function | From.Parsetree.Pcl_constr (x0,x1) -> To.Parsetree.Pcl_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcl_structure x0 -> To.Parsetree.Pcl_structure (copy_class_structure x0) | From.Parsetree.Pcl_fun (x0,x1,x2,x3) -> To.Parsetree.Pcl_fun ((copy_arg_label x0), (copy_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | From.Parsetree.Pcl_apply (x0,x1) -> To.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0,x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | From.Parsetree.Pcl_let (x0,x1,x2) -> To.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | From.Parsetree.Pcl_constraint (x0,x1) -> To.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | From.Parsetree.Pcl_extension x0 -> To.Parsetree.Pcl_extension (copy_extension x0) | From.Parsetree.Pcl_open (x0,x1) -> To.Parsetree.Pcl_open ((copy_override_flag x0.From.Parsetree.popen_override), (copy_loc copy_longident x0.From.Parsetree.popen_expr), (copy_class_expr x1)) and copy_class_structure : From.Parsetree.class_structure -> To.Parsetree.class_structure = fun { From.Parsetree.pcstr_self = pcstr_self; From.Parsetree.pcstr_fields = pcstr_fields } -> { To.Parsetree.pcstr_self = (copy_pattern pcstr_self); To.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : From.Parsetree.class_field -> To.Parsetree.class_field = fun { From.Parsetree.pcf_desc = pcf_desc; From.Parsetree.pcf_loc = pcf_loc; From.Parsetree.pcf_attributes = pcf_attributes } -> { To.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); To.Parsetree.pcf_loc = (copy_location pcf_loc); To.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : From.Parsetree.class_field_desc -> To.Parsetree.class_field_desc = function | From.Parsetree.Pcf_inherit (x0,x1,x2) -> To.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (copy_option (fun x -> copy_loc (fun x -> x) x) x2)) | From.Parsetree.Pcf_val x0 -> To.Parsetree.Pcf_val (let (x0,x1,x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_method x0 -> To.Parsetree.Pcf_method (let (x0,x1,x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | From.Parsetree.Pcf_constraint x0 -> To.Parsetree.Pcf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pcf_initializer x0 -> To.Parsetree.Pcf_initializer (copy_expression x0) | From.Parsetree.Pcf_attribute x0 -> To.Parsetree.Pcf_attribute (copy_attribute x0) | From.Parsetree.Pcf_extension x0 -> To.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : From.Parsetree.class_field_kind -> To.Parsetree.class_field_kind = function | From.Parsetree.Cfk_virtual x0 -> To.Parsetree.Cfk_virtual (copy_core_type x0) | From.Parsetree.Cfk_concrete (x0,x1) -> To.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_module_binding : From.Parsetree.module_binding -> To.Parsetree.module_binding = fun { From.Parsetree.pmb_name = pmb_name; From.Parsetree.pmb_expr = pmb_expr; From.Parsetree.pmb_attributes = pmb_attributes; From.Parsetree.pmb_loc = pmb_loc } -> { To.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); To.Parsetree.pmb_expr = (copy_module_expr pmb_expr); To.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); To.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : From.Parsetree.module_expr -> To.Parsetree.module_expr = fun { From.Parsetree.pmod_desc = pmod_desc; From.Parsetree.pmod_loc = pmod_loc; From.Parsetree.pmod_attributes = pmod_attributes } -> { To.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); To.Parsetree.pmod_loc = (copy_location pmod_loc); To.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : From.Parsetree.module_expr_desc -> To.Parsetree.module_expr_desc = function | From.Parsetree.Pmod_ident x0 -> To.Parsetree.Pmod_ident (copy_loc copy_longident x0) | From.Parsetree.Pmod_structure x0 -> To.Parsetree.Pmod_structure (copy_structure x0) | From.Parsetree.Pmod_functor (x0,x1,x2) -> To.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_expr x2)) | From.Parsetree.Pmod_apply (x0,x1) -> To.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | From.Parsetree.Pmod_constraint (x0,x1) -> To.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | From.Parsetree.Pmod_unpack x0 -> To.Parsetree.Pmod_unpack (copy_expression x0) | From.Parsetree.Pmod_extension x0 -> To.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : From.Parsetree.module_type -> To.Parsetree.module_type = fun { From.Parsetree.pmty_desc = pmty_desc; From.Parsetree.pmty_loc = pmty_loc; From.Parsetree.pmty_attributes = pmty_attributes } -> { To.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); To.Parsetree.pmty_loc = (copy_location pmty_loc); To.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : From.Parsetree.module_type_desc -> To.Parsetree.module_type_desc = function | From.Parsetree.Pmty_ident x0 -> To.Parsetree.Pmty_ident (copy_loc copy_longident x0) | From.Parsetree.Pmty_signature x0 -> To.Parsetree.Pmty_signature (copy_signature x0) | From.Parsetree.Pmty_functor (x0,x1,x2) -> To.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (copy_option copy_module_type x1), (copy_module_type x2)) | From.Parsetree.Pmty_with (x0,x1) -> To.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | From.Parsetree.Pmty_typeof x0 -> To.Parsetree.Pmty_typeof (copy_module_expr x0) | From.Parsetree.Pmty_extension x0 -> To.Parsetree.Pmty_extension (copy_extension x0) | From.Parsetree.Pmty_alias x0 -> To.Parsetree.Pmty_alias (copy_loc copy_longident x0) and copy_with_constraint : From.Parsetree.with_constraint -> To.Parsetree.with_constraint = function | From.Parsetree.Pwith_type (x0,x1) -> To.Parsetree.Pwith_type ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_module (x0,x1) -> To.Parsetree.Pwith_module ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) | From.Parsetree.Pwith_typesubst (x0,x1) -> To.Parsetree.Pwith_typesubst ((copy_loc copy_longident x0), (copy_type_declaration x1)) | From.Parsetree.Pwith_modsubst (x0,x1) -> To.Parsetree.Pwith_modsubst ((copy_loc copy_longident x0), (copy_loc copy_longident x1)) and copy_signature : From.Parsetree.signature -> To.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : From.Parsetree.signature_item -> To.Parsetree.signature_item = fun { From.Parsetree.psig_desc = psig_desc; From.Parsetree.psig_loc = psig_loc } -> { To.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); To.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : From.Parsetree.signature_item_desc -> To.Parsetree.signature_item_desc = function | From.Parsetree.Psig_value x0 -> To.Parsetree.Psig_value (copy_value_description x0) | From.Parsetree.Psig_type (x0,x1) -> To.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | From.Parsetree.Psig_typesubst x0 -> let x0_loc = match x0 with | [] -> Location.none | { From.Parsetree.ptype_loc; _ } :: _ -> ptype_loc in migration_error x0_loc Def.Psig_typesubst | From.Parsetree.Psig_typext x0 -> To.Parsetree.Psig_typext (copy_type_extension x0) | From.Parsetree.Psig_exception x0 -> To.Parsetree.Psig_exception (let e = copy_extension_constructor x0.From.Parsetree.ptyexn_constructor in {e with pext_attributes = e.pext_attributes @ (copy_attributes x0.ptyexn_attributes) }) | From.Parsetree.Psig_module x0 -> To.Parsetree.Psig_module (copy_module_declaration x0) | From.Parsetree.Psig_modsubst x0 -> migration_error x0.pms_loc Def.Psig_modsubst | From.Parsetree.Psig_recmodule x0 -> To.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | From.Parsetree.Psig_modtype x0 -> To.Parsetree.Psig_modtype (copy_module_type_declaration x0) | From.Parsetree.Psig_open x0 -> To.Parsetree.Psig_open (copy_open_description x0) | From.Parsetree.Psig_include x0 -> To.Parsetree.Psig_include (copy_include_description x0) | From.Parsetree.Psig_class x0 -> To.Parsetree.Psig_class (List.map copy_class_description x0) | From.Parsetree.Psig_class_type x0 -> To.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | From.Parsetree.Psig_attribute x0 -> To.Parsetree.Psig_attribute (copy_attribute x0) | From.Parsetree.Psig_extension (x0,x1) -> To.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : From.Parsetree.class_type_declaration -> To.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : From.Parsetree.class_description -> To.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : From.Parsetree.class_type -> To.Parsetree.class_type = fun { From.Parsetree.pcty_desc = pcty_desc; From.Parsetree.pcty_loc = pcty_loc; From.Parsetree.pcty_attributes = pcty_attributes } -> { To.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); To.Parsetree.pcty_loc = (copy_location pcty_loc); To.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : From.Parsetree.class_type_desc -> To.Parsetree.class_type_desc = function | From.Parsetree.Pcty_constr (x0,x1) -> To.Parsetree.Pcty_constr ((copy_loc copy_longident x0), (List.map copy_core_type x1)) | From.Parsetree.Pcty_signature x0 -> To.Parsetree.Pcty_signature (copy_class_signature x0) | From.Parsetree.Pcty_arrow (x0,x1,x2) -> To.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | From.Parsetree.Pcty_extension x0 -> To.Parsetree.Pcty_extension (copy_extension x0) | From.Parsetree.Pcty_open (x0,x1) -> To.Parsetree.Pcty_open ((copy_override_flag x0.From.Parsetree.popen_override), (copy_loc copy_longident x0.From.Parsetree.popen_expr), (copy_class_type x1)) and copy_class_signature : From.Parsetree.class_signature -> To.Parsetree.class_signature = fun { From.Parsetree.pcsig_self = pcsig_self; From.Parsetree.pcsig_fields = pcsig_fields } -> { To.Parsetree.pcsig_self = (copy_core_type pcsig_self); To.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : From.Parsetree.class_type_field -> To.Parsetree.class_type_field = fun { From.Parsetree.pctf_desc = pctf_desc; From.Parsetree.pctf_loc = pctf_loc; From.Parsetree.pctf_attributes = pctf_attributes } -> { To.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); To.Parsetree.pctf_loc = (copy_location pctf_loc); To.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : From.Parsetree.class_type_field_desc -> To.Parsetree.class_type_field_desc = function | From.Parsetree.Pctf_inherit x0 -> To.Parsetree.Pctf_inherit (copy_class_type x0) | From.Parsetree.Pctf_val x0 -> To.Parsetree.Pctf_val (let (x0,x1,x2,x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_method x0 -> To.Parsetree.Pctf_method (let (x0,x1,x2,x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | From.Parsetree.Pctf_constraint x0 -> To.Parsetree.Pctf_constraint (let (x0,x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | From.Parsetree.Pctf_attribute x0 -> To.Parsetree.Pctf_attribute (copy_attribute x0) | From.Parsetree.Pctf_extension x0 -> To.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : From.Parsetree.extension -> To.Parsetree.extension = fun x -> let (x0,x1) = x in let x1 = match x0.txt with | "ocaml.error" | "error" -> begin match x1 with | PStr (hd :: tl) -> From.Parsetree.PStr (hd :: hd :: tl) | _ -> x1 end | _ -> x1 in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.class_infos -> 'g0 To.Parsetree.class_infos = fun f0 -> fun { From.Parsetree.pci_virt = pci_virt; From.Parsetree.pci_params = pci_params; From.Parsetree.pci_name = pci_name; From.Parsetree.pci_expr = pci_expr; From.Parsetree.pci_loc = pci_loc; From.Parsetree.pci_attributes = pci_attributes } -> { To.Parsetree.pci_virt = (copy_virtual_flag pci_virt); To.Parsetree.pci_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); To.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); To.Parsetree.pci_expr = (f0 pci_expr); To.Parsetree.pci_loc = (copy_location pci_loc); To.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : From.Asttypes.virtual_flag -> To.Asttypes.virtual_flag = function | From.Asttypes.Virtual -> To.Asttypes.Virtual | From.Asttypes.Concrete -> To.Asttypes.Concrete and copy_include_description : From.Parsetree.include_description -> To.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Parsetree.include_infos -> 'g0 To.Parsetree.include_infos = fun f0 -> fun { From.Parsetree.pincl_mod = pincl_mod; From.Parsetree.pincl_loc = pincl_loc; From.Parsetree.pincl_attributes = pincl_attributes } -> { To.Parsetree.pincl_mod = (f0 pincl_mod); To.Parsetree.pincl_loc = (copy_location pincl_loc); To.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : From.Parsetree.open_description -> To.Parsetree.open_description = fun { From.Parsetree.popen_expr = popen_expr; From.Parsetree.popen_override = popen_override; From.Parsetree.popen_loc = popen_loc; From.Parsetree.popen_attributes = popen_attributes } -> { To.Parsetree.popen_lid = (copy_loc copy_longident popen_expr); To.Parsetree.popen_override = (copy_override_flag popen_override); To.Parsetree.popen_loc = (copy_location popen_loc); To.Parsetree.popen_attributes = (copy_attributes popen_attributes); } and copy_override_flag : From.Asttypes.override_flag -> To.Asttypes.override_flag = function | From.Asttypes.Override -> To.Asttypes.Override | From.Asttypes.Fresh -> To.Asttypes.Fresh and copy_module_type_declaration : From.Parsetree.module_type_declaration -> To.Parsetree.module_type_declaration = fun { From.Parsetree.pmtd_name = pmtd_name; From.Parsetree.pmtd_type = pmtd_type; From.Parsetree.pmtd_attributes = pmtd_attributes; From.Parsetree.pmtd_loc = pmtd_loc } -> { To.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); To.Parsetree.pmtd_type = (copy_option copy_module_type pmtd_type); To.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); To.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_declaration : From.Parsetree.module_declaration -> To.Parsetree.module_declaration = fun { From.Parsetree.pmd_name = pmd_name; From.Parsetree.pmd_type = pmd_type; From.Parsetree.pmd_attributes = pmd_attributes; From.Parsetree.pmd_loc = pmd_loc } -> { To.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); To.Parsetree.pmd_type = (copy_module_type pmd_type); To.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); To.Parsetree.pmd_loc = (copy_location pmd_loc) } (* and copy_type_exception : From.Parsetree.type_exception -> To.Parsetree.type_exception = fun { From.Parsetree.ptyexn_constructor = ptyexn_constructor; From.Parsetree.ptyexn_loc = ptyexn_loc; From.Parsetree.ptyexn_attributes = ptyexn_attributes } -> { To.Parsetree.ptyexn_constructor = (copy_extension_constructor ptyexn_constructor); To.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); To.Parsetree.ptyexn_attributes = (copy_attributes ptyexn_attributes) }*) and copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension = fun { From.Parsetree.ptyext_path = ptyext_path; From.Parsetree.ptyext_params = ptyext_params; From.Parsetree.ptyext_constructors = ptyext_constructors; From.Parsetree.ptyext_private = ptyext_private; From.Parsetree.ptyext_loc = _; From.Parsetree.ptyext_attributes = ptyext_attributes } -> { To.Parsetree.ptyext_path = (copy_loc copy_longident ptyext_path); To.Parsetree.ptyext_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); To.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); To.Parsetree.ptyext_private = (copy_private_flag ptyext_private); To.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor = fun { From.Parsetree.pext_name = pext_name; From.Parsetree.pext_kind = pext_kind; From.Parsetree.pext_loc = pext_loc; From.Parsetree.pext_attributes = pext_attributes } -> { To.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); To.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); To.Parsetree.pext_loc = (copy_location pext_loc); To.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : From.Parsetree.extension_constructor_kind -> To.Parsetree.extension_constructor_kind = function | From.Parsetree.Pext_decl (x0,x1) -> To.Parsetree.Pext_decl ((copy_constructor_arguments x0), (copy_option copy_core_type x1)) | From.Parsetree.Pext_rebind x0 -> To.Parsetree.Pext_rebind (copy_loc copy_longident x0) and copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration = fun { From.Parsetree.ptype_name = ptype_name; From.Parsetree.ptype_params = ptype_params; From.Parsetree.ptype_cstrs = ptype_cstrs; From.Parsetree.ptype_kind = ptype_kind; From.Parsetree.ptype_private = ptype_private; From.Parsetree.ptype_manifest = ptype_manifest; From.Parsetree.ptype_attributes = ptype_attributes; From.Parsetree.ptype_loc = ptype_loc } -> { To.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); To.Parsetree.ptype_params = (List.map (fun x -> let (x0,x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); To.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0,x1,x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); To.Parsetree.ptype_kind = (copy_type_kind ptype_kind); To.Parsetree.ptype_private = (copy_private_flag ptype_private); To.Parsetree.ptype_manifest = (copy_option copy_core_type ptype_manifest); To.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); To.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_type_kind : From.Parsetree.type_kind -> To.Parsetree.type_kind = function | From.Parsetree.Ptype_abstract -> To.Parsetree.Ptype_abstract | From.Parsetree.Ptype_variant x0 -> To.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | From.Parsetree.Ptype_record x0 -> To.Parsetree.Ptype_record (List.map copy_label_declaration x0) | From.Parsetree.Ptype_open -> To.Parsetree.Ptype_open and copy_constructor_declaration : From.Parsetree.constructor_declaration -> To.Parsetree.constructor_declaration = fun { From.Parsetree.pcd_name = pcd_name; From.Parsetree.pcd_args = pcd_args; From.Parsetree.pcd_res = pcd_res; From.Parsetree.pcd_loc = pcd_loc; From.Parsetree.pcd_attributes = pcd_attributes } -> { To.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); To.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); To.Parsetree.pcd_res = (copy_option copy_core_type pcd_res); To.Parsetree.pcd_loc = (copy_location pcd_loc); To.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : From.Parsetree.constructor_arguments -> To.Parsetree.constructor_arguments = function | From.Parsetree.Pcstr_tuple x0 -> To.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | From.Parsetree.Pcstr_record x0 -> To.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : From.Parsetree.label_declaration -> To.Parsetree.label_declaration = fun { From.Parsetree.pld_name = pld_name; From.Parsetree.pld_mutable = pld_mutable; From.Parsetree.pld_type = pld_type; From.Parsetree.pld_loc = pld_loc; From.Parsetree.pld_attributes = pld_attributes } -> { To.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); To.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); To.Parsetree.pld_type = (copy_core_type pld_type); To.Parsetree.pld_loc = (copy_location pld_loc); To.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : From.Asttypes.mutable_flag -> To.Asttypes.mutable_flag = function | From.Asttypes.Immutable -> To.Asttypes.Immutable | From.Asttypes.Mutable -> To.Asttypes.Mutable and copy_variance : From.Asttypes.variance -> To.Asttypes.variance = function | From.Asttypes.Covariant -> To.Asttypes.Covariant | From.Asttypes.Contravariant -> To.Asttypes.Contravariant | From.Asttypes.Invariant -> To.Asttypes.Invariant and copy_value_description : From.Parsetree.value_description -> To.Parsetree.value_description = fun { From.Parsetree.pval_name = pval_name; From.Parsetree.pval_type = pval_type; From.Parsetree.pval_prim = pval_prim; From.Parsetree.pval_attributes = pval_attributes; From.Parsetree.pval_loc = pval_loc } -> { To.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); To.Parsetree.pval_type = (copy_core_type pval_type); To.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); To.Parsetree.pval_attributes = (copy_attributes pval_attributes); To.Parsetree.pval_loc = (copy_location pval_loc) } and copy_arg_label : From.Asttypes.arg_label -> To.Asttypes.arg_label = function | From.Asttypes.Nolabel -> To.Asttypes.Nolabel | From.Asttypes.Labelled x0 -> To.Asttypes.Labelled x0 | From.Asttypes.Optional x0 -> To.Asttypes.Optional x0 and copy_closed_flag : From.Asttypes.closed_flag -> To.Asttypes.closed_flag = function | From.Asttypes.Closed -> To.Asttypes.Closed | From.Asttypes.Open -> To.Asttypes.Open and copy_label : From.Asttypes.label -> To.Asttypes.label = fun x -> x and copy_rec_flag : From.Asttypes.rec_flag -> To.Asttypes.rec_flag = function | From.Asttypes.Nonrecursive -> To.Asttypes.Nonrecursive | From.Asttypes.Recursive -> To.Asttypes.Recursive and copy_constant : From.Parsetree.constant -> To.Parsetree.constant = function | From.Parsetree.Pconst_integer (x0,x1) -> To.Parsetree.Pconst_integer (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_char x0 -> To.Parsetree.Pconst_char x0 | From.Parsetree.Pconst_string (x0,x1) -> To.Parsetree.Pconst_string (x0, (copy_option (fun x -> x) x1)) | From.Parsetree.Pconst_float (x0,x1) -> To.Parsetree.Pconst_float (x0, (copy_option (fun x -> x) x1)) and copy_option : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 option -> 'g0 option = fun f0 -> function | None -> None | Some x0 -> Some (f0 x0) and copy_longident : From.Longident.t -> To.Longident.t = function | From.Longident.Lident x0 -> To.Longident.Lident x0 | From.Longident.Ldot (x0,x1) -> To.Longident.Ldot ((copy_longident x0), x1) | From.Longident.Lapply (x0,x1) -> To.Longident.Lapply ((copy_longident x0), (copy_longident x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 From.Asttypes.loc -> 'g0 To.Asttypes.loc = fun f0 -> fun { From.Asttypes.txt = txt; From.Asttypes.loc = loc } -> { To.Asttypes.txt = (f0 txt); To.Asttypes.loc = (copy_location loc) } and copy_location : From.Location.t -> To.Location.t = fun { From.Location.loc_start = loc_start; From.Location.loc_end = loc_end; From.Location.loc_ghost = loc_ghost } -> { To.Location.loc_start = (copy_Lexing_position loc_start); To.Location.loc_end = (copy_Lexing_position loc_end); To.Location.loc_ghost = (copy_bool loc_ghost) } and copy_bool : bool -> bool = function | false -> false | true -> true and copy_Lexing_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let copy_cases x = List.map copy_case x let copy_pat = copy_pattern let copy_expr = copy_expression let copy_typ = copy_core_type let rec copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase = function | From.Outcometree.Ophr_eval (x0,x1) -> To.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | From.Outcometree.Ophr_signature x0 -> To.Outcometree.Ophr_signature (List.map (fun x -> let (x0,x1) = x in ((copy_out_sig_item x0), (copy_option copy_out_value x1))) x0) | From.Outcometree.Ophr_exception x0 -> To.Outcometree.Ophr_exception (let (x0,x1) = x0 in ((copy_exn x0), (copy_out_value x1))) and copy_exn : exn -> exn = fun x -> x and copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item = function | From.Outcometree.Osig_class (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_class_type (x0,x1,x2,x3,x4) -> To.Outcometree.Osig_class_type ((copy_bool x0), x1, (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | From.Outcometree.Osig_typext (x0,x1) -> To.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | From.Outcometree.Osig_modtype (x0,x1) -> To.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | From.Outcometree.Osig_module (x0,x1,x2) -> To.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | From.Outcometree.Osig_type (x0,x1) -> To.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | From.Outcometree.Osig_value x0 -> To.Outcometree.Osig_value (copy_out_val_decl x0) | From.Outcometree.Osig_ellipsis -> To.Outcometree.Osig_ellipsis and copy_out_val_decl : From.Outcometree.out_val_decl -> To.Outcometree.out_val_decl = fun { From.Outcometree.oval_name = oval_name; From.Outcometree.oval_type = oval_type; From.Outcometree.oval_prims = oval_prims; From.Outcometree.oval_attributes = oval_attributes } -> { To.Outcometree.oval_name = oval_name; To.Outcometree.oval_type = (copy_out_type oval_type); To.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); To.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : From.Outcometree.out_type_decl -> To.Outcometree.out_type_decl = fun { From.Outcometree.otype_name = otype_name; From.Outcometree.otype_params = otype_params; From.Outcometree.otype_type = otype_type; From.Outcometree.otype_private = otype_private; From.Outcometree.otype_immediate = otype_immediate; From.Outcometree.otype_unboxed = otype_unboxed; From.Outcometree.otype_cstrs = otype_cstrs } -> { To.Outcometree.otype_name = otype_name; To.Outcometree.otype_params = (List.map (fun x -> let (x0,x1) = x in (x0, (let (x0,x1) = x1 in ((copy_bool x0), (copy_bool x1))))) otype_params); To.Outcometree.otype_type = (copy_out_type otype_type); To.Outcometree.otype_private = (copy_From_Asttypes_private_flag otype_private); To.Outcometree.otype_immediate = (copy_bool otype_immediate); To.Outcometree.otype_unboxed = (copy_bool otype_unboxed); To.Outcometree.otype_cstrs = (List.map (fun x -> let (x0,x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type = function | From.Outcometree.Omty_abstract -> To.Outcometree.Omty_abstract | From.Outcometree.Omty_functor (x0,x1,x2) -> To.Outcometree.Omty_functor (x0, (copy_option copy_out_module_type x1), (copy_out_module_type x2)) | From.Outcometree.Omty_ident x0 -> To.Outcometree.Omty_ident (copy_out_ident x0) | From.Outcometree.Omty_signature x0 -> To.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | From.Outcometree.Omty_alias x0 -> To.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : From.Outcometree.out_ext_status -> To.Outcometree.out_ext_status = function | From.Outcometree.Oext_first -> To.Outcometree.Oext_first | From.Outcometree.Oext_next -> To.Outcometree.Oext_next | From.Outcometree.Oext_exception -> To.Outcometree.Oext_exception and copy_out_extension_constructor : From.Outcometree.out_extension_constructor -> To.Outcometree.out_extension_constructor = fun { From.Outcometree.oext_name = oext_name; From.Outcometree.oext_type_name = oext_type_name; From.Outcometree.oext_type_params = oext_type_params; From.Outcometree.oext_args = oext_args; From.Outcometree.oext_ret_type = oext_ret_type; From.Outcometree.oext_private = oext_private } -> { To.Outcometree.oext_name = oext_name; To.Outcometree.oext_type_name = oext_type_name; To.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); To.Outcometree.oext_args = (List.map copy_out_type oext_args); To.Outcometree.oext_ret_type = (copy_option copy_out_type oext_ret_type); To.Outcometree.oext_private = (copy_From_Asttypes_private_flag oext_private) } and copy_From_Asttypes_private_flag : From.Asttypes.private_flag -> To.Asttypes.private_flag = function | From.Asttypes.Private -> To.Asttypes.Private | From.Asttypes.Public -> To.Asttypes.Public and copy_out_rec_status : From.Outcometree.out_rec_status -> To.Outcometree.out_rec_status = function | From.Outcometree.Orec_not -> To.Outcometree.Orec_not | From.Outcometree.Orec_first -> To.Outcometree.Orec_first | From.Outcometree.Orec_next -> To.Outcometree.Orec_next and copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type = function | From.Outcometree.Octy_constr (x0,x1) -> To.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Octy_arrow (x0,x1,x2) -> To.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | From.Outcometree.Octy_signature (x0,x1) -> To.Outcometree.Octy_signature ((copy_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : From.Outcometree.out_class_sig_item -> To.Outcometree.out_class_sig_item = function | From.Outcometree.Ocsg_constraint (x0,x1) -> To.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Ocsg_method (x0,x1,x2,x3) -> To.Outcometree.Ocsg_method (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) | From.Outcometree.Ocsg_value (x0,x1,x2,x3) -> To.Outcometree.Ocsg_value (x0, (copy_bool x1), (copy_bool x2), (copy_out_type x3)) and copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type = function | From.Outcometree.Otyp_abstract -> To.Outcometree.Otyp_abstract | From.Outcometree.Otyp_open -> To.Outcometree.Otyp_open | From.Outcometree.Otyp_alias (x0,x1) -> To.Outcometree.Otyp_alias ((copy_out_type x0), x1) | From.Outcometree.Otyp_arrow (x0,x1,x2) -> To.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | From.Outcometree.Otyp_class (x0,x1,x2) -> To.Outcometree.Otyp_class ((copy_bool x0), (copy_out_ident x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_constr (x0,x1) -> To.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | From.Outcometree.Otyp_manifest (x0,x1) -> To.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | From.Outcometree.Otyp_object (x0,x1) -> To.Outcometree.Otyp_object ((List.map (fun x -> let (x0,x1) = x in (x0, (copy_out_type x1))) x0), (copy_option copy_bool x1)) | From.Outcometree.Otyp_record x0 -> To.Outcometree.Otyp_record (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (copy_out_type x2))) x0) | From.Outcometree.Otyp_stuff x0 -> To.Outcometree.Otyp_stuff x0 | From.Outcometree.Otyp_sum x0 -> To.Outcometree.Otyp_sum (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) x0) | From.Outcometree.Otyp_tuple x0 -> To.Outcometree.Otyp_tuple (List.map copy_out_type x0) | From.Outcometree.Otyp_var (x0,x1) -> To.Outcometree.Otyp_var ((copy_bool x0), x1) | From.Outcometree.Otyp_variant (x0,x1,x2,x3) -> To.Outcometree.Otyp_variant ((copy_bool x0), (copy_out_variant x1), (copy_bool x2), (copy_option (fun x -> List.map (fun x -> x) x) x3)) | From.Outcometree.Otyp_poly (x0,x1) -> To.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | From.Outcometree.Otyp_module (x0,x1,x2) -> To.Outcometree.Otyp_module ((match x0 with | Oide_ident id -> id.From.Outcometree.printed_name | From.Outcometree.Oide_apply _ | From.Outcometree.Oide_dot _ -> migration_error Location.none Def.Otyp_module), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | From.Outcometree.Otyp_attribute (x0,x1) -> To.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_string : From.Outcometree.out_string -> To.Outcometree.out_string = function | From.Outcometree.Ostr_string -> To.Outcometree.Ostr_string | From.Outcometree.Ostr_bytes -> To.Outcometree.Ostr_bytes and copy_out_attribute : From.Outcometree.out_attribute -> To.Outcometree.out_attribute = fun { From.Outcometree.oattr_name = oattr_name } -> { To.Outcometree.oattr_name = oattr_name } and copy_out_variant : From.Outcometree.out_variant -> To.Outcometree.out_variant = function | From.Outcometree.Ovar_fields x0 -> To.Outcometree.Ovar_fields (List.map (fun x -> let (x0,x1,x2) = x in (x0, (copy_bool x1), (List.map copy_out_type x2))) x0) | From.Outcometree.Ovar_typ x0 -> To.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value = function | From.Outcometree.Oval_array x0 -> To.Outcometree.Oval_array (List.map copy_out_value x0) | From.Outcometree.Oval_char x0 -> To.Outcometree.Oval_char x0 | From.Outcometree.Oval_constr (x0,x1) -> To.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | From.Outcometree.Oval_ellipsis -> To.Outcometree.Oval_ellipsis | From.Outcometree.Oval_float x0 -> To.Outcometree.Oval_float (copy_float x0) | From.Outcometree.Oval_int x0 -> To.Outcometree.Oval_int x0 | From.Outcometree.Oval_int32 x0 -> To.Outcometree.Oval_int32 x0 | From.Outcometree.Oval_int64 x0 -> To.Outcometree.Oval_int64 x0 | From.Outcometree.Oval_nativeint x0 -> To.Outcometree.Oval_nativeint x0 | From.Outcometree.Oval_list x0 -> To.Outcometree.Oval_list (List.map copy_out_value x0) | From.Outcometree.Oval_printer x0 -> To.Outcometree.Oval_printer x0 | From.Outcometree.Oval_record x0 -> To.Outcometree.Oval_record (List.map (fun x -> let (x0,x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | From.Outcometree.Oval_string (x0, x1, x2) -> To.Outcometree.Oval_string (x0, x1, copy_out_string x2) | From.Outcometree.Oval_stuff x0 -> To.Outcometree.Oval_stuff x0 | From.Outcometree.Oval_tuple x0 -> To.Outcometree.Oval_tuple (List.map copy_out_value x0) | From.Outcometree.Oval_variant (x0,x1) -> To.Outcometree.Oval_variant (x0, (copy_option copy_out_value x1)) and copy_float : float -> float = fun x -> x and copy_out_ident : From.Outcometree.out_ident -> To.Outcometree.out_ident = function | From.Outcometree.Oide_apply (x0,x1) -> To.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | From.Outcometree.Oide_dot (x0,x1) -> To.Outcometree.Oide_dot ((copy_out_ident x0), x1) | From.Outcometree.Oide_ident x0 -> To.Outcometree.Oide_ident x0.From.Outcometree.printed_name let copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension = fun { From.Outcometree.otyext_name = otyext_name; From.Outcometree.otyext_params = otyext_params; From.Outcometree.otyext_constructors = otyext_constructors; From.Outcometree.otyext_private = otyext_private } -> { To.Outcometree.otyext_name = otyext_name; To.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); To.Outcometree.otyext_constructors = (List.map (fun x -> let (x0,x1,x2) = x in (x0, (List.map copy_out_type x1), (copy_option copy_out_type x2))) otyext_constructors); To.Outcometree.otyext_private = (copy_private_flag otyext_private) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_408_409.ml000066400000000000000000000171161356450464700240640ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_408_409_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload"; "binding_op"; "module_substitution"; "open_declaration"; "type_exception" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; binding_op; module_substitution; open_declaration; type_exception; (*$*) } as mapper) -> let module Def = Migrate_parsetree_def in let module R = Migrate_parsetree_409_408_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_408_409_migrate.ml000066400000000000000000001764561356450464700256110ustar00rootroot00000000000000open Stdlib0 module From = Ast_408 module To = Ast_409 let rec copy_out_type_extension : Ast_408.Outcometree.out_type_extension -> Ast_409.Outcometree.out_type_extension = fun { Ast_408.Outcometree.otyext_name = otyext_name; Ast_408.Outcometree.otyext_params = otyext_params; Ast_408.Outcometree.otyext_constructors = otyext_constructors; Ast_408.Outcometree.otyext_private = otyext_private } -> { Ast_409.Outcometree.otyext_name = otyext_name; Ast_409.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); Ast_409.Outcometree.otyext_constructors = (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (Option.map copy_out_type x2))) otyext_constructors); Ast_409.Outcometree.otyext_private = (copy_private_flag otyext_private) } and copy_out_phrase : Ast_408.Outcometree.out_phrase -> Ast_409.Outcometree.out_phrase = function | Ast_408.Outcometree.Ophr_eval (x0, x1) -> Ast_409.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | Ast_408.Outcometree.Ophr_signature x0 -> Ast_409.Outcometree.Ophr_signature (List.map (fun x -> let (x0, x1) = x in ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) | Ast_408.Outcometree.Ophr_exception x0 -> Ast_409.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : Ast_408.Outcometree.out_sig_item -> Ast_409.Outcometree.out_sig_item = function | Ast_408.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> Ast_409.Outcometree.Osig_class (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_408.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> Ast_409.Outcometree.Osig_class_type (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_408.Outcometree.Osig_typext (x0, x1) -> Ast_409.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | Ast_408.Outcometree.Osig_modtype (x0, x1) -> Ast_409.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | Ast_408.Outcometree.Osig_module (x0, x1, x2) -> Ast_409.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | Ast_408.Outcometree.Osig_type (x0, x1) -> Ast_409.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | Ast_408.Outcometree.Osig_value x0 -> Ast_409.Outcometree.Osig_value (copy_out_val_decl x0) | Ast_408.Outcometree.Osig_ellipsis -> Ast_409.Outcometree.Osig_ellipsis and copy_out_val_decl : Ast_408.Outcometree.out_val_decl -> Ast_409.Outcometree.out_val_decl = fun { Ast_408.Outcometree.oval_name = oval_name; Ast_408.Outcometree.oval_type = oval_type; Ast_408.Outcometree.oval_prims = oval_prims; Ast_408.Outcometree.oval_attributes = oval_attributes } -> { Ast_409.Outcometree.oval_name = oval_name; Ast_409.Outcometree.oval_type = (copy_out_type oval_type); Ast_409.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); Ast_409.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : Ast_408.Outcometree.out_type_decl -> Ast_409.Outcometree.out_type_decl = fun { Ast_408.Outcometree.otype_name = otype_name; Ast_408.Outcometree.otype_params = otype_params; Ast_408.Outcometree.otype_type = otype_type; Ast_408.Outcometree.otype_private = otype_private; Ast_408.Outcometree.otype_immediate = otype_immediate; Ast_408.Outcometree.otype_unboxed = otype_unboxed; Ast_408.Outcometree.otype_cstrs = otype_cstrs } -> { Ast_409.Outcometree.otype_name = otype_name; Ast_409.Outcometree.otype_params = (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) otype_params); Ast_409.Outcometree.otype_type = (copy_out_type otype_type); Ast_409.Outcometree.otype_private = (copy_private_flag otype_private); Ast_409.Outcometree.otype_immediate = otype_immediate; Ast_409.Outcometree.otype_unboxed = otype_unboxed; Ast_409.Outcometree.otype_cstrs = (List.map (fun x -> let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : Ast_408.Outcometree.out_module_type -> Ast_409.Outcometree.out_module_type = function | Ast_408.Outcometree.Omty_abstract -> Ast_409.Outcometree.Omty_abstract | Ast_408.Outcometree.Omty_functor (x0, x1, x2) -> Ast_409.Outcometree.Omty_functor (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) | Ast_408.Outcometree.Omty_ident x0 -> Ast_409.Outcometree.Omty_ident (copy_out_ident x0) | Ast_408.Outcometree.Omty_signature x0 -> Ast_409.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | Ast_408.Outcometree.Omty_alias x0 -> Ast_409.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : Ast_408.Outcometree.out_ext_status -> Ast_409.Outcometree.out_ext_status = function | Ast_408.Outcometree.Oext_first -> Ast_409.Outcometree.Oext_first | Ast_408.Outcometree.Oext_next -> Ast_409.Outcometree.Oext_next | Ast_408.Outcometree.Oext_exception -> Ast_409.Outcometree.Oext_exception and copy_out_extension_constructor : Ast_408.Outcometree.out_extension_constructor -> Ast_409.Outcometree.out_extension_constructor = fun { Ast_408.Outcometree.oext_name = oext_name; Ast_408.Outcometree.oext_type_name = oext_type_name; Ast_408.Outcometree.oext_type_params = oext_type_params; Ast_408.Outcometree.oext_args = oext_args; Ast_408.Outcometree.oext_ret_type = oext_ret_type; Ast_408.Outcometree.oext_private = oext_private } -> { Ast_409.Outcometree.oext_name = oext_name; Ast_409.Outcometree.oext_type_name = oext_type_name; Ast_409.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); Ast_409.Outcometree.oext_args = (List.map copy_out_type oext_args); Ast_409.Outcometree.oext_ret_type = (Option.map copy_out_type oext_ret_type); Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) } and copy_out_rec_status : Ast_408.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = function | Ast_408.Outcometree.Orec_not -> Ast_409.Outcometree.Orec_not | Ast_408.Outcometree.Orec_first -> Ast_409.Outcometree.Orec_first | Ast_408.Outcometree.Orec_next -> Ast_409.Outcometree.Orec_next and copy_out_class_type : Ast_408.Outcometree.out_class_type -> Ast_409.Outcometree.out_class_type = function | Ast_408.Outcometree.Octy_constr (x0, x1) -> Ast_409.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_408.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_409.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | Ast_408.Outcometree.Octy_signature (x0, x1) -> Ast_409.Outcometree.Octy_signature ((Option.map copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : Ast_408.Outcometree.out_class_sig_item -> Ast_409.Outcometree.out_class_sig_item = function | Ast_408.Outcometree.Ocsg_constraint (x0, x1) -> Ast_409.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | Ast_408.Outcometree.Ocsg_method (x0, x1, x2, x3) -> Ast_409.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) | Ast_408.Outcometree.Ocsg_value (x0, x1, x2, x3) -> Ast_409.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) and copy_out_type : Ast_408.Outcometree.out_type -> Ast_409.Outcometree.out_type = function | Ast_408.Outcometree.Otyp_abstract -> Ast_409.Outcometree.Otyp_abstract | Ast_408.Outcometree.Otyp_open -> Ast_409.Outcometree.Otyp_open | Ast_408.Outcometree.Otyp_alias (x0, x1) -> Ast_409.Outcometree.Otyp_alias ((copy_out_type x0), x1) | Ast_408.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_409.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | Ast_408.Outcometree.Otyp_class (x0, x1, x2) -> Ast_409.Outcometree.Otyp_class (x0, (copy_out_ident x1), (List.map copy_out_type x2)) | Ast_408.Outcometree.Otyp_constr (x0, x1) -> Ast_409.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_408.Outcometree.Otyp_manifest (x0, x1) -> Ast_409.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | Ast_408.Outcometree.Otyp_object (x0, x1) -> Ast_409.Outcometree.Otyp_object ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), (Option.map (fun x -> x) x1)) | Ast_408.Outcometree.Otyp_record x0 -> Ast_409.Outcometree.Otyp_record (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) | Ast_408.Outcometree.Otyp_stuff x0 -> Ast_409.Outcometree.Otyp_stuff x0 | Ast_408.Outcometree.Otyp_sum x0 -> Ast_409.Outcometree.Otyp_sum (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (Option.map copy_out_type x2))) x0) | Ast_408.Outcometree.Otyp_tuple x0 -> Ast_409.Outcometree.Otyp_tuple (List.map copy_out_type x0) | Ast_408.Outcometree.Otyp_var (x0, x1) -> Ast_409.Outcometree.Otyp_var (x0, x1) | Ast_408.Outcometree.Otyp_variant (x0, x1, x2, x3) -> Ast_409.Outcometree.Otyp_variant (x0, (copy_out_variant x1), x2, (Option.map (fun x -> List.map (fun x -> x) x) x3)) | Ast_408.Outcometree.Otyp_poly (x0, x1) -> Ast_409.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | Ast_408.Outcometree.Otyp_module (x0, x1, x2) -> Ast_409.Outcometree.Otyp_module ((copy_out_ident x0), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | Ast_408.Outcometree.Otyp_attribute (x0, x1) -> Ast_409.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : Ast_408.Outcometree.out_attribute -> Ast_409.Outcometree.out_attribute = fun { Ast_408.Outcometree.oattr_name = oattr_name } -> { Ast_409.Outcometree.oattr_name = oattr_name } and copy_out_variant : Ast_408.Outcometree.out_variant -> Ast_409.Outcometree.out_variant = function | Ast_408.Outcometree.Ovar_fields x0 -> Ast_409.Outcometree.Ovar_fields (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) x0) | Ast_408.Outcometree.Ovar_typ x0 -> Ast_409.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : Ast_408.Outcometree.out_value -> Ast_409.Outcometree.out_value = function | Ast_408.Outcometree.Oval_array x0 -> Ast_409.Outcometree.Oval_array (List.map copy_out_value x0) | Ast_408.Outcometree.Oval_char x0 -> Ast_409.Outcometree.Oval_char x0 | Ast_408.Outcometree.Oval_constr (x0, x1) -> Ast_409.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | Ast_408.Outcometree.Oval_ellipsis -> Ast_409.Outcometree.Oval_ellipsis | Ast_408.Outcometree.Oval_float x0 -> Ast_409.Outcometree.Oval_float x0 | Ast_408.Outcometree.Oval_int x0 -> Ast_409.Outcometree.Oval_int x0 | Ast_408.Outcometree.Oval_int32 x0 -> Ast_409.Outcometree.Oval_int32 x0 | Ast_408.Outcometree.Oval_int64 x0 -> Ast_409.Outcometree.Oval_int64 x0 | Ast_408.Outcometree.Oval_nativeint x0 -> Ast_409.Outcometree.Oval_nativeint x0 | Ast_408.Outcometree.Oval_list x0 -> Ast_409.Outcometree.Oval_list (List.map copy_out_value x0) | Ast_408.Outcometree.Oval_printer x0 -> Ast_409.Outcometree.Oval_printer x0 | Ast_408.Outcometree.Oval_record x0 -> Ast_409.Outcometree.Oval_record (List.map (fun x -> let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | Ast_408.Outcometree.Oval_string (x0, x1, x2) -> Ast_409.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) | Ast_408.Outcometree.Oval_stuff x0 -> Ast_409.Outcometree.Oval_stuff x0 | Ast_408.Outcometree.Oval_tuple x0 -> Ast_409.Outcometree.Oval_tuple (List.map copy_out_value x0) | Ast_408.Outcometree.Oval_variant (x0, x1) -> Ast_409.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) and copy_out_string : Ast_408.Outcometree.out_string -> Ast_409.Outcometree.out_string = function | Ast_408.Outcometree.Ostr_string -> Ast_409.Outcometree.Ostr_string | Ast_408.Outcometree.Ostr_bytes -> Ast_409.Outcometree.Ostr_bytes and copy_out_ident : Ast_408.Outcometree.out_ident -> Ast_409.Outcometree.out_ident = function | Ast_408.Outcometree.Oide_apply (x0, x1) -> Ast_409.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | Ast_408.Outcometree.Oide_dot (x0, x1) -> Ast_409.Outcometree.Oide_dot ((copy_out_ident x0), x1) | Ast_408.Outcometree.Oide_ident x0 -> Ast_409.Outcometree.Oide_ident (copy_out_name x0) and copy_out_name : Ast_408.Outcometree.out_name -> Ast_409.Outcometree.out_name = fun { Ast_408.Outcometree.printed_name = printed_name } -> { Ast_409.Outcometree.printed_name = printed_name } and copy_toplevel_phrase : Ast_408.Parsetree.toplevel_phrase -> Ast_409.Parsetree.toplevel_phrase = function | Ast_408.Parsetree.Ptop_def x0 -> Ast_409.Parsetree.Ptop_def (copy_structure x0) | Ast_408.Parsetree.Ptop_dir x0 -> Ast_409.Parsetree.Ptop_dir (copy_toplevel_directive x0) and copy_toplevel_directive : Ast_408.Parsetree.toplevel_directive -> Ast_409.Parsetree.toplevel_directive = fun { Ast_408.Parsetree.pdir_name = pdir_name; Ast_408.Parsetree.pdir_arg = pdir_arg; Ast_408.Parsetree.pdir_loc = pdir_loc } -> { Ast_409.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); Ast_409.Parsetree.pdir_arg = (Option.map copy_directive_argument pdir_arg); Ast_409.Parsetree.pdir_loc = (copy_location pdir_loc) } and copy_directive_argument : Ast_408.Parsetree.directive_argument -> Ast_409.Parsetree.directive_argument = fun { Ast_408.Parsetree.pdira_desc = pdira_desc; Ast_408.Parsetree.pdira_loc = pdira_loc } -> { Ast_409.Parsetree.pdira_desc = (copy_directive_argument_desc pdira_desc); Ast_409.Parsetree.pdira_loc = (copy_location pdira_loc) } and copy_directive_argument_desc : Ast_408.Parsetree.directive_argument_desc -> Ast_409.Parsetree.directive_argument_desc = function | Ast_408.Parsetree.Pdir_string x0 -> Ast_409.Parsetree.Pdir_string x0 | Ast_408.Parsetree.Pdir_int (x0, x1) -> Ast_409.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) | Ast_408.Parsetree.Pdir_ident x0 -> Ast_409.Parsetree.Pdir_ident (copy_Longident_t x0) | Ast_408.Parsetree.Pdir_bool x0 -> Ast_409.Parsetree.Pdir_bool x0 and copy_typ : Ast_408.Parsetree.typ -> Ast_409.Parsetree.typ = fun x -> copy_core_type x and copy_pat : Ast_408.Parsetree.pat -> Ast_409.Parsetree.pat = fun x -> copy_pattern x and copy_expr : Ast_408.Parsetree.expr -> Ast_409.Parsetree.expr = fun x -> copy_expression x and copy_expression : Ast_408.Parsetree.expression -> Ast_409.Parsetree.expression = fun { Ast_408.Parsetree.pexp_desc = pexp_desc; Ast_408.Parsetree.pexp_loc = pexp_loc; Ast_408.Parsetree.pexp_loc_stack = pexp_loc_stack; Ast_408.Parsetree.pexp_attributes = pexp_attributes } -> { Ast_409.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); Ast_409.Parsetree.pexp_loc = (copy_location pexp_loc); Ast_409.Parsetree.pexp_loc_stack = (List.map copy_location pexp_loc_stack); Ast_409.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : Ast_408.Parsetree.expression_desc -> Ast_409.Parsetree.expression_desc = function | Ast_408.Parsetree.Pexp_ident x0 -> Ast_409.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) | Ast_408.Parsetree.Pexp_constant x0 -> Ast_409.Parsetree.Pexp_constant (copy_constant x0) | Ast_408.Parsetree.Pexp_let (x0, x1, x2) -> Ast_409.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | Ast_408.Parsetree.Pexp_function x0 -> Ast_409.Parsetree.Pexp_function (copy_cases x0) | Ast_408.Parsetree.Pexp_fun (x0, x1, x2, x3) -> Ast_409.Parsetree.Pexp_fun ((copy_arg_label x0), (Option.map copy_expression x1), (copy_pattern x2), (copy_expression x3)) | Ast_408.Parsetree.Pexp_apply (x0, x1) -> Ast_409.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_408.Parsetree.Pexp_match (x0, x1) -> Ast_409.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) | Ast_408.Parsetree.Pexp_try (x0, x1) -> Ast_409.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) | Ast_408.Parsetree.Pexp_tuple x0 -> Ast_409.Parsetree.Pexp_tuple (List.map copy_expression x0) | Ast_408.Parsetree.Pexp_construct (x0, x1) -> Ast_409.Parsetree.Pexp_construct ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) | Ast_408.Parsetree.Pexp_variant (x0, x1) -> Ast_409.Parsetree.Pexp_variant ((copy_label x0), (Option.map copy_expression x1)) | Ast_408.Parsetree.Pexp_record (x0, x1) -> Ast_409.Parsetree.Pexp_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), (Option.map copy_expression x1)) | Ast_408.Parsetree.Pexp_field (x0, x1) -> Ast_409.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_Longident_t x1)) | Ast_408.Parsetree.Pexp_setfield (x0, x1, x2) -> Ast_409.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_Longident_t x1), (copy_expression x2)) | Ast_408.Parsetree.Pexp_array x0 -> Ast_409.Parsetree.Pexp_array (List.map copy_expression x0) | Ast_408.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> Ast_409.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (Option.map copy_expression x2)) | Ast_408.Parsetree.Pexp_sequence (x0, x1) -> Ast_409.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_while (x0, x1) -> Ast_409.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> Ast_409.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | Ast_408.Parsetree.Pexp_constraint (x0, x1) -> Ast_409.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | Ast_408.Parsetree.Pexp_coerce (x0, x1, x2) -> Ast_409.Parsetree.Pexp_coerce ((copy_expression x0), (Option.map copy_core_type x1), (copy_core_type x2)) | Ast_408.Parsetree.Pexp_send (x0, x1) -> Ast_409.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | Ast_408.Parsetree.Pexp_new x0 -> Ast_409.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) | Ast_408.Parsetree.Pexp_setinstvar (x0, x1) -> Ast_409.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_override x0 -> Ast_409.Parsetree.Pexp_override (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | Ast_408.Parsetree.Pexp_letmodule (x0, x1, x2) -> Ast_409.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | Ast_408.Parsetree.Pexp_letexception (x0, x1) -> Ast_409.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_assert x0 -> Ast_409.Parsetree.Pexp_assert (copy_expression x0) | Ast_408.Parsetree.Pexp_lazy x0 -> Ast_409.Parsetree.Pexp_lazy (copy_expression x0) | Ast_408.Parsetree.Pexp_poly (x0, x1) -> Ast_409.Parsetree.Pexp_poly ((copy_expression x0), (Option.map copy_core_type x1)) | Ast_408.Parsetree.Pexp_object x0 -> Ast_409.Parsetree.Pexp_object (copy_class_structure x0) | Ast_408.Parsetree.Pexp_newtype (x0, x1) -> Ast_409.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_pack x0 -> Ast_409.Parsetree.Pexp_pack (copy_module_expr x0) | Ast_408.Parsetree.Pexp_open (x0, x1) -> Ast_409.Parsetree.Pexp_open ((copy_open_declaration x0), (copy_expression x1)) | Ast_408.Parsetree.Pexp_letop x0 -> Ast_409.Parsetree.Pexp_letop (copy_letop x0) | Ast_408.Parsetree.Pexp_extension x0 -> Ast_409.Parsetree.Pexp_extension (copy_extension x0) | Ast_408.Parsetree.Pexp_unreachable -> Ast_409.Parsetree.Pexp_unreachable and copy_letop : Ast_408.Parsetree.letop -> Ast_409.Parsetree.letop = fun { Ast_408.Parsetree.let_ = let_; Ast_408.Parsetree.ands = ands; Ast_408.Parsetree.body = body } -> { Ast_409.Parsetree.let_ = (copy_binding_op let_); Ast_409.Parsetree.ands = (List.map copy_binding_op ands); Ast_409.Parsetree.body = (copy_expression body) } and copy_binding_op : Ast_408.Parsetree.binding_op -> Ast_409.Parsetree.binding_op = fun { Ast_408.Parsetree.pbop_op = pbop_op; Ast_408.Parsetree.pbop_pat = pbop_pat; Ast_408.Parsetree.pbop_exp = pbop_exp; Ast_408.Parsetree.pbop_loc = pbop_loc } -> { Ast_409.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); Ast_409.Parsetree.pbop_pat = (copy_pattern pbop_pat); Ast_409.Parsetree.pbop_exp = (copy_expression pbop_exp); Ast_409.Parsetree.pbop_loc = (copy_location pbop_loc) } and copy_direction_flag : Ast_408.Asttypes.direction_flag -> Ast_409.Asttypes.direction_flag = function | Ast_408.Asttypes.Upto -> Ast_409.Asttypes.Upto | Ast_408.Asttypes.Downto -> Ast_409.Asttypes.Downto and copy_cases : Ast_408.Parsetree.cases -> Ast_409.Parsetree.cases = fun x -> List.map copy_case x and copy_case : Ast_408.Parsetree.case -> Ast_409.Parsetree.case = fun { Ast_408.Parsetree.pc_lhs = pc_lhs; Ast_408.Parsetree.pc_guard = pc_guard; Ast_408.Parsetree.pc_rhs = pc_rhs } -> { Ast_409.Parsetree.pc_lhs = (copy_pattern pc_lhs); Ast_409.Parsetree.pc_guard = (Option.map copy_expression pc_guard); Ast_409.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : Ast_408.Parsetree.value_binding -> Ast_409.Parsetree.value_binding = fun { Ast_408.Parsetree.pvb_pat = pvb_pat; Ast_408.Parsetree.pvb_expr = pvb_expr; Ast_408.Parsetree.pvb_attributes = pvb_attributes; Ast_408.Parsetree.pvb_loc = pvb_loc } -> { Ast_409.Parsetree.pvb_pat = (copy_pattern pvb_pat); Ast_409.Parsetree.pvb_expr = (copy_expression pvb_expr); Ast_409.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); Ast_409.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : Ast_408.Parsetree.pattern -> Ast_409.Parsetree.pattern = fun { Ast_408.Parsetree.ppat_desc = ppat_desc; Ast_408.Parsetree.ppat_loc = ppat_loc; Ast_408.Parsetree.ppat_loc_stack = ppat_loc_stack; Ast_408.Parsetree.ppat_attributes = ppat_attributes } -> { Ast_409.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); Ast_409.Parsetree.ppat_loc = (copy_location ppat_loc); Ast_409.Parsetree.ppat_loc_stack = (List.map copy_location ppat_loc_stack); Ast_409.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : Ast_408.Parsetree.pattern_desc -> Ast_409.Parsetree.pattern_desc = function | Ast_408.Parsetree.Ppat_any -> Ast_409.Parsetree.Ppat_any | Ast_408.Parsetree.Ppat_var x0 -> Ast_409.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | Ast_408.Parsetree.Ppat_alias (x0, x1) -> Ast_409.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | Ast_408.Parsetree.Ppat_constant x0 -> Ast_409.Parsetree.Ppat_constant (copy_constant x0) | Ast_408.Parsetree.Ppat_interval (x0, x1) -> Ast_409.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | Ast_408.Parsetree.Ppat_tuple x0 -> Ast_409.Parsetree.Ppat_tuple (List.map copy_pattern x0) | Ast_408.Parsetree.Ppat_construct (x0, x1) -> Ast_409.Parsetree.Ppat_construct ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) | Ast_408.Parsetree.Ppat_variant (x0, x1) -> Ast_409.Parsetree.Ppat_variant ((copy_label x0), (Option.map copy_pattern x1)) | Ast_408.Parsetree.Ppat_record (x0, x1) -> Ast_409.Parsetree.Ppat_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | Ast_408.Parsetree.Ppat_array x0 -> Ast_409.Parsetree.Ppat_array (List.map copy_pattern x0) | Ast_408.Parsetree.Ppat_or (x0, x1) -> Ast_409.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | Ast_408.Parsetree.Ppat_constraint (x0, x1) -> Ast_409.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | Ast_408.Parsetree.Ppat_type x0 -> Ast_409.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) | Ast_408.Parsetree.Ppat_lazy x0 -> Ast_409.Parsetree.Ppat_lazy (copy_pattern x0) | Ast_408.Parsetree.Ppat_unpack x0 -> Ast_409.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | Ast_408.Parsetree.Ppat_exception x0 -> Ast_409.Parsetree.Ppat_exception (copy_pattern x0) | Ast_408.Parsetree.Ppat_extension x0 -> Ast_409.Parsetree.Ppat_extension (copy_extension x0) | Ast_408.Parsetree.Ppat_open (x0, x1) -> Ast_409.Parsetree.Ppat_open ((copy_loc copy_Longident_t x0), (copy_pattern x1)) and copy_core_type : Ast_408.Parsetree.core_type -> Ast_409.Parsetree.core_type = fun { Ast_408.Parsetree.ptyp_desc = ptyp_desc; Ast_408.Parsetree.ptyp_loc = ptyp_loc; Ast_408.Parsetree.ptyp_loc_stack = ptyp_loc_stack; Ast_408.Parsetree.ptyp_attributes = ptyp_attributes } -> { Ast_409.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); Ast_409.Parsetree.ptyp_loc = (copy_location ptyp_loc); Ast_409.Parsetree.ptyp_loc_stack = (List.map copy_location ptyp_loc_stack); Ast_409.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : Ast_408.Parsetree.core_type_desc -> Ast_409.Parsetree.core_type_desc = function | Ast_408.Parsetree.Ptyp_any -> Ast_409.Parsetree.Ptyp_any | Ast_408.Parsetree.Ptyp_var x0 -> Ast_409.Parsetree.Ptyp_var x0 | Ast_408.Parsetree.Ptyp_arrow (x0, x1, x2) -> Ast_409.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | Ast_408.Parsetree.Ptyp_tuple x0 -> Ast_409.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | Ast_408.Parsetree.Ptyp_constr (x0, x1) -> Ast_409.Parsetree.Ptyp_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_408.Parsetree.Ptyp_object (x0, x1) -> Ast_409.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | Ast_408.Parsetree.Ptyp_class (x0, x1) -> Ast_409.Parsetree.Ptyp_class ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_408.Parsetree.Ptyp_alias (x0, x1) -> Ast_409.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | Ast_408.Parsetree.Ptyp_variant (x0, x1, x2) -> Ast_409.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (Option.map (fun x -> List.map copy_label x) x2)) | Ast_408.Parsetree.Ptyp_poly (x0, x1) -> Ast_409.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | Ast_408.Parsetree.Ptyp_package x0 -> Ast_409.Parsetree.Ptyp_package (copy_package_type x0) | Ast_408.Parsetree.Ptyp_extension x0 -> Ast_409.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : Ast_408.Parsetree.package_type -> Ast_409.Parsetree.package_type = fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) and copy_row_field : Ast_408.Parsetree.row_field -> Ast_409.Parsetree.row_field = fun { Ast_408.Parsetree.prf_desc = prf_desc; Ast_408.Parsetree.prf_loc = prf_loc; Ast_408.Parsetree.prf_attributes = prf_attributes } -> { Ast_409.Parsetree.prf_desc = (copy_row_field_desc prf_desc); Ast_409.Parsetree.prf_loc = (copy_location prf_loc); Ast_409.Parsetree.prf_attributes = (copy_attributes prf_attributes) } and copy_row_field_desc : Ast_408.Parsetree.row_field_desc -> Ast_409.Parsetree.row_field_desc = function | Ast_408.Parsetree.Rtag (x0, x1, x2) -> Ast_409.Parsetree.Rtag ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) | Ast_408.Parsetree.Rinherit x0 -> Ast_409.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : Ast_408.Parsetree.object_field -> Ast_409.Parsetree.object_field = fun { Ast_408.Parsetree.pof_desc = pof_desc; Ast_408.Parsetree.pof_loc = pof_loc; Ast_408.Parsetree.pof_attributes = pof_attributes } -> { Ast_409.Parsetree.pof_desc = (copy_object_field_desc pof_desc); Ast_409.Parsetree.pof_loc = (copy_location pof_loc); Ast_409.Parsetree.pof_attributes = (copy_attributes pof_attributes) } and copy_attributes : Ast_408.Parsetree.attributes -> Ast_409.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : Ast_408.Parsetree.attribute -> Ast_409.Parsetree.attribute = fun { Ast_408.Parsetree.attr_name = attr_name; Ast_408.Parsetree.attr_payload = attr_payload; Ast_408.Parsetree.attr_loc = attr_loc } -> { Ast_409.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); Ast_409.Parsetree.attr_payload = (copy_payload attr_payload); Ast_409.Parsetree.attr_loc = (copy_location attr_loc) } and copy_payload : Ast_408.Parsetree.payload -> Ast_409.Parsetree.payload = function | Ast_408.Parsetree.PStr x0 -> Ast_409.Parsetree.PStr (copy_structure x0) | Ast_408.Parsetree.PSig x0 -> Ast_409.Parsetree.PSig (copy_signature x0) | Ast_408.Parsetree.PTyp x0 -> Ast_409.Parsetree.PTyp (copy_core_type x0) | Ast_408.Parsetree.PPat (x0, x1) -> Ast_409.Parsetree.PPat ((copy_pattern x0), (Option.map copy_expression x1)) and copy_structure : Ast_408.Parsetree.structure -> Ast_409.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : Ast_408.Parsetree.structure_item -> Ast_409.Parsetree.structure_item = fun { Ast_408.Parsetree.pstr_desc = pstr_desc; Ast_408.Parsetree.pstr_loc = pstr_loc } -> { Ast_409.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); Ast_409.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : Ast_408.Parsetree.structure_item_desc -> Ast_409.Parsetree.structure_item_desc = function | Ast_408.Parsetree.Pstr_eval (x0, x1) -> Ast_409.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | Ast_408.Parsetree.Pstr_value (x0, x1) -> Ast_409.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | Ast_408.Parsetree.Pstr_primitive x0 -> Ast_409.Parsetree.Pstr_primitive (copy_value_description x0) | Ast_408.Parsetree.Pstr_type (x0, x1) -> Ast_409.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_408.Parsetree.Pstr_typext x0 -> Ast_409.Parsetree.Pstr_typext (copy_type_extension x0) | Ast_408.Parsetree.Pstr_exception x0 -> Ast_409.Parsetree.Pstr_exception (copy_type_exception x0) | Ast_408.Parsetree.Pstr_module x0 -> Ast_409.Parsetree.Pstr_module (copy_module_binding x0) | Ast_408.Parsetree.Pstr_recmodule x0 -> Ast_409.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | Ast_408.Parsetree.Pstr_modtype x0 -> Ast_409.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | Ast_408.Parsetree.Pstr_open x0 -> Ast_409.Parsetree.Pstr_open (copy_open_declaration x0) | Ast_408.Parsetree.Pstr_class x0 -> Ast_409.Parsetree.Pstr_class (List.map copy_class_declaration x0) | Ast_408.Parsetree.Pstr_class_type x0 -> Ast_409.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | Ast_408.Parsetree.Pstr_include x0 -> Ast_409.Parsetree.Pstr_include (copy_include_declaration x0) | Ast_408.Parsetree.Pstr_attribute x0 -> Ast_409.Parsetree.Pstr_attribute (copy_attribute x0) | Ast_408.Parsetree.Pstr_extension (x0, x1) -> Ast_409.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : Ast_408.Parsetree.include_declaration -> Ast_409.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : Ast_408.Parsetree.class_declaration -> Ast_409.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : Ast_408.Parsetree.class_expr -> Ast_409.Parsetree.class_expr = fun { Ast_408.Parsetree.pcl_desc = pcl_desc; Ast_408.Parsetree.pcl_loc = pcl_loc; Ast_408.Parsetree.pcl_attributes = pcl_attributes } -> { Ast_409.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); Ast_409.Parsetree.pcl_loc = (copy_location pcl_loc); Ast_409.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : Ast_408.Parsetree.class_expr_desc -> Ast_409.Parsetree.class_expr_desc = function | Ast_408.Parsetree.Pcl_constr (x0, x1) -> Ast_409.Parsetree.Pcl_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_408.Parsetree.Pcl_structure x0 -> Ast_409.Parsetree.Pcl_structure (copy_class_structure x0) | Ast_408.Parsetree.Pcl_fun (x0, x1, x2, x3) -> Ast_409.Parsetree.Pcl_fun ((copy_arg_label x0), (Option.map copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | Ast_408.Parsetree.Pcl_apply (x0, x1) -> Ast_409.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_408.Parsetree.Pcl_let (x0, x1, x2) -> Ast_409.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | Ast_408.Parsetree.Pcl_constraint (x0, x1) -> Ast_409.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | Ast_408.Parsetree.Pcl_extension x0 -> Ast_409.Parsetree.Pcl_extension (copy_extension x0) | Ast_408.Parsetree.Pcl_open (x0, x1) -> Ast_409.Parsetree.Pcl_open ((copy_open_description x0), (copy_class_expr x1)) and copy_class_structure : Ast_408.Parsetree.class_structure -> Ast_409.Parsetree.class_structure = fun { Ast_408.Parsetree.pcstr_self = pcstr_self; Ast_408.Parsetree.pcstr_fields = pcstr_fields } -> { Ast_409.Parsetree.pcstr_self = (copy_pattern pcstr_self); Ast_409.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : Ast_408.Parsetree.class_field -> Ast_409.Parsetree.class_field = fun { Ast_408.Parsetree.pcf_desc = pcf_desc; Ast_408.Parsetree.pcf_loc = pcf_loc; Ast_408.Parsetree.pcf_attributes = pcf_attributes } -> { Ast_409.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); Ast_409.Parsetree.pcf_loc = (copy_location pcf_loc); Ast_409.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : Ast_408.Parsetree.class_field_desc -> Ast_409.Parsetree.class_field_desc = function | Ast_408.Parsetree.Pcf_inherit (x0, x1, x2) -> Ast_409.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) | Ast_408.Parsetree.Pcf_val x0 -> Ast_409.Parsetree.Pcf_val (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | Ast_408.Parsetree.Pcf_method x0 -> Ast_409.Parsetree.Pcf_method (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | Ast_408.Parsetree.Pcf_constraint x0 -> Ast_409.Parsetree.Pcf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_408.Parsetree.Pcf_initializer x0 -> Ast_409.Parsetree.Pcf_initializer (copy_expression x0) | Ast_408.Parsetree.Pcf_attribute x0 -> Ast_409.Parsetree.Pcf_attribute (copy_attribute x0) | Ast_408.Parsetree.Pcf_extension x0 -> Ast_409.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : Ast_408.Parsetree.class_field_kind -> Ast_409.Parsetree.class_field_kind = function | Ast_408.Parsetree.Cfk_virtual x0 -> Ast_409.Parsetree.Cfk_virtual (copy_core_type x0) | Ast_408.Parsetree.Cfk_concrete (x0, x1) -> Ast_409.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_open_declaration : Ast_408.Parsetree.open_declaration -> Ast_409.Parsetree.open_declaration = fun x -> copy_open_infos copy_module_expr x and copy_module_binding : Ast_408.Parsetree.module_binding -> Ast_409.Parsetree.module_binding = fun { Ast_408.Parsetree.pmb_name = pmb_name; Ast_408.Parsetree.pmb_expr = pmb_expr; Ast_408.Parsetree.pmb_attributes = pmb_attributes; Ast_408.Parsetree.pmb_loc = pmb_loc } -> { Ast_409.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); Ast_409.Parsetree.pmb_expr = (copy_module_expr pmb_expr); Ast_409.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); Ast_409.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : Ast_408.Parsetree.module_expr -> Ast_409.Parsetree.module_expr = fun { Ast_408.Parsetree.pmod_desc = pmod_desc; Ast_408.Parsetree.pmod_loc = pmod_loc; Ast_408.Parsetree.pmod_attributes = pmod_attributes } -> { Ast_409.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); Ast_409.Parsetree.pmod_loc = (copy_location pmod_loc); Ast_409.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : Ast_408.Parsetree.module_expr_desc -> Ast_409.Parsetree.module_expr_desc = function | Ast_408.Parsetree.Pmod_ident x0 -> Ast_409.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) | Ast_408.Parsetree.Pmod_structure x0 -> Ast_409.Parsetree.Pmod_structure (copy_structure x0) | Ast_408.Parsetree.Pmod_functor (x0, x1, x2) -> Ast_409.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), (copy_module_expr x2)) | Ast_408.Parsetree.Pmod_apply (x0, x1) -> Ast_409.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | Ast_408.Parsetree.Pmod_constraint (x0, x1) -> Ast_409.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | Ast_408.Parsetree.Pmod_unpack x0 -> Ast_409.Parsetree.Pmod_unpack (copy_expression x0) | Ast_408.Parsetree.Pmod_extension x0 -> Ast_409.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : Ast_408.Parsetree.module_type -> Ast_409.Parsetree.module_type = fun { Ast_408.Parsetree.pmty_desc = pmty_desc; Ast_408.Parsetree.pmty_loc = pmty_loc; Ast_408.Parsetree.pmty_attributes = pmty_attributes } -> { Ast_409.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); Ast_409.Parsetree.pmty_loc = (copy_location pmty_loc); Ast_409.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : Ast_408.Parsetree.module_type_desc -> Ast_409.Parsetree.module_type_desc = function | Ast_408.Parsetree.Pmty_ident x0 -> Ast_409.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) | Ast_408.Parsetree.Pmty_signature x0 -> Ast_409.Parsetree.Pmty_signature (copy_signature x0) | Ast_408.Parsetree.Pmty_functor (x0, x1, x2) -> Ast_409.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), (copy_module_type x2)) | Ast_408.Parsetree.Pmty_with (x0, x1) -> Ast_409.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | Ast_408.Parsetree.Pmty_typeof x0 -> Ast_409.Parsetree.Pmty_typeof (copy_module_expr x0) | Ast_408.Parsetree.Pmty_extension x0 -> Ast_409.Parsetree.Pmty_extension (copy_extension x0) | Ast_408.Parsetree.Pmty_alias x0 -> Ast_409.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) and copy_with_constraint : Ast_408.Parsetree.with_constraint -> Ast_409.Parsetree.with_constraint = function | Ast_408.Parsetree.Pwith_type (x0, x1) -> Ast_409.Parsetree.Pwith_type ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_408.Parsetree.Pwith_module (x0, x1) -> Ast_409.Parsetree.Pwith_module ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) | Ast_408.Parsetree.Pwith_typesubst (x0, x1) -> Ast_409.Parsetree.Pwith_typesubst ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_408.Parsetree.Pwith_modsubst (x0, x1) -> Ast_409.Parsetree.Pwith_modsubst ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) and copy_signature : Ast_408.Parsetree.signature -> Ast_409.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : Ast_408.Parsetree.signature_item -> Ast_409.Parsetree.signature_item = fun { Ast_408.Parsetree.psig_desc = psig_desc; Ast_408.Parsetree.psig_loc = psig_loc } -> { Ast_409.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); Ast_409.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : Ast_408.Parsetree.signature_item_desc -> Ast_409.Parsetree.signature_item_desc = function | Ast_408.Parsetree.Psig_value x0 -> Ast_409.Parsetree.Psig_value (copy_value_description x0) | Ast_408.Parsetree.Psig_type (x0, x1) -> Ast_409.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_408.Parsetree.Psig_typesubst x0 -> Ast_409.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) | Ast_408.Parsetree.Psig_typext x0 -> Ast_409.Parsetree.Psig_typext (copy_type_extension x0) | Ast_408.Parsetree.Psig_exception x0 -> Ast_409.Parsetree.Psig_exception (copy_type_exception x0) | Ast_408.Parsetree.Psig_module x0 -> Ast_409.Parsetree.Psig_module (copy_module_declaration x0) | Ast_408.Parsetree.Psig_modsubst x0 -> Ast_409.Parsetree.Psig_modsubst (copy_module_substitution x0) | Ast_408.Parsetree.Psig_recmodule x0 -> Ast_409.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | Ast_408.Parsetree.Psig_modtype x0 -> Ast_409.Parsetree.Psig_modtype (copy_module_type_declaration x0) | Ast_408.Parsetree.Psig_open x0 -> Ast_409.Parsetree.Psig_open (copy_open_description x0) | Ast_408.Parsetree.Psig_include x0 -> Ast_409.Parsetree.Psig_include (copy_include_description x0) | Ast_408.Parsetree.Psig_class x0 -> Ast_409.Parsetree.Psig_class (List.map copy_class_description x0) | Ast_408.Parsetree.Psig_class_type x0 -> Ast_409.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | Ast_408.Parsetree.Psig_attribute x0 -> Ast_409.Parsetree.Psig_attribute (copy_attribute x0) | Ast_408.Parsetree.Psig_extension (x0, x1) -> Ast_409.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : Ast_408.Parsetree.class_type_declaration -> Ast_409.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : Ast_408.Parsetree.class_description -> Ast_409.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : Ast_408.Parsetree.class_type -> Ast_409.Parsetree.class_type = fun { Ast_408.Parsetree.pcty_desc = pcty_desc; Ast_408.Parsetree.pcty_loc = pcty_loc; Ast_408.Parsetree.pcty_attributes = pcty_attributes } -> { Ast_409.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); Ast_409.Parsetree.pcty_loc = (copy_location pcty_loc); Ast_409.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : Ast_408.Parsetree.class_type_desc -> Ast_409.Parsetree.class_type_desc = function | Ast_408.Parsetree.Pcty_constr (x0, x1) -> Ast_409.Parsetree.Pcty_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_408.Parsetree.Pcty_signature x0 -> Ast_409.Parsetree.Pcty_signature (copy_class_signature x0) | Ast_408.Parsetree.Pcty_arrow (x0, x1, x2) -> Ast_409.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | Ast_408.Parsetree.Pcty_extension x0 -> Ast_409.Parsetree.Pcty_extension (copy_extension x0) | Ast_408.Parsetree.Pcty_open (x0, x1) -> Ast_409.Parsetree.Pcty_open ((copy_open_description x0), (copy_class_type x1)) and copy_class_signature : Ast_408.Parsetree.class_signature -> Ast_409.Parsetree.class_signature = fun { Ast_408.Parsetree.pcsig_self = pcsig_self; Ast_408.Parsetree.pcsig_fields = pcsig_fields } -> { Ast_409.Parsetree.pcsig_self = (copy_core_type pcsig_self); Ast_409.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : Ast_408.Parsetree.class_type_field -> Ast_409.Parsetree.class_type_field = fun { Ast_408.Parsetree.pctf_desc = pctf_desc; Ast_408.Parsetree.pctf_loc = pctf_loc; Ast_408.Parsetree.pctf_attributes = pctf_attributes } -> { Ast_409.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); Ast_409.Parsetree.pctf_loc = (copy_location pctf_loc); Ast_409.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : Ast_408.Parsetree.class_type_field_desc -> Ast_409.Parsetree.class_type_field_desc = function | Ast_408.Parsetree.Pctf_inherit x0 -> Ast_409.Parsetree.Pctf_inherit (copy_class_type x0) | Ast_408.Parsetree.Pctf_val x0 -> Ast_409.Parsetree.Pctf_val (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_408.Parsetree.Pctf_method x0 -> Ast_409.Parsetree.Pctf_method (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_408.Parsetree.Pctf_constraint x0 -> Ast_409.Parsetree.Pctf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_408.Parsetree.Pctf_attribute x0 -> Ast_409.Parsetree.Pctf_attribute (copy_attribute x0) | Ast_408.Parsetree.Pctf_extension x0 -> Ast_409.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : Ast_408.Parsetree.extension -> Ast_409.Parsetree.extension = fun x -> let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_408.Parsetree.class_infos -> 'g0 Ast_409.Parsetree.class_infos = fun f0 -> fun { Ast_408.Parsetree.pci_virt = pci_virt; Ast_408.Parsetree.pci_params = pci_params; Ast_408.Parsetree.pci_name = pci_name; Ast_408.Parsetree.pci_expr = pci_expr; Ast_408.Parsetree.pci_loc = pci_loc; Ast_408.Parsetree.pci_attributes = pci_attributes } -> { Ast_409.Parsetree.pci_virt = (copy_virtual_flag pci_virt); Ast_409.Parsetree.pci_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); Ast_409.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); Ast_409.Parsetree.pci_expr = (f0 pci_expr); Ast_409.Parsetree.pci_loc = (copy_location pci_loc); Ast_409.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : Ast_408.Asttypes.virtual_flag -> Ast_409.Asttypes.virtual_flag = function | Ast_408.Asttypes.Virtual -> Ast_409.Asttypes.Virtual | Ast_408.Asttypes.Concrete -> Ast_409.Asttypes.Concrete and copy_include_description : Ast_408.Parsetree.include_description -> Ast_409.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_408.Parsetree.include_infos -> 'g0 Ast_409.Parsetree.include_infos = fun f0 -> fun { Ast_408.Parsetree.pincl_mod = pincl_mod; Ast_408.Parsetree.pincl_loc = pincl_loc; Ast_408.Parsetree.pincl_attributes = pincl_attributes } -> { Ast_409.Parsetree.pincl_mod = (f0 pincl_mod); Ast_409.Parsetree.pincl_loc = (copy_location pincl_loc); Ast_409.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : Ast_408.Parsetree.open_description -> Ast_409.Parsetree.open_description = fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x and copy_open_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_408.Parsetree.open_infos -> 'g0 Ast_409.Parsetree.open_infos = fun f0 -> fun { Ast_408.Parsetree.popen_expr = popen_expr; Ast_408.Parsetree.popen_override = popen_override; Ast_408.Parsetree.popen_loc = popen_loc; Ast_408.Parsetree.popen_attributes = popen_attributes } -> { Ast_409.Parsetree.popen_expr = (f0 popen_expr); Ast_409.Parsetree.popen_override = (copy_override_flag popen_override); Ast_409.Parsetree.popen_loc = (copy_location popen_loc); Ast_409.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : Ast_408.Asttypes.override_flag -> Ast_409.Asttypes.override_flag = function | Ast_408.Asttypes.Override -> Ast_409.Asttypes.Override | Ast_408.Asttypes.Fresh -> Ast_409.Asttypes.Fresh and copy_module_type_declaration : Ast_408.Parsetree.module_type_declaration -> Ast_409.Parsetree.module_type_declaration = fun { Ast_408.Parsetree.pmtd_name = pmtd_name; Ast_408.Parsetree.pmtd_type = pmtd_type; Ast_408.Parsetree.pmtd_attributes = pmtd_attributes; Ast_408.Parsetree.pmtd_loc = pmtd_loc } -> { Ast_409.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); Ast_409.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); Ast_409.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); Ast_409.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_substitution : Ast_408.Parsetree.module_substitution -> Ast_409.Parsetree.module_substitution = fun { Ast_408.Parsetree.pms_name = pms_name; Ast_408.Parsetree.pms_manifest = pms_manifest; Ast_408.Parsetree.pms_attributes = pms_attributes; Ast_408.Parsetree.pms_loc = pms_loc } -> { Ast_409.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); Ast_409.Parsetree.pms_manifest = (copy_loc copy_Longident_t pms_manifest); Ast_409.Parsetree.pms_attributes = (copy_attributes pms_attributes); Ast_409.Parsetree.pms_loc = (copy_location pms_loc) } and copy_module_declaration : Ast_408.Parsetree.module_declaration -> Ast_409.Parsetree.module_declaration = fun { Ast_408.Parsetree.pmd_name = pmd_name; Ast_408.Parsetree.pmd_type = pmd_type; Ast_408.Parsetree.pmd_attributes = pmd_attributes; Ast_408.Parsetree.pmd_loc = pmd_loc } -> { Ast_409.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); Ast_409.Parsetree.pmd_type = (copy_module_type pmd_type); Ast_409.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); Ast_409.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_exception : Ast_408.Parsetree.type_exception -> Ast_409.Parsetree.type_exception = fun { Ast_408.Parsetree.ptyexn_constructor = ptyexn_constructor; Ast_408.Parsetree.ptyexn_loc = ptyexn_loc; Ast_408.Parsetree.ptyexn_attributes = ptyexn_attributes } -> { Ast_409.Parsetree.ptyexn_constructor = (copy_extension_constructor ptyexn_constructor); Ast_409.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); Ast_409.Parsetree.ptyexn_attributes = (copy_attributes ptyexn_attributes) } and copy_type_extension : Ast_408.Parsetree.type_extension -> Ast_409.Parsetree.type_extension = fun { Ast_408.Parsetree.ptyext_path = ptyext_path; Ast_408.Parsetree.ptyext_params = ptyext_params; Ast_408.Parsetree.ptyext_constructors = ptyext_constructors; Ast_408.Parsetree.ptyext_private = ptyext_private; Ast_408.Parsetree.ptyext_loc = ptyext_loc; Ast_408.Parsetree.ptyext_attributes = ptyext_attributes } -> { Ast_409.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); Ast_409.Parsetree.ptyext_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); Ast_409.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); Ast_409.Parsetree.ptyext_private = (copy_private_flag ptyext_private); Ast_409.Parsetree.ptyext_loc = (copy_location ptyext_loc); Ast_409.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : Ast_408.Parsetree.extension_constructor -> Ast_409.Parsetree.extension_constructor = fun { Ast_408.Parsetree.pext_name = pext_name; Ast_408.Parsetree.pext_kind = pext_kind; Ast_408.Parsetree.pext_loc = pext_loc; Ast_408.Parsetree.pext_attributes = pext_attributes } -> { Ast_409.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); Ast_409.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); Ast_409.Parsetree.pext_loc = (copy_location pext_loc); Ast_409.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : Ast_408.Parsetree.extension_constructor_kind -> Ast_409.Parsetree.extension_constructor_kind = function | Ast_408.Parsetree.Pext_decl (x0, x1) -> Ast_409.Parsetree.Pext_decl ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) | Ast_408.Parsetree.Pext_rebind x0 -> Ast_409.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) and copy_type_declaration : Ast_408.Parsetree.type_declaration -> Ast_409.Parsetree.type_declaration = fun { Ast_408.Parsetree.ptype_name = ptype_name; Ast_408.Parsetree.ptype_params = ptype_params; Ast_408.Parsetree.ptype_cstrs = ptype_cstrs; Ast_408.Parsetree.ptype_kind = ptype_kind; Ast_408.Parsetree.ptype_private = ptype_private; Ast_408.Parsetree.ptype_manifest = ptype_manifest; Ast_408.Parsetree.ptype_attributes = ptype_attributes; Ast_408.Parsetree.ptype_loc = ptype_loc } -> { Ast_409.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); Ast_409.Parsetree.ptype_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); Ast_409.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0, x1, x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); Ast_409.Parsetree.ptype_kind = (copy_type_kind ptype_kind); Ast_409.Parsetree.ptype_private = (copy_private_flag ptype_private); Ast_409.Parsetree.ptype_manifest = (Option.map copy_core_type ptype_manifest); Ast_409.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); Ast_409.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : Ast_408.Asttypes.private_flag -> Ast_409.Asttypes.private_flag = function | Ast_408.Asttypes.Private -> Ast_409.Asttypes.Private | Ast_408.Asttypes.Public -> Ast_409.Asttypes.Public and copy_type_kind : Ast_408.Parsetree.type_kind -> Ast_409.Parsetree.type_kind = function | Ast_408.Parsetree.Ptype_abstract -> Ast_409.Parsetree.Ptype_abstract | Ast_408.Parsetree.Ptype_variant x0 -> Ast_409.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | Ast_408.Parsetree.Ptype_record x0 -> Ast_409.Parsetree.Ptype_record (List.map copy_label_declaration x0) | Ast_408.Parsetree.Ptype_open -> Ast_409.Parsetree.Ptype_open and copy_constructor_declaration : Ast_408.Parsetree.constructor_declaration -> Ast_409.Parsetree.constructor_declaration = fun { Ast_408.Parsetree.pcd_name = pcd_name; Ast_408.Parsetree.pcd_args = pcd_args; Ast_408.Parsetree.pcd_res = pcd_res; Ast_408.Parsetree.pcd_loc = pcd_loc; Ast_408.Parsetree.pcd_attributes = pcd_attributes } -> { Ast_409.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); Ast_409.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); Ast_409.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); Ast_409.Parsetree.pcd_loc = (copy_location pcd_loc); Ast_409.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : Ast_408.Parsetree.constructor_arguments -> Ast_409.Parsetree.constructor_arguments = function | Ast_408.Parsetree.Pcstr_tuple x0 -> Ast_409.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | Ast_408.Parsetree.Pcstr_record x0 -> Ast_409.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : Ast_408.Parsetree.label_declaration -> Ast_409.Parsetree.label_declaration = fun { Ast_408.Parsetree.pld_name = pld_name; Ast_408.Parsetree.pld_mutable = pld_mutable; Ast_408.Parsetree.pld_type = pld_type; Ast_408.Parsetree.pld_loc = pld_loc; Ast_408.Parsetree.pld_attributes = pld_attributes } -> { Ast_409.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); Ast_409.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); Ast_409.Parsetree.pld_type = (copy_core_type pld_type); Ast_409.Parsetree.pld_loc = (copy_location pld_loc); Ast_409.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : Ast_408.Asttypes.mutable_flag -> Ast_409.Asttypes.mutable_flag = function | Ast_408.Asttypes.Immutable -> Ast_409.Asttypes.Immutable | Ast_408.Asttypes.Mutable -> Ast_409.Asttypes.Mutable and copy_variance : Ast_408.Asttypes.variance -> Ast_409.Asttypes.variance = function | Ast_408.Asttypes.Covariant -> Ast_409.Asttypes.Covariant | Ast_408.Asttypes.Contravariant -> Ast_409.Asttypes.Contravariant | Ast_408.Asttypes.Invariant -> Ast_409.Asttypes.Invariant and copy_value_description : Ast_408.Parsetree.value_description -> Ast_409.Parsetree.value_description = fun { Ast_408.Parsetree.pval_name = pval_name; Ast_408.Parsetree.pval_type = pval_type; Ast_408.Parsetree.pval_prim = pval_prim; Ast_408.Parsetree.pval_attributes = pval_attributes; Ast_408.Parsetree.pval_loc = pval_loc } -> { Ast_409.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); Ast_409.Parsetree.pval_type = (copy_core_type pval_type); Ast_409.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); Ast_409.Parsetree.pval_attributes = (copy_attributes pval_attributes); Ast_409.Parsetree.pval_loc = (copy_location pval_loc) } and copy_object_field_desc : Ast_408.Parsetree.object_field_desc -> Ast_409.Parsetree.object_field_desc = function | Ast_408.Parsetree.Otag (x0, x1) -> Ast_409.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) | Ast_408.Parsetree.Oinherit x0 -> Ast_409.Parsetree.Oinherit (copy_core_type x0) and copy_arg_label : Ast_408.Asttypes.arg_label -> Ast_409.Asttypes.arg_label = function | Ast_408.Asttypes.Nolabel -> Ast_409.Asttypes.Nolabel | Ast_408.Asttypes.Labelled x0 -> Ast_409.Asttypes.Labelled x0 | Ast_408.Asttypes.Optional x0 -> Ast_409.Asttypes.Optional x0 and copy_closed_flag : Ast_408.Asttypes.closed_flag -> Ast_409.Asttypes.closed_flag = function | Ast_408.Asttypes.Closed -> Ast_409.Asttypes.Closed | Ast_408.Asttypes.Open -> Ast_409.Asttypes.Open and copy_label : Ast_408.Asttypes.label -> Ast_409.Asttypes.label = fun x -> x and copy_rec_flag : Ast_408.Asttypes.rec_flag -> Ast_409.Asttypes.rec_flag = function | Ast_408.Asttypes.Nonrecursive -> Ast_409.Asttypes.Nonrecursive | Ast_408.Asttypes.Recursive -> Ast_409.Asttypes.Recursive and copy_constant : Ast_408.Parsetree.constant -> Ast_409.Parsetree.constant = function | Ast_408.Parsetree.Pconst_integer (x0, x1) -> Ast_409.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) | Ast_408.Parsetree.Pconst_char x0 -> Ast_409.Parsetree.Pconst_char x0 | Ast_408.Parsetree.Pconst_string (x0, x1) -> Ast_409.Parsetree.Pconst_string (x0, (Option.map (fun x -> x) x1)) | Ast_408.Parsetree.Pconst_float (x0, x1) -> Ast_409.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) and copy_Longident_t : Ast_408.Longident.t -> Ast_409.Longident.t = function | Ast_408.Longident.Lident x0 -> Ast_409.Longident.Lident x0 | Ast_408.Longident.Ldot (x0, x1) -> Ast_409.Longident.Ldot ((copy_Longident_t x0), x1) | Ast_408.Longident.Lapply (x0, x1) -> Ast_409.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_408.Asttypes.loc -> 'g0 Ast_409.Asttypes.loc = fun f0 -> fun { Ast_408.Asttypes.txt = txt; Ast_408.Asttypes.loc = loc } -> { Ast_409.Asttypes.txt = (f0 txt); Ast_409.Asttypes.loc = (copy_location loc) } and copy_location : Ast_408.Location.t -> Ast_409.Location.t = fun { Ast_408.Location.loc_start = loc_start; Ast_408.Location.loc_end = loc_end; Ast_408.Location.loc_ghost = loc_ghost } -> { Ast_409.Location.loc_start = (copy_position loc_start); Ast_409.Location.loc_end = (copy_position loc_end); Ast_409.Location.loc_ghost = loc_ghost } and copy_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_409_408.ml000066400000000000000000000171161356450464700240640ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_409_408_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload"; "binding_op"; "module_substitution"; "open_declaration"; "type_exception" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; binding_op; module_substitution; open_declaration; type_exception; (*$*) } as mapper) -> let module Def = Migrate_parsetree_def in let module R = Migrate_parsetree_408_409_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_409_408_migrate.ml000066400000000000000000001764561356450464700256110ustar00rootroot00000000000000open Stdlib0 module From = Ast_409 module To = Ast_408 let rec copy_out_type_extension : Ast_409.Outcometree.out_type_extension -> Ast_408.Outcometree.out_type_extension = fun { Ast_409.Outcometree.otyext_name = otyext_name; Ast_409.Outcometree.otyext_params = otyext_params; Ast_409.Outcometree.otyext_constructors = otyext_constructors; Ast_409.Outcometree.otyext_private = otyext_private } -> { Ast_408.Outcometree.otyext_name = otyext_name; Ast_408.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); Ast_408.Outcometree.otyext_constructors = (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (Option.map copy_out_type x2))) otyext_constructors); Ast_408.Outcometree.otyext_private = (copy_private_flag otyext_private) } and copy_out_phrase : Ast_409.Outcometree.out_phrase -> Ast_408.Outcometree.out_phrase = function | Ast_409.Outcometree.Ophr_eval (x0, x1) -> Ast_408.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | Ast_409.Outcometree.Ophr_signature x0 -> Ast_408.Outcometree.Ophr_signature (List.map (fun x -> let (x0, x1) = x in ((copy_out_sig_item x0), (Option.map copy_out_value x1))) x0) | Ast_409.Outcometree.Ophr_exception x0 -> Ast_408.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : Ast_409.Outcometree.out_sig_item -> Ast_408.Outcometree.out_sig_item = function | Ast_409.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> Ast_408.Outcometree.Osig_class (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_409.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> Ast_408.Outcometree.Osig_class_type (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_409.Outcometree.Osig_typext (x0, x1) -> Ast_408.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | Ast_409.Outcometree.Osig_modtype (x0, x1) -> Ast_408.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | Ast_409.Outcometree.Osig_module (x0, x1, x2) -> Ast_408.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | Ast_409.Outcometree.Osig_type (x0, x1) -> Ast_408.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | Ast_409.Outcometree.Osig_value x0 -> Ast_408.Outcometree.Osig_value (copy_out_val_decl x0) | Ast_409.Outcometree.Osig_ellipsis -> Ast_408.Outcometree.Osig_ellipsis and copy_out_val_decl : Ast_409.Outcometree.out_val_decl -> Ast_408.Outcometree.out_val_decl = fun { Ast_409.Outcometree.oval_name = oval_name; Ast_409.Outcometree.oval_type = oval_type; Ast_409.Outcometree.oval_prims = oval_prims; Ast_409.Outcometree.oval_attributes = oval_attributes } -> { Ast_408.Outcometree.oval_name = oval_name; Ast_408.Outcometree.oval_type = (copy_out_type oval_type); Ast_408.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); Ast_408.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : Ast_409.Outcometree.out_type_decl -> Ast_408.Outcometree.out_type_decl = fun { Ast_409.Outcometree.otype_name = otype_name; Ast_409.Outcometree.otype_params = otype_params; Ast_409.Outcometree.otype_type = otype_type; Ast_409.Outcometree.otype_private = otype_private; Ast_409.Outcometree.otype_immediate = otype_immediate; Ast_409.Outcometree.otype_unboxed = otype_unboxed; Ast_409.Outcometree.otype_cstrs = otype_cstrs } -> { Ast_408.Outcometree.otype_name = otype_name; Ast_408.Outcometree.otype_params = (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) otype_params); Ast_408.Outcometree.otype_type = (copy_out_type otype_type); Ast_408.Outcometree.otype_private = (copy_private_flag otype_private); Ast_408.Outcometree.otype_immediate = otype_immediate; Ast_408.Outcometree.otype_unboxed = otype_unboxed; Ast_408.Outcometree.otype_cstrs = (List.map (fun x -> let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : Ast_409.Outcometree.out_module_type -> Ast_408.Outcometree.out_module_type = function | Ast_409.Outcometree.Omty_abstract -> Ast_408.Outcometree.Omty_abstract | Ast_409.Outcometree.Omty_functor (x0, x1, x2) -> Ast_408.Outcometree.Omty_functor (x0, (Option.map copy_out_module_type x1), (copy_out_module_type x2)) | Ast_409.Outcometree.Omty_ident x0 -> Ast_408.Outcometree.Omty_ident (copy_out_ident x0) | Ast_409.Outcometree.Omty_signature x0 -> Ast_408.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | Ast_409.Outcometree.Omty_alias x0 -> Ast_408.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : Ast_409.Outcometree.out_ext_status -> Ast_408.Outcometree.out_ext_status = function | Ast_409.Outcometree.Oext_first -> Ast_408.Outcometree.Oext_first | Ast_409.Outcometree.Oext_next -> Ast_408.Outcometree.Oext_next | Ast_409.Outcometree.Oext_exception -> Ast_408.Outcometree.Oext_exception and copy_out_extension_constructor : Ast_409.Outcometree.out_extension_constructor -> Ast_408.Outcometree.out_extension_constructor = fun { Ast_409.Outcometree.oext_name = oext_name; Ast_409.Outcometree.oext_type_name = oext_type_name; Ast_409.Outcometree.oext_type_params = oext_type_params; Ast_409.Outcometree.oext_args = oext_args; Ast_409.Outcometree.oext_ret_type = oext_ret_type; Ast_409.Outcometree.oext_private = oext_private } -> { Ast_408.Outcometree.oext_name = oext_name; Ast_408.Outcometree.oext_type_name = oext_type_name; Ast_408.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); Ast_408.Outcometree.oext_args = (List.map copy_out_type oext_args); Ast_408.Outcometree.oext_ret_type = (Option.map copy_out_type oext_ret_type); Ast_408.Outcometree.oext_private = (copy_private_flag oext_private) } and copy_out_rec_status : Ast_409.Outcometree.out_rec_status -> Ast_408.Outcometree.out_rec_status = function | Ast_409.Outcometree.Orec_not -> Ast_408.Outcometree.Orec_not | Ast_409.Outcometree.Orec_first -> Ast_408.Outcometree.Orec_first | Ast_409.Outcometree.Orec_next -> Ast_408.Outcometree.Orec_next and copy_out_class_type : Ast_409.Outcometree.out_class_type -> Ast_408.Outcometree.out_class_type = function | Ast_409.Outcometree.Octy_constr (x0, x1) -> Ast_408.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_409.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_408.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | Ast_409.Outcometree.Octy_signature (x0, x1) -> Ast_408.Outcometree.Octy_signature ((Option.map copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : Ast_409.Outcometree.out_class_sig_item -> Ast_408.Outcometree.out_class_sig_item = function | Ast_409.Outcometree.Ocsg_constraint (x0, x1) -> Ast_408.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | Ast_409.Outcometree.Ocsg_method (x0, x1, x2, x3) -> Ast_408.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) | Ast_409.Outcometree.Ocsg_value (x0, x1, x2, x3) -> Ast_408.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) and copy_out_type : Ast_409.Outcometree.out_type -> Ast_408.Outcometree.out_type = function | Ast_409.Outcometree.Otyp_abstract -> Ast_408.Outcometree.Otyp_abstract | Ast_409.Outcometree.Otyp_open -> Ast_408.Outcometree.Otyp_open | Ast_409.Outcometree.Otyp_alias (x0, x1) -> Ast_408.Outcometree.Otyp_alias ((copy_out_type x0), x1) | Ast_409.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_408.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | Ast_409.Outcometree.Otyp_class (x0, x1, x2) -> Ast_408.Outcometree.Otyp_class (x0, (copy_out_ident x1), (List.map copy_out_type x2)) | Ast_409.Outcometree.Otyp_constr (x0, x1) -> Ast_408.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_409.Outcometree.Otyp_manifest (x0, x1) -> Ast_408.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | Ast_409.Outcometree.Otyp_object (x0, x1) -> Ast_408.Outcometree.Otyp_object ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), (Option.map (fun x -> x) x1)) | Ast_409.Outcometree.Otyp_record x0 -> Ast_408.Outcometree.Otyp_record (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) | Ast_409.Outcometree.Otyp_stuff x0 -> Ast_408.Outcometree.Otyp_stuff x0 | Ast_409.Outcometree.Otyp_sum x0 -> Ast_408.Outcometree.Otyp_sum (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (Option.map copy_out_type x2))) x0) | Ast_409.Outcometree.Otyp_tuple x0 -> Ast_408.Outcometree.Otyp_tuple (List.map copy_out_type x0) | Ast_409.Outcometree.Otyp_var (x0, x1) -> Ast_408.Outcometree.Otyp_var (x0, x1) | Ast_409.Outcometree.Otyp_variant (x0, x1, x2, x3) -> Ast_408.Outcometree.Otyp_variant (x0, (copy_out_variant x1), x2, (Option.map (fun x -> List.map (fun x -> x) x) x3)) | Ast_409.Outcometree.Otyp_poly (x0, x1) -> Ast_408.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | Ast_409.Outcometree.Otyp_module (x0, x1, x2) -> Ast_408.Outcometree.Otyp_module ((copy_out_ident x0), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | Ast_409.Outcometree.Otyp_attribute (x0, x1) -> Ast_408.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : Ast_409.Outcometree.out_attribute -> Ast_408.Outcometree.out_attribute = fun { Ast_409.Outcometree.oattr_name = oattr_name } -> { Ast_408.Outcometree.oattr_name = oattr_name } and copy_out_variant : Ast_409.Outcometree.out_variant -> Ast_408.Outcometree.out_variant = function | Ast_409.Outcometree.Ovar_fields x0 -> Ast_408.Outcometree.Ovar_fields (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) x0) | Ast_409.Outcometree.Ovar_typ x0 -> Ast_408.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : Ast_409.Outcometree.out_value -> Ast_408.Outcometree.out_value = function | Ast_409.Outcometree.Oval_array x0 -> Ast_408.Outcometree.Oval_array (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_char x0 -> Ast_408.Outcometree.Oval_char x0 | Ast_409.Outcometree.Oval_constr (x0, x1) -> Ast_408.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | Ast_409.Outcometree.Oval_ellipsis -> Ast_408.Outcometree.Oval_ellipsis | Ast_409.Outcometree.Oval_float x0 -> Ast_408.Outcometree.Oval_float x0 | Ast_409.Outcometree.Oval_int x0 -> Ast_408.Outcometree.Oval_int x0 | Ast_409.Outcometree.Oval_int32 x0 -> Ast_408.Outcometree.Oval_int32 x0 | Ast_409.Outcometree.Oval_int64 x0 -> Ast_408.Outcometree.Oval_int64 x0 | Ast_409.Outcometree.Oval_nativeint x0 -> Ast_408.Outcometree.Oval_nativeint x0 | Ast_409.Outcometree.Oval_list x0 -> Ast_408.Outcometree.Oval_list (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_printer x0 -> Ast_408.Outcometree.Oval_printer x0 | Ast_409.Outcometree.Oval_record x0 -> Ast_408.Outcometree.Oval_record (List.map (fun x -> let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | Ast_409.Outcometree.Oval_string (x0, x1, x2) -> Ast_408.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) | Ast_409.Outcometree.Oval_stuff x0 -> Ast_408.Outcometree.Oval_stuff x0 | Ast_409.Outcometree.Oval_tuple x0 -> Ast_408.Outcometree.Oval_tuple (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_variant (x0, x1) -> Ast_408.Outcometree.Oval_variant (x0, (Option.map copy_out_value x1)) and copy_out_string : Ast_409.Outcometree.out_string -> Ast_408.Outcometree.out_string = function | Ast_409.Outcometree.Ostr_string -> Ast_408.Outcometree.Ostr_string | Ast_409.Outcometree.Ostr_bytes -> Ast_408.Outcometree.Ostr_bytes and copy_out_ident : Ast_409.Outcometree.out_ident -> Ast_408.Outcometree.out_ident = function | Ast_409.Outcometree.Oide_apply (x0, x1) -> Ast_408.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | Ast_409.Outcometree.Oide_dot (x0, x1) -> Ast_408.Outcometree.Oide_dot ((copy_out_ident x0), x1) | Ast_409.Outcometree.Oide_ident x0 -> Ast_408.Outcometree.Oide_ident (copy_out_name x0) and copy_out_name : Ast_409.Outcometree.out_name -> Ast_408.Outcometree.out_name = fun { Ast_409.Outcometree.printed_name = printed_name } -> { Ast_408.Outcometree.printed_name = printed_name } and copy_toplevel_phrase : Ast_409.Parsetree.toplevel_phrase -> Ast_408.Parsetree.toplevel_phrase = function | Ast_409.Parsetree.Ptop_def x0 -> Ast_408.Parsetree.Ptop_def (copy_structure x0) | Ast_409.Parsetree.Ptop_dir x0 -> Ast_408.Parsetree.Ptop_dir (copy_toplevel_directive x0) and copy_toplevel_directive : Ast_409.Parsetree.toplevel_directive -> Ast_408.Parsetree.toplevel_directive = fun { Ast_409.Parsetree.pdir_name = pdir_name; Ast_409.Parsetree.pdir_arg = pdir_arg; Ast_409.Parsetree.pdir_loc = pdir_loc } -> { Ast_408.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); Ast_408.Parsetree.pdir_arg = (Option.map copy_directive_argument pdir_arg); Ast_408.Parsetree.pdir_loc = (copy_location pdir_loc) } and copy_directive_argument : Ast_409.Parsetree.directive_argument -> Ast_408.Parsetree.directive_argument = fun { Ast_409.Parsetree.pdira_desc = pdira_desc; Ast_409.Parsetree.pdira_loc = pdira_loc } -> { Ast_408.Parsetree.pdira_desc = (copy_directive_argument_desc pdira_desc); Ast_408.Parsetree.pdira_loc = (copy_location pdira_loc) } and copy_directive_argument_desc : Ast_409.Parsetree.directive_argument_desc -> Ast_408.Parsetree.directive_argument_desc = function | Ast_409.Parsetree.Pdir_string x0 -> Ast_408.Parsetree.Pdir_string x0 | Ast_409.Parsetree.Pdir_int (x0, x1) -> Ast_408.Parsetree.Pdir_int (x0, (Option.map (fun x -> x) x1)) | Ast_409.Parsetree.Pdir_ident x0 -> Ast_408.Parsetree.Pdir_ident (copy_Longident_t x0) | Ast_409.Parsetree.Pdir_bool x0 -> Ast_408.Parsetree.Pdir_bool x0 and copy_typ : Ast_409.Parsetree.typ -> Ast_408.Parsetree.typ = fun x -> copy_core_type x and copy_pat : Ast_409.Parsetree.pat -> Ast_408.Parsetree.pat = fun x -> copy_pattern x and copy_expr : Ast_409.Parsetree.expr -> Ast_408.Parsetree.expr = fun x -> copy_expression x and copy_expression : Ast_409.Parsetree.expression -> Ast_408.Parsetree.expression = fun { Ast_409.Parsetree.pexp_desc = pexp_desc; Ast_409.Parsetree.pexp_loc = pexp_loc; Ast_409.Parsetree.pexp_loc_stack = pexp_loc_stack; Ast_409.Parsetree.pexp_attributes = pexp_attributes } -> { Ast_408.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); Ast_408.Parsetree.pexp_loc = (copy_location pexp_loc); Ast_408.Parsetree.pexp_loc_stack = (List.map copy_location pexp_loc_stack); Ast_408.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : Ast_409.Parsetree.expression_desc -> Ast_408.Parsetree.expression_desc = function | Ast_409.Parsetree.Pexp_ident x0 -> Ast_408.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pexp_constant x0 -> Ast_408.Parsetree.Pexp_constant (copy_constant x0) | Ast_409.Parsetree.Pexp_let (x0, x1, x2) -> Ast_408.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_function x0 -> Ast_408.Parsetree.Pexp_function (copy_cases x0) | Ast_409.Parsetree.Pexp_fun (x0, x1, x2, x3) -> Ast_408.Parsetree.Pexp_fun ((copy_arg_label x0), (Option.map copy_expression x1), (copy_pattern x2), (copy_expression x3)) | Ast_409.Parsetree.Pexp_apply (x0, x1) -> Ast_408.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_409.Parsetree.Pexp_match (x0, x1) -> Ast_408.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) | Ast_409.Parsetree.Pexp_try (x0, x1) -> Ast_408.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) | Ast_409.Parsetree.Pexp_tuple x0 -> Ast_408.Parsetree.Pexp_tuple (List.map copy_expression x0) | Ast_409.Parsetree.Pexp_construct (x0, x1) -> Ast_408.Parsetree.Pexp_construct ((copy_loc copy_Longident_t x0), (Option.map copy_expression x1)) | Ast_409.Parsetree.Pexp_variant (x0, x1) -> Ast_408.Parsetree.Pexp_variant ((copy_label x0), (Option.map copy_expression x1)) | Ast_409.Parsetree.Pexp_record (x0, x1) -> Ast_408.Parsetree.Pexp_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), (Option.map copy_expression x1)) | Ast_409.Parsetree.Pexp_field (x0, x1) -> Ast_408.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_Longident_t x1)) | Ast_409.Parsetree.Pexp_setfield (x0, x1, x2) -> Ast_408.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_Longident_t x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_array x0 -> Ast_408.Parsetree.Pexp_array (List.map copy_expression x0) | Ast_409.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> Ast_408.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (Option.map copy_expression x2)) | Ast_409.Parsetree.Pexp_sequence (x0, x1) -> Ast_408.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_while (x0, x1) -> Ast_408.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> Ast_408.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | Ast_409.Parsetree.Pexp_constraint (x0, x1) -> Ast_408.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | Ast_409.Parsetree.Pexp_coerce (x0, x1, x2) -> Ast_408.Parsetree.Pexp_coerce ((copy_expression x0), (Option.map copy_core_type x1), (copy_core_type x2)) | Ast_409.Parsetree.Pexp_send (x0, x1) -> Ast_408.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | Ast_409.Parsetree.Pexp_new x0 -> Ast_408.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pexp_setinstvar (x0, x1) -> Ast_408.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_override x0 -> Ast_408.Parsetree.Pexp_override (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | Ast_409.Parsetree.Pexp_letmodule (x0, x1, x2) -> Ast_408.Parsetree.Pexp_letmodule ((copy_loc (fun x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_letexception (x0, x1) -> Ast_408.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_assert x0 -> Ast_408.Parsetree.Pexp_assert (copy_expression x0) | Ast_409.Parsetree.Pexp_lazy x0 -> Ast_408.Parsetree.Pexp_lazy (copy_expression x0) | Ast_409.Parsetree.Pexp_poly (x0, x1) -> Ast_408.Parsetree.Pexp_poly ((copy_expression x0), (Option.map copy_core_type x1)) | Ast_409.Parsetree.Pexp_object x0 -> Ast_408.Parsetree.Pexp_object (copy_class_structure x0) | Ast_409.Parsetree.Pexp_newtype (x0, x1) -> Ast_408.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_pack x0 -> Ast_408.Parsetree.Pexp_pack (copy_module_expr x0) | Ast_409.Parsetree.Pexp_open (x0, x1) -> Ast_408.Parsetree.Pexp_open ((copy_open_declaration x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_letop x0 -> Ast_408.Parsetree.Pexp_letop (copy_letop x0) | Ast_409.Parsetree.Pexp_extension x0 -> Ast_408.Parsetree.Pexp_extension (copy_extension x0) | Ast_409.Parsetree.Pexp_unreachable -> Ast_408.Parsetree.Pexp_unreachable and copy_letop : Ast_409.Parsetree.letop -> Ast_408.Parsetree.letop = fun { Ast_409.Parsetree.let_ = let_; Ast_409.Parsetree.ands = ands; Ast_409.Parsetree.body = body } -> { Ast_408.Parsetree.let_ = (copy_binding_op let_); Ast_408.Parsetree.ands = (List.map copy_binding_op ands); Ast_408.Parsetree.body = (copy_expression body) } and copy_binding_op : Ast_409.Parsetree.binding_op -> Ast_408.Parsetree.binding_op = fun { Ast_409.Parsetree.pbop_op = pbop_op; Ast_409.Parsetree.pbop_pat = pbop_pat; Ast_409.Parsetree.pbop_exp = pbop_exp; Ast_409.Parsetree.pbop_loc = pbop_loc } -> { Ast_408.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); Ast_408.Parsetree.pbop_pat = (copy_pattern pbop_pat); Ast_408.Parsetree.pbop_exp = (copy_expression pbop_exp); Ast_408.Parsetree.pbop_loc = (copy_location pbop_loc) } and copy_direction_flag : Ast_409.Asttypes.direction_flag -> Ast_408.Asttypes.direction_flag = function | Ast_409.Asttypes.Upto -> Ast_408.Asttypes.Upto | Ast_409.Asttypes.Downto -> Ast_408.Asttypes.Downto and copy_cases : Ast_409.Parsetree.cases -> Ast_408.Parsetree.cases = fun x -> List.map copy_case x and copy_case : Ast_409.Parsetree.case -> Ast_408.Parsetree.case = fun { Ast_409.Parsetree.pc_lhs = pc_lhs; Ast_409.Parsetree.pc_guard = pc_guard; Ast_409.Parsetree.pc_rhs = pc_rhs } -> { Ast_408.Parsetree.pc_lhs = (copy_pattern pc_lhs); Ast_408.Parsetree.pc_guard = (Option.map copy_expression pc_guard); Ast_408.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : Ast_409.Parsetree.value_binding -> Ast_408.Parsetree.value_binding = fun { Ast_409.Parsetree.pvb_pat = pvb_pat; Ast_409.Parsetree.pvb_expr = pvb_expr; Ast_409.Parsetree.pvb_attributes = pvb_attributes; Ast_409.Parsetree.pvb_loc = pvb_loc } -> { Ast_408.Parsetree.pvb_pat = (copy_pattern pvb_pat); Ast_408.Parsetree.pvb_expr = (copy_expression pvb_expr); Ast_408.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); Ast_408.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : Ast_409.Parsetree.pattern -> Ast_408.Parsetree.pattern = fun { Ast_409.Parsetree.ppat_desc = ppat_desc; Ast_409.Parsetree.ppat_loc = ppat_loc; Ast_409.Parsetree.ppat_loc_stack = ppat_loc_stack; Ast_409.Parsetree.ppat_attributes = ppat_attributes } -> { Ast_408.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); Ast_408.Parsetree.ppat_loc = (copy_location ppat_loc); Ast_408.Parsetree.ppat_loc_stack = (List.map copy_location ppat_loc_stack); Ast_408.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : Ast_409.Parsetree.pattern_desc -> Ast_408.Parsetree.pattern_desc = function | Ast_409.Parsetree.Ppat_any -> Ast_408.Parsetree.Ppat_any | Ast_409.Parsetree.Ppat_var x0 -> Ast_408.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | Ast_409.Parsetree.Ppat_alias (x0, x1) -> Ast_408.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | Ast_409.Parsetree.Ppat_constant x0 -> Ast_408.Parsetree.Ppat_constant (copy_constant x0) | Ast_409.Parsetree.Ppat_interval (x0, x1) -> Ast_408.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | Ast_409.Parsetree.Ppat_tuple x0 -> Ast_408.Parsetree.Ppat_tuple (List.map copy_pattern x0) | Ast_409.Parsetree.Ppat_construct (x0, x1) -> Ast_408.Parsetree.Ppat_construct ((copy_loc copy_Longident_t x0), (Option.map copy_pattern x1)) | Ast_409.Parsetree.Ppat_variant (x0, x1) -> Ast_408.Parsetree.Ppat_variant ((copy_label x0), (Option.map copy_pattern x1)) | Ast_409.Parsetree.Ppat_record (x0, x1) -> Ast_408.Parsetree.Ppat_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | Ast_409.Parsetree.Ppat_array x0 -> Ast_408.Parsetree.Ppat_array (List.map copy_pattern x0) | Ast_409.Parsetree.Ppat_or (x0, x1) -> Ast_408.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | Ast_409.Parsetree.Ppat_constraint (x0, x1) -> Ast_408.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | Ast_409.Parsetree.Ppat_type x0 -> Ast_408.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Ppat_lazy x0 -> Ast_408.Parsetree.Ppat_lazy (copy_pattern x0) | Ast_409.Parsetree.Ppat_unpack x0 -> Ast_408.Parsetree.Ppat_unpack (copy_loc (fun x -> x) x0) | Ast_409.Parsetree.Ppat_exception x0 -> Ast_408.Parsetree.Ppat_exception (copy_pattern x0) | Ast_409.Parsetree.Ppat_extension x0 -> Ast_408.Parsetree.Ppat_extension (copy_extension x0) | Ast_409.Parsetree.Ppat_open (x0, x1) -> Ast_408.Parsetree.Ppat_open ((copy_loc copy_Longident_t x0), (copy_pattern x1)) and copy_core_type : Ast_409.Parsetree.core_type -> Ast_408.Parsetree.core_type = fun { Ast_409.Parsetree.ptyp_desc = ptyp_desc; Ast_409.Parsetree.ptyp_loc = ptyp_loc; Ast_409.Parsetree.ptyp_loc_stack = ptyp_loc_stack; Ast_409.Parsetree.ptyp_attributes = ptyp_attributes } -> { Ast_408.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); Ast_408.Parsetree.ptyp_loc = (copy_location ptyp_loc); Ast_408.Parsetree.ptyp_loc_stack = (List.map copy_location ptyp_loc_stack); Ast_408.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : Ast_409.Parsetree.core_type_desc -> Ast_408.Parsetree.core_type_desc = function | Ast_409.Parsetree.Ptyp_any -> Ast_408.Parsetree.Ptyp_any | Ast_409.Parsetree.Ptyp_var x0 -> Ast_408.Parsetree.Ptyp_var x0 | Ast_409.Parsetree.Ptyp_arrow (x0, x1, x2) -> Ast_408.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | Ast_409.Parsetree.Ptyp_tuple x0 -> Ast_408.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | Ast_409.Parsetree.Ptyp_constr (x0, x1) -> Ast_408.Parsetree.Ptyp_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Ptyp_object (x0, x1) -> Ast_408.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | Ast_409.Parsetree.Ptyp_class (x0, x1) -> Ast_408.Parsetree.Ptyp_class ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Ptyp_alias (x0, x1) -> Ast_408.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | Ast_409.Parsetree.Ptyp_variant (x0, x1, x2) -> Ast_408.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (Option.map (fun x -> List.map copy_label x) x2)) | Ast_409.Parsetree.Ptyp_poly (x0, x1) -> Ast_408.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | Ast_409.Parsetree.Ptyp_package x0 -> Ast_408.Parsetree.Ptyp_package (copy_package_type x0) | Ast_409.Parsetree.Ptyp_extension x0 -> Ast_408.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : Ast_409.Parsetree.package_type -> Ast_408.Parsetree.package_type = fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) and copy_row_field : Ast_409.Parsetree.row_field -> Ast_408.Parsetree.row_field = fun { Ast_409.Parsetree.prf_desc = prf_desc; Ast_409.Parsetree.prf_loc = prf_loc; Ast_409.Parsetree.prf_attributes = prf_attributes } -> { Ast_408.Parsetree.prf_desc = (copy_row_field_desc prf_desc); Ast_408.Parsetree.prf_loc = (copy_location prf_loc); Ast_408.Parsetree.prf_attributes = (copy_attributes prf_attributes) } and copy_row_field_desc : Ast_409.Parsetree.row_field_desc -> Ast_408.Parsetree.row_field_desc = function | Ast_409.Parsetree.Rtag (x0, x1, x2) -> Ast_408.Parsetree.Rtag ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) | Ast_409.Parsetree.Rinherit x0 -> Ast_408.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : Ast_409.Parsetree.object_field -> Ast_408.Parsetree.object_field = fun { Ast_409.Parsetree.pof_desc = pof_desc; Ast_409.Parsetree.pof_loc = pof_loc; Ast_409.Parsetree.pof_attributes = pof_attributes } -> { Ast_408.Parsetree.pof_desc = (copy_object_field_desc pof_desc); Ast_408.Parsetree.pof_loc = (copy_location pof_loc); Ast_408.Parsetree.pof_attributes = (copy_attributes pof_attributes) } and copy_attributes : Ast_409.Parsetree.attributes -> Ast_408.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : Ast_409.Parsetree.attribute -> Ast_408.Parsetree.attribute = fun { Ast_409.Parsetree.attr_name = attr_name; Ast_409.Parsetree.attr_payload = attr_payload; Ast_409.Parsetree.attr_loc = attr_loc } -> { Ast_408.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); Ast_408.Parsetree.attr_payload = (copy_payload attr_payload); Ast_408.Parsetree.attr_loc = (copy_location attr_loc) } and copy_payload : Ast_409.Parsetree.payload -> Ast_408.Parsetree.payload = function | Ast_409.Parsetree.PStr x0 -> Ast_408.Parsetree.PStr (copy_structure x0) | Ast_409.Parsetree.PSig x0 -> Ast_408.Parsetree.PSig (copy_signature x0) | Ast_409.Parsetree.PTyp x0 -> Ast_408.Parsetree.PTyp (copy_core_type x0) | Ast_409.Parsetree.PPat (x0, x1) -> Ast_408.Parsetree.PPat ((copy_pattern x0), (Option.map copy_expression x1)) and copy_structure : Ast_409.Parsetree.structure -> Ast_408.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : Ast_409.Parsetree.structure_item -> Ast_408.Parsetree.structure_item = fun { Ast_409.Parsetree.pstr_desc = pstr_desc; Ast_409.Parsetree.pstr_loc = pstr_loc } -> { Ast_408.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); Ast_408.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : Ast_409.Parsetree.structure_item_desc -> Ast_408.Parsetree.structure_item_desc = function | Ast_409.Parsetree.Pstr_eval (x0, x1) -> Ast_408.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | Ast_409.Parsetree.Pstr_value (x0, x1) -> Ast_408.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | Ast_409.Parsetree.Pstr_primitive x0 -> Ast_408.Parsetree.Pstr_primitive (copy_value_description x0) | Ast_409.Parsetree.Pstr_type (x0, x1) -> Ast_408.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_409.Parsetree.Pstr_typext x0 -> Ast_408.Parsetree.Pstr_typext (copy_type_extension x0) | Ast_409.Parsetree.Pstr_exception x0 -> Ast_408.Parsetree.Pstr_exception (copy_type_exception x0) | Ast_409.Parsetree.Pstr_module x0 -> Ast_408.Parsetree.Pstr_module (copy_module_binding x0) | Ast_409.Parsetree.Pstr_recmodule x0 -> Ast_408.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | Ast_409.Parsetree.Pstr_modtype x0 -> Ast_408.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | Ast_409.Parsetree.Pstr_open x0 -> Ast_408.Parsetree.Pstr_open (copy_open_declaration x0) | Ast_409.Parsetree.Pstr_class x0 -> Ast_408.Parsetree.Pstr_class (List.map copy_class_declaration x0) | Ast_409.Parsetree.Pstr_class_type x0 -> Ast_408.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | Ast_409.Parsetree.Pstr_include x0 -> Ast_408.Parsetree.Pstr_include (copy_include_declaration x0) | Ast_409.Parsetree.Pstr_attribute x0 -> Ast_408.Parsetree.Pstr_attribute (copy_attribute x0) | Ast_409.Parsetree.Pstr_extension (x0, x1) -> Ast_408.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : Ast_409.Parsetree.include_declaration -> Ast_408.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : Ast_409.Parsetree.class_declaration -> Ast_408.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : Ast_409.Parsetree.class_expr -> Ast_408.Parsetree.class_expr = fun { Ast_409.Parsetree.pcl_desc = pcl_desc; Ast_409.Parsetree.pcl_loc = pcl_loc; Ast_409.Parsetree.pcl_attributes = pcl_attributes } -> { Ast_408.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); Ast_408.Parsetree.pcl_loc = (copy_location pcl_loc); Ast_408.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : Ast_409.Parsetree.class_expr_desc -> Ast_408.Parsetree.class_expr_desc = function | Ast_409.Parsetree.Pcl_constr (x0, x1) -> Ast_408.Parsetree.Pcl_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Pcl_structure x0 -> Ast_408.Parsetree.Pcl_structure (copy_class_structure x0) | Ast_409.Parsetree.Pcl_fun (x0, x1, x2, x3) -> Ast_408.Parsetree.Pcl_fun ((copy_arg_label x0), (Option.map copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | Ast_409.Parsetree.Pcl_apply (x0, x1) -> Ast_408.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_409.Parsetree.Pcl_let (x0, x1, x2) -> Ast_408.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | Ast_409.Parsetree.Pcl_constraint (x0, x1) -> Ast_408.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | Ast_409.Parsetree.Pcl_extension x0 -> Ast_408.Parsetree.Pcl_extension (copy_extension x0) | Ast_409.Parsetree.Pcl_open (x0, x1) -> Ast_408.Parsetree.Pcl_open ((copy_open_description x0), (copy_class_expr x1)) and copy_class_structure : Ast_409.Parsetree.class_structure -> Ast_408.Parsetree.class_structure = fun { Ast_409.Parsetree.pcstr_self = pcstr_self; Ast_409.Parsetree.pcstr_fields = pcstr_fields } -> { Ast_408.Parsetree.pcstr_self = (copy_pattern pcstr_self); Ast_408.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : Ast_409.Parsetree.class_field -> Ast_408.Parsetree.class_field = fun { Ast_409.Parsetree.pcf_desc = pcf_desc; Ast_409.Parsetree.pcf_loc = pcf_loc; Ast_409.Parsetree.pcf_attributes = pcf_attributes } -> { Ast_408.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); Ast_408.Parsetree.pcf_loc = (copy_location pcf_loc); Ast_408.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : Ast_409.Parsetree.class_field_desc -> Ast_408.Parsetree.class_field_desc = function | Ast_409.Parsetree.Pcf_inherit (x0, x1, x2) -> Ast_408.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (Option.map (fun x -> copy_loc (fun x -> x) x) x2)) | Ast_409.Parsetree.Pcf_val x0 -> Ast_408.Parsetree.Pcf_val (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | Ast_409.Parsetree.Pcf_method x0 -> Ast_408.Parsetree.Pcf_method (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | Ast_409.Parsetree.Pcf_constraint x0 -> Ast_408.Parsetree.Pcf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_409.Parsetree.Pcf_initializer x0 -> Ast_408.Parsetree.Pcf_initializer (copy_expression x0) | Ast_409.Parsetree.Pcf_attribute x0 -> Ast_408.Parsetree.Pcf_attribute (copy_attribute x0) | Ast_409.Parsetree.Pcf_extension x0 -> Ast_408.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : Ast_409.Parsetree.class_field_kind -> Ast_408.Parsetree.class_field_kind = function | Ast_409.Parsetree.Cfk_virtual x0 -> Ast_408.Parsetree.Cfk_virtual (copy_core_type x0) | Ast_409.Parsetree.Cfk_concrete (x0, x1) -> Ast_408.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_open_declaration : Ast_409.Parsetree.open_declaration -> Ast_408.Parsetree.open_declaration = fun x -> copy_open_infos copy_module_expr x and copy_module_binding : Ast_409.Parsetree.module_binding -> Ast_408.Parsetree.module_binding = fun { Ast_409.Parsetree.pmb_name = pmb_name; Ast_409.Parsetree.pmb_expr = pmb_expr; Ast_409.Parsetree.pmb_attributes = pmb_attributes; Ast_409.Parsetree.pmb_loc = pmb_loc } -> { Ast_408.Parsetree.pmb_name = (copy_loc (fun x -> x) pmb_name); Ast_408.Parsetree.pmb_expr = (copy_module_expr pmb_expr); Ast_408.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); Ast_408.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : Ast_409.Parsetree.module_expr -> Ast_408.Parsetree.module_expr = fun { Ast_409.Parsetree.pmod_desc = pmod_desc; Ast_409.Parsetree.pmod_loc = pmod_loc; Ast_409.Parsetree.pmod_attributes = pmod_attributes } -> { Ast_408.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); Ast_408.Parsetree.pmod_loc = (copy_location pmod_loc); Ast_408.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : Ast_409.Parsetree.module_expr_desc -> Ast_408.Parsetree.module_expr_desc = function | Ast_409.Parsetree.Pmod_ident x0 -> Ast_408.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pmod_structure x0 -> Ast_408.Parsetree.Pmod_structure (copy_structure x0) | Ast_409.Parsetree.Pmod_functor (x0, x1, x2) -> Ast_408.Parsetree.Pmod_functor ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), (copy_module_expr x2)) | Ast_409.Parsetree.Pmod_apply (x0, x1) -> Ast_408.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | Ast_409.Parsetree.Pmod_constraint (x0, x1) -> Ast_408.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | Ast_409.Parsetree.Pmod_unpack x0 -> Ast_408.Parsetree.Pmod_unpack (copy_expression x0) | Ast_409.Parsetree.Pmod_extension x0 -> Ast_408.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : Ast_409.Parsetree.module_type -> Ast_408.Parsetree.module_type = fun { Ast_409.Parsetree.pmty_desc = pmty_desc; Ast_409.Parsetree.pmty_loc = pmty_loc; Ast_409.Parsetree.pmty_attributes = pmty_attributes } -> { Ast_408.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); Ast_408.Parsetree.pmty_loc = (copy_location pmty_loc); Ast_408.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : Ast_409.Parsetree.module_type_desc -> Ast_408.Parsetree.module_type_desc = function | Ast_409.Parsetree.Pmty_ident x0 -> Ast_408.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pmty_signature x0 -> Ast_408.Parsetree.Pmty_signature (copy_signature x0) | Ast_409.Parsetree.Pmty_functor (x0, x1, x2) -> Ast_408.Parsetree.Pmty_functor ((copy_loc (fun x -> x) x0), (Option.map copy_module_type x1), (copy_module_type x2)) | Ast_409.Parsetree.Pmty_with (x0, x1) -> Ast_408.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | Ast_409.Parsetree.Pmty_typeof x0 -> Ast_408.Parsetree.Pmty_typeof (copy_module_expr x0) | Ast_409.Parsetree.Pmty_extension x0 -> Ast_408.Parsetree.Pmty_extension (copy_extension x0) | Ast_409.Parsetree.Pmty_alias x0 -> Ast_408.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) and copy_with_constraint : Ast_409.Parsetree.with_constraint -> Ast_408.Parsetree.with_constraint = function | Ast_409.Parsetree.Pwith_type (x0, x1) -> Ast_408.Parsetree.Pwith_type ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_409.Parsetree.Pwith_module (x0, x1) -> Ast_408.Parsetree.Pwith_module ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) | Ast_409.Parsetree.Pwith_typesubst (x0, x1) -> Ast_408.Parsetree.Pwith_typesubst ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_409.Parsetree.Pwith_modsubst (x0, x1) -> Ast_408.Parsetree.Pwith_modsubst ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) and copy_signature : Ast_409.Parsetree.signature -> Ast_408.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : Ast_409.Parsetree.signature_item -> Ast_408.Parsetree.signature_item = fun { Ast_409.Parsetree.psig_desc = psig_desc; Ast_409.Parsetree.psig_loc = psig_loc } -> { Ast_408.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); Ast_408.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : Ast_409.Parsetree.signature_item_desc -> Ast_408.Parsetree.signature_item_desc = function | Ast_409.Parsetree.Psig_value x0 -> Ast_408.Parsetree.Psig_value (copy_value_description x0) | Ast_409.Parsetree.Psig_type (x0, x1) -> Ast_408.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_409.Parsetree.Psig_typesubst x0 -> Ast_408.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) | Ast_409.Parsetree.Psig_typext x0 -> Ast_408.Parsetree.Psig_typext (copy_type_extension x0) | Ast_409.Parsetree.Psig_exception x0 -> Ast_408.Parsetree.Psig_exception (copy_type_exception x0) | Ast_409.Parsetree.Psig_module x0 -> Ast_408.Parsetree.Psig_module (copy_module_declaration x0) | Ast_409.Parsetree.Psig_modsubst x0 -> Ast_408.Parsetree.Psig_modsubst (copy_module_substitution x0) | Ast_409.Parsetree.Psig_recmodule x0 -> Ast_408.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | Ast_409.Parsetree.Psig_modtype x0 -> Ast_408.Parsetree.Psig_modtype (copy_module_type_declaration x0) | Ast_409.Parsetree.Psig_open x0 -> Ast_408.Parsetree.Psig_open (copy_open_description x0) | Ast_409.Parsetree.Psig_include x0 -> Ast_408.Parsetree.Psig_include (copy_include_description x0) | Ast_409.Parsetree.Psig_class x0 -> Ast_408.Parsetree.Psig_class (List.map copy_class_description x0) | Ast_409.Parsetree.Psig_class_type x0 -> Ast_408.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | Ast_409.Parsetree.Psig_attribute x0 -> Ast_408.Parsetree.Psig_attribute (copy_attribute x0) | Ast_409.Parsetree.Psig_extension (x0, x1) -> Ast_408.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : Ast_409.Parsetree.class_type_declaration -> Ast_408.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : Ast_409.Parsetree.class_description -> Ast_408.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : Ast_409.Parsetree.class_type -> Ast_408.Parsetree.class_type = fun { Ast_409.Parsetree.pcty_desc = pcty_desc; Ast_409.Parsetree.pcty_loc = pcty_loc; Ast_409.Parsetree.pcty_attributes = pcty_attributes } -> { Ast_408.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); Ast_408.Parsetree.pcty_loc = (copy_location pcty_loc); Ast_408.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : Ast_409.Parsetree.class_type_desc -> Ast_408.Parsetree.class_type_desc = function | Ast_409.Parsetree.Pcty_constr (x0, x1) -> Ast_408.Parsetree.Pcty_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Pcty_signature x0 -> Ast_408.Parsetree.Pcty_signature (copy_class_signature x0) | Ast_409.Parsetree.Pcty_arrow (x0, x1, x2) -> Ast_408.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | Ast_409.Parsetree.Pcty_extension x0 -> Ast_408.Parsetree.Pcty_extension (copy_extension x0) | Ast_409.Parsetree.Pcty_open (x0, x1) -> Ast_408.Parsetree.Pcty_open ((copy_open_description x0), (copy_class_type x1)) and copy_class_signature : Ast_409.Parsetree.class_signature -> Ast_408.Parsetree.class_signature = fun { Ast_409.Parsetree.pcsig_self = pcsig_self; Ast_409.Parsetree.pcsig_fields = pcsig_fields } -> { Ast_408.Parsetree.pcsig_self = (copy_core_type pcsig_self); Ast_408.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : Ast_409.Parsetree.class_type_field -> Ast_408.Parsetree.class_type_field = fun { Ast_409.Parsetree.pctf_desc = pctf_desc; Ast_409.Parsetree.pctf_loc = pctf_loc; Ast_409.Parsetree.pctf_attributes = pctf_attributes } -> { Ast_408.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); Ast_408.Parsetree.pctf_loc = (copy_location pctf_loc); Ast_408.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : Ast_409.Parsetree.class_type_field_desc -> Ast_408.Parsetree.class_type_field_desc = function | Ast_409.Parsetree.Pctf_inherit x0 -> Ast_408.Parsetree.Pctf_inherit (copy_class_type x0) | Ast_409.Parsetree.Pctf_val x0 -> Ast_408.Parsetree.Pctf_val (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_409.Parsetree.Pctf_method x0 -> Ast_408.Parsetree.Pctf_method (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_409.Parsetree.Pctf_constraint x0 -> Ast_408.Parsetree.Pctf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_409.Parsetree.Pctf_attribute x0 -> Ast_408.Parsetree.Pctf_attribute (copy_attribute x0) | Ast_409.Parsetree.Pctf_extension x0 -> Ast_408.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : Ast_409.Parsetree.extension -> Ast_408.Parsetree.extension = fun x -> let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.class_infos -> 'g0 Ast_408.Parsetree.class_infos = fun f0 -> fun { Ast_409.Parsetree.pci_virt = pci_virt; Ast_409.Parsetree.pci_params = pci_params; Ast_409.Parsetree.pci_name = pci_name; Ast_409.Parsetree.pci_expr = pci_expr; Ast_409.Parsetree.pci_loc = pci_loc; Ast_409.Parsetree.pci_attributes = pci_attributes } -> { Ast_408.Parsetree.pci_virt = (copy_virtual_flag pci_virt); Ast_408.Parsetree.pci_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); Ast_408.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); Ast_408.Parsetree.pci_expr = (f0 pci_expr); Ast_408.Parsetree.pci_loc = (copy_location pci_loc); Ast_408.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : Ast_409.Asttypes.virtual_flag -> Ast_408.Asttypes.virtual_flag = function | Ast_409.Asttypes.Virtual -> Ast_408.Asttypes.Virtual | Ast_409.Asttypes.Concrete -> Ast_408.Asttypes.Concrete and copy_include_description : Ast_409.Parsetree.include_description -> Ast_408.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.include_infos -> 'g0 Ast_408.Parsetree.include_infos = fun f0 -> fun { Ast_409.Parsetree.pincl_mod = pincl_mod; Ast_409.Parsetree.pincl_loc = pincl_loc; Ast_409.Parsetree.pincl_attributes = pincl_attributes } -> { Ast_408.Parsetree.pincl_mod = (f0 pincl_mod); Ast_408.Parsetree.pincl_loc = (copy_location pincl_loc); Ast_408.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : Ast_409.Parsetree.open_description -> Ast_408.Parsetree.open_description = fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x and copy_open_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.open_infos -> 'g0 Ast_408.Parsetree.open_infos = fun f0 -> fun { Ast_409.Parsetree.popen_expr = popen_expr; Ast_409.Parsetree.popen_override = popen_override; Ast_409.Parsetree.popen_loc = popen_loc; Ast_409.Parsetree.popen_attributes = popen_attributes } -> { Ast_408.Parsetree.popen_expr = (f0 popen_expr); Ast_408.Parsetree.popen_override = (copy_override_flag popen_override); Ast_408.Parsetree.popen_loc = (copy_location popen_loc); Ast_408.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : Ast_409.Asttypes.override_flag -> Ast_408.Asttypes.override_flag = function | Ast_409.Asttypes.Override -> Ast_408.Asttypes.Override | Ast_409.Asttypes.Fresh -> Ast_408.Asttypes.Fresh and copy_module_type_declaration : Ast_409.Parsetree.module_type_declaration -> Ast_408.Parsetree.module_type_declaration = fun { Ast_409.Parsetree.pmtd_name = pmtd_name; Ast_409.Parsetree.pmtd_type = pmtd_type; Ast_409.Parsetree.pmtd_attributes = pmtd_attributes; Ast_409.Parsetree.pmtd_loc = pmtd_loc } -> { Ast_408.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); Ast_408.Parsetree.pmtd_type = (Option.map copy_module_type pmtd_type); Ast_408.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); Ast_408.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_substitution : Ast_409.Parsetree.module_substitution -> Ast_408.Parsetree.module_substitution = fun { Ast_409.Parsetree.pms_name = pms_name; Ast_409.Parsetree.pms_manifest = pms_manifest; Ast_409.Parsetree.pms_attributes = pms_attributes; Ast_409.Parsetree.pms_loc = pms_loc } -> { Ast_408.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); Ast_408.Parsetree.pms_manifest = (copy_loc copy_Longident_t pms_manifest); Ast_408.Parsetree.pms_attributes = (copy_attributes pms_attributes); Ast_408.Parsetree.pms_loc = (copy_location pms_loc) } and copy_module_declaration : Ast_409.Parsetree.module_declaration -> Ast_408.Parsetree.module_declaration = fun { Ast_409.Parsetree.pmd_name = pmd_name; Ast_409.Parsetree.pmd_type = pmd_type; Ast_409.Parsetree.pmd_attributes = pmd_attributes; Ast_409.Parsetree.pmd_loc = pmd_loc } -> { Ast_408.Parsetree.pmd_name = (copy_loc (fun x -> x) pmd_name); Ast_408.Parsetree.pmd_type = (copy_module_type pmd_type); Ast_408.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); Ast_408.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_exception : Ast_409.Parsetree.type_exception -> Ast_408.Parsetree.type_exception = fun { Ast_409.Parsetree.ptyexn_constructor = ptyexn_constructor; Ast_409.Parsetree.ptyexn_loc = ptyexn_loc; Ast_409.Parsetree.ptyexn_attributes = ptyexn_attributes } -> { Ast_408.Parsetree.ptyexn_constructor = (copy_extension_constructor ptyexn_constructor); Ast_408.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); Ast_408.Parsetree.ptyexn_attributes = (copy_attributes ptyexn_attributes) } and copy_type_extension : Ast_409.Parsetree.type_extension -> Ast_408.Parsetree.type_extension = fun { Ast_409.Parsetree.ptyext_path = ptyext_path; Ast_409.Parsetree.ptyext_params = ptyext_params; Ast_409.Parsetree.ptyext_constructors = ptyext_constructors; Ast_409.Parsetree.ptyext_private = ptyext_private; Ast_409.Parsetree.ptyext_loc = ptyext_loc; Ast_409.Parsetree.ptyext_attributes = ptyext_attributes } -> { Ast_408.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); Ast_408.Parsetree.ptyext_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); Ast_408.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); Ast_408.Parsetree.ptyext_private = (copy_private_flag ptyext_private); Ast_408.Parsetree.ptyext_loc = (copy_location ptyext_loc); Ast_408.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : Ast_409.Parsetree.extension_constructor -> Ast_408.Parsetree.extension_constructor = fun { Ast_409.Parsetree.pext_name = pext_name; Ast_409.Parsetree.pext_kind = pext_kind; Ast_409.Parsetree.pext_loc = pext_loc; Ast_409.Parsetree.pext_attributes = pext_attributes } -> { Ast_408.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); Ast_408.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); Ast_408.Parsetree.pext_loc = (copy_location pext_loc); Ast_408.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : Ast_409.Parsetree.extension_constructor_kind -> Ast_408.Parsetree.extension_constructor_kind = function | Ast_409.Parsetree.Pext_decl (x0, x1) -> Ast_408.Parsetree.Pext_decl ((copy_constructor_arguments x0), (Option.map copy_core_type x1)) | Ast_409.Parsetree.Pext_rebind x0 -> Ast_408.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) and copy_type_declaration : Ast_409.Parsetree.type_declaration -> Ast_408.Parsetree.type_declaration = fun { Ast_409.Parsetree.ptype_name = ptype_name; Ast_409.Parsetree.ptype_params = ptype_params; Ast_409.Parsetree.ptype_cstrs = ptype_cstrs; Ast_409.Parsetree.ptype_kind = ptype_kind; Ast_409.Parsetree.ptype_private = ptype_private; Ast_409.Parsetree.ptype_manifest = ptype_manifest; Ast_409.Parsetree.ptype_attributes = ptype_attributes; Ast_409.Parsetree.ptype_loc = ptype_loc } -> { Ast_408.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); Ast_408.Parsetree.ptype_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); Ast_408.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0, x1, x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); Ast_408.Parsetree.ptype_kind = (copy_type_kind ptype_kind); Ast_408.Parsetree.ptype_private = (copy_private_flag ptype_private); Ast_408.Parsetree.ptype_manifest = (Option.map copy_core_type ptype_manifest); Ast_408.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); Ast_408.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : Ast_409.Asttypes.private_flag -> Ast_408.Asttypes.private_flag = function | Ast_409.Asttypes.Private -> Ast_408.Asttypes.Private | Ast_409.Asttypes.Public -> Ast_408.Asttypes.Public and copy_type_kind : Ast_409.Parsetree.type_kind -> Ast_408.Parsetree.type_kind = function | Ast_409.Parsetree.Ptype_abstract -> Ast_408.Parsetree.Ptype_abstract | Ast_409.Parsetree.Ptype_variant x0 -> Ast_408.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | Ast_409.Parsetree.Ptype_record x0 -> Ast_408.Parsetree.Ptype_record (List.map copy_label_declaration x0) | Ast_409.Parsetree.Ptype_open -> Ast_408.Parsetree.Ptype_open and copy_constructor_declaration : Ast_409.Parsetree.constructor_declaration -> Ast_408.Parsetree.constructor_declaration = fun { Ast_409.Parsetree.pcd_name = pcd_name; Ast_409.Parsetree.pcd_args = pcd_args; Ast_409.Parsetree.pcd_res = pcd_res; Ast_409.Parsetree.pcd_loc = pcd_loc; Ast_409.Parsetree.pcd_attributes = pcd_attributes } -> { Ast_408.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); Ast_408.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); Ast_408.Parsetree.pcd_res = (Option.map copy_core_type pcd_res); Ast_408.Parsetree.pcd_loc = (copy_location pcd_loc); Ast_408.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : Ast_409.Parsetree.constructor_arguments -> Ast_408.Parsetree.constructor_arguments = function | Ast_409.Parsetree.Pcstr_tuple x0 -> Ast_408.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | Ast_409.Parsetree.Pcstr_record x0 -> Ast_408.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : Ast_409.Parsetree.label_declaration -> Ast_408.Parsetree.label_declaration = fun { Ast_409.Parsetree.pld_name = pld_name; Ast_409.Parsetree.pld_mutable = pld_mutable; Ast_409.Parsetree.pld_type = pld_type; Ast_409.Parsetree.pld_loc = pld_loc; Ast_409.Parsetree.pld_attributes = pld_attributes } -> { Ast_408.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); Ast_408.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); Ast_408.Parsetree.pld_type = (copy_core_type pld_type); Ast_408.Parsetree.pld_loc = (copy_location pld_loc); Ast_408.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : Ast_409.Asttypes.mutable_flag -> Ast_408.Asttypes.mutable_flag = function | Ast_409.Asttypes.Immutable -> Ast_408.Asttypes.Immutable | Ast_409.Asttypes.Mutable -> Ast_408.Asttypes.Mutable and copy_variance : Ast_409.Asttypes.variance -> Ast_408.Asttypes.variance = function | Ast_409.Asttypes.Covariant -> Ast_408.Asttypes.Covariant | Ast_409.Asttypes.Contravariant -> Ast_408.Asttypes.Contravariant | Ast_409.Asttypes.Invariant -> Ast_408.Asttypes.Invariant and copy_value_description : Ast_409.Parsetree.value_description -> Ast_408.Parsetree.value_description = fun { Ast_409.Parsetree.pval_name = pval_name; Ast_409.Parsetree.pval_type = pval_type; Ast_409.Parsetree.pval_prim = pval_prim; Ast_409.Parsetree.pval_attributes = pval_attributes; Ast_409.Parsetree.pval_loc = pval_loc } -> { Ast_408.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); Ast_408.Parsetree.pval_type = (copy_core_type pval_type); Ast_408.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); Ast_408.Parsetree.pval_attributes = (copy_attributes pval_attributes); Ast_408.Parsetree.pval_loc = (copy_location pval_loc) } and copy_object_field_desc : Ast_409.Parsetree.object_field_desc -> Ast_408.Parsetree.object_field_desc = function | Ast_409.Parsetree.Otag (x0, x1) -> Ast_408.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) | Ast_409.Parsetree.Oinherit x0 -> Ast_408.Parsetree.Oinherit (copy_core_type x0) and copy_arg_label : Ast_409.Asttypes.arg_label -> Ast_408.Asttypes.arg_label = function | Ast_409.Asttypes.Nolabel -> Ast_408.Asttypes.Nolabel | Ast_409.Asttypes.Labelled x0 -> Ast_408.Asttypes.Labelled x0 | Ast_409.Asttypes.Optional x0 -> Ast_408.Asttypes.Optional x0 and copy_closed_flag : Ast_409.Asttypes.closed_flag -> Ast_408.Asttypes.closed_flag = function | Ast_409.Asttypes.Closed -> Ast_408.Asttypes.Closed | Ast_409.Asttypes.Open -> Ast_408.Asttypes.Open and copy_label : Ast_409.Asttypes.label -> Ast_408.Asttypes.label = fun x -> x and copy_rec_flag : Ast_409.Asttypes.rec_flag -> Ast_408.Asttypes.rec_flag = function | Ast_409.Asttypes.Nonrecursive -> Ast_408.Asttypes.Nonrecursive | Ast_409.Asttypes.Recursive -> Ast_408.Asttypes.Recursive and copy_constant : Ast_409.Parsetree.constant -> Ast_408.Parsetree.constant = function | Ast_409.Parsetree.Pconst_integer (x0, x1) -> Ast_408.Parsetree.Pconst_integer (x0, (Option.map (fun x -> x) x1)) | Ast_409.Parsetree.Pconst_char x0 -> Ast_408.Parsetree.Pconst_char x0 | Ast_409.Parsetree.Pconst_string (x0, x1) -> Ast_408.Parsetree.Pconst_string (x0, (Option.map (fun x -> x) x1)) | Ast_409.Parsetree.Pconst_float (x0, x1) -> Ast_408.Parsetree.Pconst_float (x0, (Option.map (fun x -> x) x1)) and copy_Longident_t : Ast_409.Longident.t -> Ast_408.Longident.t = function | Ast_409.Longident.Lident x0 -> Ast_408.Longident.Lident x0 | Ast_409.Longident.Ldot (x0, x1) -> Ast_408.Longident.Ldot ((copy_Longident_t x0), x1) | Ast_409.Longident.Lapply (x0, x1) -> Ast_408.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Asttypes.loc -> 'g0 Ast_408.Asttypes.loc = fun f0 -> fun { Ast_409.Asttypes.txt = txt; Ast_409.Asttypes.loc = loc } -> { Ast_408.Asttypes.txt = (f0 txt); Ast_408.Asttypes.loc = (copy_location loc) } and copy_location : Ast_409.Location.t -> Ast_408.Location.t = fun { Ast_409.Location.loc_start = loc_start; Ast_409.Location.loc_end = loc_end; Ast_409.Location.loc_ghost = loc_ghost } -> { Ast_408.Location.loc_start = (copy_position loc_start); Ast_408.Location.loc_end = (copy_position loc_end); Ast_408.Location.loc_ghost = loc_ghost } and copy_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_409_410.ml000066400000000000000000000171161356450464700240550ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_409_410_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload"; "binding_op"; "module_substitution"; "open_declaration"; "type_exception" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; binding_op; module_substitution; open_declaration; type_exception; (*$*) } as mapper) -> let module Def = Migrate_parsetree_def in let module R = Migrate_parsetree_410_409_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_409_410_migrate.ml000066400000000000000000002002301356450464700255540ustar00rootroot00000000000000module From = Ast_409 module To = Ast_410 let map_option f x = match x with | None -> None | Some x -> Some (f x) let rec copy_out_type_extension : Ast_409.Outcometree.out_type_extension -> Ast_410.Outcometree.out_type_extension = fun { Ast_409.Outcometree.otyext_name = otyext_name; Ast_409.Outcometree.otyext_params = otyext_params; Ast_409.Outcometree.otyext_constructors = otyext_constructors; Ast_409.Outcometree.otyext_private = otyext_private } -> { Ast_410.Outcometree.otyext_name = otyext_name; Ast_410.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); Ast_410.Outcometree.otyext_constructors = (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (map_option copy_out_type x2))) otyext_constructors); Ast_410.Outcometree.otyext_private = (copy_private_flag otyext_private) } and copy_out_phrase : Ast_409.Outcometree.out_phrase -> Ast_410.Outcometree.out_phrase = function | Ast_409.Outcometree.Ophr_eval (x0, x1) -> Ast_410.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | Ast_409.Outcometree.Ophr_signature x0 -> Ast_410.Outcometree.Ophr_signature (List.map (fun x -> let (x0, x1) = x in ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) | Ast_409.Outcometree.Ophr_exception x0 -> Ast_410.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : Ast_409.Outcometree.out_sig_item -> Ast_410.Outcometree.out_sig_item = function | Ast_409.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> Ast_410.Outcometree.Osig_class (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_409.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> Ast_410.Outcometree.Osig_class_type (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_409.Outcometree.Osig_typext (x0, x1) -> Ast_410.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | Ast_409.Outcometree.Osig_modtype (x0, x1) -> Ast_410.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | Ast_409.Outcometree.Osig_module (x0, x1, x2) -> Ast_410.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | Ast_409.Outcometree.Osig_type (x0, x1) -> Ast_410.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | Ast_409.Outcometree.Osig_value x0 -> Ast_410.Outcometree.Osig_value (copy_out_val_decl x0) | Ast_409.Outcometree.Osig_ellipsis -> Ast_410.Outcometree.Osig_ellipsis and copy_out_val_decl : Ast_409.Outcometree.out_val_decl -> Ast_410.Outcometree.out_val_decl = fun { Ast_409.Outcometree.oval_name = oval_name; Ast_409.Outcometree.oval_type = oval_type; Ast_409.Outcometree.oval_prims = oval_prims; Ast_409.Outcometree.oval_attributes = oval_attributes } -> { Ast_410.Outcometree.oval_name = oval_name; Ast_410.Outcometree.oval_type = (copy_out_type oval_type); Ast_410.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); Ast_410.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : Ast_409.Outcometree.out_type_decl -> Ast_410.Outcometree.out_type_decl = fun { Ast_409.Outcometree.otype_name = otype_name; Ast_409.Outcometree.otype_params = otype_params; Ast_409.Outcometree.otype_type = otype_type; Ast_409.Outcometree.otype_private = otype_private; Ast_409.Outcometree.otype_immediate = otype_immediate; Ast_409.Outcometree.otype_unboxed = otype_unboxed; Ast_409.Outcometree.otype_cstrs = otype_cstrs } -> { Ast_410.Outcometree.otype_name = otype_name; Ast_410.Outcometree.otype_params = (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) otype_params); Ast_410.Outcometree.otype_type = (copy_out_type otype_type); Ast_410.Outcometree.otype_private = (copy_private_flag otype_private); Ast_410.Outcometree.otype_immediate = (if otype_immediate then Always else Unknown); Ast_410.Outcometree.otype_unboxed = otype_unboxed; Ast_410.Outcometree.otype_cstrs = (List.map (fun x -> let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_out_module_type : Ast_409.Outcometree.out_module_type -> Ast_410.Outcometree.out_module_type = function | Ast_409.Outcometree.Omty_abstract -> Ast_410.Outcometree.Omty_abstract | Ast_409.Outcometree.Omty_functor (x0, x1, x2) -> Ast_410.Outcometree.Omty_functor ((match x0, x1 with | "*", None -> None | "_", Some mt -> Some (None, copy_out_module_type mt) | s, Some mt -> Some (Some s, copy_out_module_type mt) |_ -> assert false), copy_out_module_type x2) | Ast_409.Outcometree.Omty_ident x0 -> Ast_410.Outcometree.Omty_ident (copy_out_ident x0) | Ast_409.Outcometree.Omty_signature x0 -> Ast_410.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | Ast_409.Outcometree.Omty_alias x0 -> Ast_410.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : Ast_409.Outcometree.out_ext_status -> Ast_410.Outcometree.out_ext_status = function | Ast_409.Outcometree.Oext_first -> Ast_410.Outcometree.Oext_first | Ast_409.Outcometree.Oext_next -> Ast_410.Outcometree.Oext_next | Ast_409.Outcometree.Oext_exception -> Ast_410.Outcometree.Oext_exception and copy_out_extension_constructor : Ast_409.Outcometree.out_extension_constructor -> Ast_410.Outcometree.out_extension_constructor = fun { Ast_409.Outcometree.oext_name = oext_name; Ast_409.Outcometree.oext_type_name = oext_type_name; Ast_409.Outcometree.oext_type_params = oext_type_params; Ast_409.Outcometree.oext_args = oext_args; Ast_409.Outcometree.oext_ret_type = oext_ret_type; Ast_409.Outcometree.oext_private = oext_private } -> { Ast_410.Outcometree.oext_name = oext_name; Ast_410.Outcometree.oext_type_name = oext_type_name; Ast_410.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); Ast_410.Outcometree.oext_args = (List.map copy_out_type oext_args); Ast_410.Outcometree.oext_ret_type = (map_option copy_out_type oext_ret_type); Ast_410.Outcometree.oext_private = (copy_private_flag oext_private) } and copy_out_rec_status : Ast_409.Outcometree.out_rec_status -> Ast_410.Outcometree.out_rec_status = function | Ast_409.Outcometree.Orec_not -> Ast_410.Outcometree.Orec_not | Ast_409.Outcometree.Orec_first -> Ast_410.Outcometree.Orec_first | Ast_409.Outcometree.Orec_next -> Ast_410.Outcometree.Orec_next and copy_out_class_type : Ast_409.Outcometree.out_class_type -> Ast_410.Outcometree.out_class_type = function | Ast_409.Outcometree.Octy_constr (x0, x1) -> Ast_410.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_409.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_410.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | Ast_409.Outcometree.Octy_signature (x0, x1) -> Ast_410.Outcometree.Octy_signature ((map_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : Ast_409.Outcometree.out_class_sig_item -> Ast_410.Outcometree.out_class_sig_item = function | Ast_409.Outcometree.Ocsg_constraint (x0, x1) -> Ast_410.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | Ast_409.Outcometree.Ocsg_method (x0, x1, x2, x3) -> Ast_410.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) | Ast_409.Outcometree.Ocsg_value (x0, x1, x2, x3) -> Ast_410.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) and copy_out_type : Ast_409.Outcometree.out_type -> Ast_410.Outcometree.out_type = function | Ast_409.Outcometree.Otyp_abstract -> Ast_410.Outcometree.Otyp_abstract | Ast_409.Outcometree.Otyp_open -> Ast_410.Outcometree.Otyp_open | Ast_409.Outcometree.Otyp_alias (x0, x1) -> Ast_410.Outcometree.Otyp_alias ((copy_out_type x0), x1) | Ast_409.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_410.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | Ast_409.Outcometree.Otyp_class (x0, x1, x2) -> Ast_410.Outcometree.Otyp_class (x0, (copy_out_ident x1), (List.map copy_out_type x2)) | Ast_409.Outcometree.Otyp_constr (x0, x1) -> Ast_410.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_409.Outcometree.Otyp_manifest (x0, x1) -> Ast_410.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | Ast_409.Outcometree.Otyp_object (x0, x1) -> Ast_410.Outcometree.Otyp_object ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), (map_option (fun x -> x) x1)) | Ast_409.Outcometree.Otyp_record x0 -> Ast_410.Outcometree.Otyp_record (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) | Ast_409.Outcometree.Otyp_stuff x0 -> Ast_410.Outcometree.Otyp_stuff x0 | Ast_409.Outcometree.Otyp_sum x0 -> Ast_410.Outcometree.Otyp_sum (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (map_option copy_out_type x2))) x0) | Ast_409.Outcometree.Otyp_tuple x0 -> Ast_410.Outcometree.Otyp_tuple (List.map copy_out_type x0) | Ast_409.Outcometree.Otyp_var (x0, x1) -> Ast_410.Outcometree.Otyp_var (x0, x1) | Ast_409.Outcometree.Otyp_variant (x0, x1, x2, x3) -> Ast_410.Outcometree.Otyp_variant (x0, (copy_out_variant x1), x2, (map_option (fun x -> List.map (fun x -> x) x) x3)) | Ast_409.Outcometree.Otyp_poly (x0, x1) -> Ast_410.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | Ast_409.Outcometree.Otyp_module (x0, x1, x2) -> Ast_410.Outcometree.Otyp_module ((copy_out_ident x0), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | Ast_409.Outcometree.Otyp_attribute (x0, x1) -> Ast_410.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : Ast_409.Outcometree.out_attribute -> Ast_410.Outcometree.out_attribute = fun { Ast_409.Outcometree.oattr_name = oattr_name } -> { Ast_410.Outcometree.oattr_name = oattr_name } and copy_out_variant : Ast_409.Outcometree.out_variant -> Ast_410.Outcometree.out_variant = function | Ast_409.Outcometree.Ovar_fields x0 -> Ast_410.Outcometree.Ovar_fields (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) x0) | Ast_409.Outcometree.Ovar_typ x0 -> Ast_410.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : Ast_409.Outcometree.out_value -> Ast_410.Outcometree.out_value = function | Ast_409.Outcometree.Oval_array x0 -> Ast_410.Outcometree.Oval_array (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_char x0 -> Ast_410.Outcometree.Oval_char x0 | Ast_409.Outcometree.Oval_constr (x0, x1) -> Ast_410.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | Ast_409.Outcometree.Oval_ellipsis -> Ast_410.Outcometree.Oval_ellipsis | Ast_409.Outcometree.Oval_float x0 -> Ast_410.Outcometree.Oval_float x0 | Ast_409.Outcometree.Oval_int x0 -> Ast_410.Outcometree.Oval_int x0 | Ast_409.Outcometree.Oval_int32 x0 -> Ast_410.Outcometree.Oval_int32 x0 | Ast_409.Outcometree.Oval_int64 x0 -> Ast_410.Outcometree.Oval_int64 x0 | Ast_409.Outcometree.Oval_nativeint x0 -> Ast_410.Outcometree.Oval_nativeint x0 | Ast_409.Outcometree.Oval_list x0 -> Ast_410.Outcometree.Oval_list (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_printer x0 -> Ast_410.Outcometree.Oval_printer x0 | Ast_409.Outcometree.Oval_record x0 -> Ast_410.Outcometree.Oval_record (List.map (fun x -> let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | Ast_409.Outcometree.Oval_string (x0, x1, x2) -> Ast_410.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) | Ast_409.Outcometree.Oval_stuff x0 -> Ast_410.Outcometree.Oval_stuff x0 | Ast_409.Outcometree.Oval_tuple x0 -> Ast_410.Outcometree.Oval_tuple (List.map copy_out_value x0) | Ast_409.Outcometree.Oval_variant (x0, x1) -> Ast_410.Outcometree.Oval_variant (x0, (map_option copy_out_value x1)) and copy_out_string : Ast_409.Outcometree.out_string -> Ast_410.Outcometree.out_string = function | Ast_409.Outcometree.Ostr_string -> Ast_410.Outcometree.Ostr_string | Ast_409.Outcometree.Ostr_bytes -> Ast_410.Outcometree.Ostr_bytes and copy_out_ident : Ast_409.Outcometree.out_ident -> Ast_410.Outcometree.out_ident = function | Ast_409.Outcometree.Oide_apply (x0, x1) -> Ast_410.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | Ast_409.Outcometree.Oide_dot (x0, x1) -> Ast_410.Outcometree.Oide_dot ((copy_out_ident x0), x1) | Ast_409.Outcometree.Oide_ident x0 -> Ast_410.Outcometree.Oide_ident (copy_out_name x0) and copy_out_name : Ast_409.Outcometree.out_name -> Ast_410.Outcometree.out_name = fun { Ast_409.Outcometree.printed_name = printed_name } -> { Ast_410.Outcometree.printed_name = printed_name } and copy_toplevel_phrase : Ast_409.Parsetree.toplevel_phrase -> Ast_410.Parsetree.toplevel_phrase = function | Ast_409.Parsetree.Ptop_def x0 -> Ast_410.Parsetree.Ptop_def (copy_structure x0) | Ast_409.Parsetree.Ptop_dir x0 -> Ast_410.Parsetree.Ptop_dir (copy_toplevel_directive x0) and copy_toplevel_directive : Ast_409.Parsetree.toplevel_directive -> Ast_410.Parsetree.toplevel_directive = fun { Ast_409.Parsetree.pdir_name = pdir_name; Ast_409.Parsetree.pdir_arg = pdir_arg; Ast_409.Parsetree.pdir_loc = pdir_loc } -> { Ast_410.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); Ast_410.Parsetree.pdir_arg = (map_option copy_directive_argument pdir_arg); Ast_410.Parsetree.pdir_loc = (copy_location pdir_loc) } and copy_directive_argument : Ast_409.Parsetree.directive_argument -> Ast_410.Parsetree.directive_argument = fun { Ast_409.Parsetree.pdira_desc = pdira_desc; Ast_409.Parsetree.pdira_loc = pdira_loc } -> { Ast_410.Parsetree.pdira_desc = (copy_directive_argument_desc pdira_desc); Ast_410.Parsetree.pdira_loc = (copy_location pdira_loc) } and copy_directive_argument_desc : Ast_409.Parsetree.directive_argument_desc -> Ast_410.Parsetree.directive_argument_desc = function | Ast_409.Parsetree.Pdir_string x0 -> Ast_410.Parsetree.Pdir_string x0 | Ast_409.Parsetree.Pdir_int (x0, x1) -> Ast_410.Parsetree.Pdir_int (x0, (map_option (fun x -> x) x1)) | Ast_409.Parsetree.Pdir_ident x0 -> Ast_410.Parsetree.Pdir_ident (copy_Longident_t x0) | Ast_409.Parsetree.Pdir_bool x0 -> Ast_410.Parsetree.Pdir_bool x0 and copy_expression : Ast_409.Parsetree.expression -> Ast_410.Parsetree.expression = fun { Ast_409.Parsetree.pexp_desc = pexp_desc; Ast_409.Parsetree.pexp_loc = pexp_loc; Ast_409.Parsetree.pexp_loc_stack = pexp_loc_stack; Ast_409.Parsetree.pexp_attributes = pexp_attributes } -> { Ast_410.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); Ast_410.Parsetree.pexp_loc = (copy_location pexp_loc); Ast_410.Parsetree.pexp_loc_stack = (List.map copy_location pexp_loc_stack); Ast_410.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : Ast_409.Parsetree.expression_desc -> Ast_410.Parsetree.expression_desc = function | Ast_409.Parsetree.Pexp_ident x0 -> Ast_410.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pexp_constant x0 -> Ast_410.Parsetree.Pexp_constant (copy_constant x0) | Ast_409.Parsetree.Pexp_let (x0, x1, x2) -> Ast_410.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_function x0 -> Ast_410.Parsetree.Pexp_function (copy_cases x0) | Ast_409.Parsetree.Pexp_fun (x0, x1, x2, x3) -> Ast_410.Parsetree.Pexp_fun ((copy_arg_label x0), (map_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | Ast_409.Parsetree.Pexp_apply (x0, x1) -> Ast_410.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_409.Parsetree.Pexp_match (x0, x1) -> Ast_410.Parsetree.Pexp_match ((copy_expression x0), (copy_cases x1)) | Ast_409.Parsetree.Pexp_try (x0, x1) -> Ast_410.Parsetree.Pexp_try ((copy_expression x0), (copy_cases x1)) | Ast_409.Parsetree.Pexp_tuple x0 -> Ast_410.Parsetree.Pexp_tuple (List.map copy_expression x0) | Ast_409.Parsetree.Pexp_construct (x0, x1) -> Ast_410.Parsetree.Pexp_construct ((copy_loc copy_Longident_t x0), (map_option copy_expression x1)) | Ast_409.Parsetree.Pexp_variant (x0, x1) -> Ast_410.Parsetree.Pexp_variant ((copy_label x0), (map_option copy_expression x1)) | Ast_409.Parsetree.Pexp_record (x0, x1) -> Ast_410.Parsetree.Pexp_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), (map_option copy_expression x1)) | Ast_409.Parsetree.Pexp_field (x0, x1) -> Ast_410.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_Longident_t x1)) | Ast_409.Parsetree.Pexp_setfield (x0, x1, x2) -> Ast_410.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_Longident_t x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_array x0 -> Ast_410.Parsetree.Pexp_array (List.map copy_expression x0) | Ast_409.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> Ast_410.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (map_option copy_expression x2)) | Ast_409.Parsetree.Pexp_sequence (x0, x1) -> Ast_410.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_while (x0, x1) -> Ast_410.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> Ast_410.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | Ast_409.Parsetree.Pexp_constraint (x0, x1) -> Ast_410.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | Ast_409.Parsetree.Pexp_coerce (x0, x1, x2) -> Ast_410.Parsetree.Pexp_coerce ((copy_expression x0), (map_option copy_core_type x1), (copy_core_type x2)) | Ast_409.Parsetree.Pexp_send (x0, x1) -> Ast_410.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | Ast_409.Parsetree.Pexp_new x0 -> Ast_410.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pexp_setinstvar (x0, x1) -> Ast_410.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_override x0 -> Ast_410.Parsetree.Pexp_override (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | Ast_409.Parsetree.Pexp_letmodule (x0, x1, x2) -> Ast_410.Parsetree.Pexp_letmodule ((copy_loc (fun x -> Some x) x0), (copy_module_expr x1), (copy_expression x2)) | Ast_409.Parsetree.Pexp_letexception (x0, x1) -> Ast_410.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_assert x0 -> Ast_410.Parsetree.Pexp_assert (copy_expression x0) | Ast_409.Parsetree.Pexp_lazy x0 -> Ast_410.Parsetree.Pexp_lazy (copy_expression x0) | Ast_409.Parsetree.Pexp_poly (x0, x1) -> Ast_410.Parsetree.Pexp_poly ((copy_expression x0), (map_option copy_core_type x1)) | Ast_409.Parsetree.Pexp_object x0 -> Ast_410.Parsetree.Pexp_object (copy_class_structure x0) | Ast_409.Parsetree.Pexp_newtype (x0, x1) -> Ast_410.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_pack x0 -> Ast_410.Parsetree.Pexp_pack (copy_module_expr x0) | Ast_409.Parsetree.Pexp_open (x0, x1) -> Ast_410.Parsetree.Pexp_open ((copy_open_declaration x0), (copy_expression x1)) | Ast_409.Parsetree.Pexp_letop x0 -> Ast_410.Parsetree.Pexp_letop (copy_letop x0) | Ast_409.Parsetree.Pexp_extension x0 -> Ast_410.Parsetree.Pexp_extension (copy_extension x0) | Ast_409.Parsetree.Pexp_unreachable -> Ast_410.Parsetree.Pexp_unreachable and copy_letop : Ast_409.Parsetree.letop -> Ast_410.Parsetree.letop = fun { Ast_409.Parsetree.let_ = let_; Ast_409.Parsetree.ands = ands; Ast_409.Parsetree.body = body } -> { Ast_410.Parsetree.let_ = (copy_binding_op let_); Ast_410.Parsetree.ands = (List.map copy_binding_op ands); Ast_410.Parsetree.body = (copy_expression body) } and copy_binding_op : Ast_409.Parsetree.binding_op -> Ast_410.Parsetree.binding_op = fun { Ast_409.Parsetree.pbop_op = pbop_op; Ast_409.Parsetree.pbop_pat = pbop_pat; Ast_409.Parsetree.pbop_exp = pbop_exp; Ast_409.Parsetree.pbop_loc = pbop_loc } -> { Ast_410.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); Ast_410.Parsetree.pbop_pat = (copy_pattern pbop_pat); Ast_410.Parsetree.pbop_exp = (copy_expression pbop_exp); Ast_410.Parsetree.pbop_loc = (copy_location pbop_loc) } and copy_direction_flag : Ast_409.Asttypes.direction_flag -> Ast_410.Asttypes.direction_flag = function | Ast_409.Asttypes.Upto -> Ast_410.Asttypes.Upto | Ast_409.Asttypes.Downto -> Ast_410.Asttypes.Downto and copy_cases : Ast_409.Parsetree.cases -> Ast_410.Parsetree.case list = fun x -> List.map copy_case x and copy_case : Ast_409.Parsetree.case -> Ast_410.Parsetree.case = fun { Ast_409.Parsetree.pc_lhs = pc_lhs; Ast_409.Parsetree.pc_guard = pc_guard; Ast_409.Parsetree.pc_rhs = pc_rhs } -> { Ast_410.Parsetree.pc_lhs = (copy_pattern pc_lhs); Ast_410.Parsetree.pc_guard = (map_option copy_expression pc_guard); Ast_410.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_value_binding : Ast_409.Parsetree.value_binding -> Ast_410.Parsetree.value_binding = fun { Ast_409.Parsetree.pvb_pat = pvb_pat; Ast_409.Parsetree.pvb_expr = pvb_expr; Ast_409.Parsetree.pvb_attributes = pvb_attributes; Ast_409.Parsetree.pvb_loc = pvb_loc } -> { Ast_410.Parsetree.pvb_pat = (copy_pattern pvb_pat); Ast_410.Parsetree.pvb_expr = (copy_expression pvb_expr); Ast_410.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); Ast_410.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : Ast_409.Parsetree.pattern -> Ast_410.Parsetree.pattern = fun { Ast_409.Parsetree.ppat_desc = ppat_desc; Ast_409.Parsetree.ppat_loc = ppat_loc; Ast_409.Parsetree.ppat_loc_stack = ppat_loc_stack; Ast_409.Parsetree.ppat_attributes = ppat_attributes } -> { Ast_410.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); Ast_410.Parsetree.ppat_loc = (copy_location ppat_loc); Ast_410.Parsetree.ppat_loc_stack = (List.map copy_location ppat_loc_stack); Ast_410.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : Ast_409.Parsetree.pattern_desc -> Ast_410.Parsetree.pattern_desc = function | Ast_409.Parsetree.Ppat_any -> Ast_410.Parsetree.Ppat_any | Ast_409.Parsetree.Ppat_var x0 -> Ast_410.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | Ast_409.Parsetree.Ppat_alias (x0, x1) -> Ast_410.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | Ast_409.Parsetree.Ppat_constant x0 -> Ast_410.Parsetree.Ppat_constant (copy_constant x0) | Ast_409.Parsetree.Ppat_interval (x0, x1) -> Ast_410.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | Ast_409.Parsetree.Ppat_tuple x0 -> Ast_410.Parsetree.Ppat_tuple (List.map copy_pattern x0) | Ast_409.Parsetree.Ppat_construct (x0, x1) -> Ast_410.Parsetree.Ppat_construct ((copy_loc copy_Longident_t x0), (map_option copy_pattern x1)) | Ast_409.Parsetree.Ppat_variant (x0, x1) -> Ast_410.Parsetree.Ppat_variant ((copy_label x0), (map_option copy_pattern x1)) | Ast_409.Parsetree.Ppat_record (x0, x1) -> Ast_410.Parsetree.Ppat_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | Ast_409.Parsetree.Ppat_array x0 -> Ast_410.Parsetree.Ppat_array (List.map copy_pattern x0) | Ast_409.Parsetree.Ppat_or (x0, x1) -> Ast_410.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | Ast_409.Parsetree.Ppat_constraint (x0, x1) -> Ast_410.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | Ast_409.Parsetree.Ppat_type x0 -> Ast_410.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Ppat_lazy x0 -> Ast_410.Parsetree.Ppat_lazy (copy_pattern x0) | Ast_409.Parsetree.Ppat_unpack x0 -> Ast_410.Parsetree.Ppat_unpack (copy_loc (fun x -> Some x) x0) | Ast_409.Parsetree.Ppat_exception x0 -> Ast_410.Parsetree.Ppat_exception (copy_pattern x0) | Ast_409.Parsetree.Ppat_extension x0 -> Ast_410.Parsetree.Ppat_extension (copy_extension x0) | Ast_409.Parsetree.Ppat_open (x0, x1) -> Ast_410.Parsetree.Ppat_open ((copy_loc copy_Longident_t x0), (copy_pattern x1)) and copy_core_type : Ast_409.Parsetree.core_type -> Ast_410.Parsetree.core_type = fun { Ast_409.Parsetree.ptyp_desc = ptyp_desc; Ast_409.Parsetree.ptyp_loc = ptyp_loc; Ast_409.Parsetree.ptyp_loc_stack = ptyp_loc_stack; Ast_409.Parsetree.ptyp_attributes = ptyp_attributes } -> { Ast_410.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); Ast_410.Parsetree.ptyp_loc = (copy_location ptyp_loc); Ast_410.Parsetree.ptyp_loc_stack = (List.map copy_location ptyp_loc_stack); Ast_410.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_core_type_desc : Ast_409.Parsetree.core_type_desc -> Ast_410.Parsetree.core_type_desc = function | Ast_409.Parsetree.Ptyp_any -> Ast_410.Parsetree.Ptyp_any | Ast_409.Parsetree.Ptyp_var x0 -> Ast_410.Parsetree.Ptyp_var x0 | Ast_409.Parsetree.Ptyp_arrow (x0, x1, x2) -> Ast_410.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | Ast_409.Parsetree.Ptyp_tuple x0 -> Ast_410.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | Ast_409.Parsetree.Ptyp_constr (x0, x1) -> Ast_410.Parsetree.Ptyp_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Ptyp_object (x0, x1) -> Ast_410.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | Ast_409.Parsetree.Ptyp_class (x0, x1) -> Ast_410.Parsetree.Ptyp_class ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Ptyp_alias (x0, x1) -> Ast_410.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | Ast_409.Parsetree.Ptyp_variant (x0, x1, x2) -> Ast_410.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (map_option (fun x -> List.map copy_label x) x2)) | Ast_409.Parsetree.Ptyp_poly (x0, x1) -> Ast_410.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | Ast_409.Parsetree.Ptyp_package x0 -> Ast_410.Parsetree.Ptyp_package (copy_package_type x0) | Ast_409.Parsetree.Ptyp_extension x0 -> Ast_410.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : Ast_409.Parsetree.package_type -> Ast_410.Parsetree.package_type = fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) and copy_row_field : Ast_409.Parsetree.row_field -> Ast_410.Parsetree.row_field = fun { Ast_409.Parsetree.prf_desc = prf_desc; Ast_409.Parsetree.prf_loc = prf_loc; Ast_409.Parsetree.prf_attributes = prf_attributes } -> { Ast_410.Parsetree.prf_desc = (copy_row_field_desc prf_desc); Ast_410.Parsetree.prf_loc = (copy_location prf_loc); Ast_410.Parsetree.prf_attributes = (copy_attributes prf_attributes) } and copy_row_field_desc : Ast_409.Parsetree.row_field_desc -> Ast_410.Parsetree.row_field_desc = function | Ast_409.Parsetree.Rtag (x0, x1, x2) -> Ast_410.Parsetree.Rtag ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) | Ast_409.Parsetree.Rinherit x0 -> Ast_410.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : Ast_409.Parsetree.object_field -> Ast_410.Parsetree.object_field = fun { Ast_409.Parsetree.pof_desc = pof_desc; Ast_409.Parsetree.pof_loc = pof_loc; Ast_409.Parsetree.pof_attributes = pof_attributes } -> { Ast_410.Parsetree.pof_desc = (copy_object_field_desc pof_desc); Ast_410.Parsetree.pof_loc = (copy_location pof_loc); Ast_410.Parsetree.pof_attributes = (copy_attributes pof_attributes) } and copy_attributes : Ast_409.Parsetree.attributes -> Ast_410.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : Ast_409.Parsetree.attribute -> Ast_410.Parsetree.attribute = fun { Ast_409.Parsetree.attr_name = attr_name; Ast_409.Parsetree.attr_payload = attr_payload; Ast_409.Parsetree.attr_loc = attr_loc } -> { Ast_410.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); Ast_410.Parsetree.attr_payload = (copy_payload attr_payload); Ast_410.Parsetree.attr_loc = (copy_location attr_loc) } and copy_payload : Ast_409.Parsetree.payload -> Ast_410.Parsetree.payload = function | Ast_409.Parsetree.PStr x0 -> Ast_410.Parsetree.PStr (copy_structure x0) | Ast_409.Parsetree.PSig x0 -> Ast_410.Parsetree.PSig (copy_signature x0) | Ast_409.Parsetree.PTyp x0 -> Ast_410.Parsetree.PTyp (copy_core_type x0) | Ast_409.Parsetree.PPat (x0, x1) -> Ast_410.Parsetree.PPat ((copy_pattern x0), (map_option copy_expression x1)) and copy_structure : Ast_409.Parsetree.structure -> Ast_410.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : Ast_409.Parsetree.structure_item -> Ast_410.Parsetree.structure_item = fun { Ast_409.Parsetree.pstr_desc = pstr_desc; Ast_409.Parsetree.pstr_loc = pstr_loc } -> { Ast_410.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); Ast_410.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : Ast_409.Parsetree.structure_item_desc -> Ast_410.Parsetree.structure_item_desc = function | Ast_409.Parsetree.Pstr_eval (x0, x1) -> Ast_410.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | Ast_409.Parsetree.Pstr_value (x0, x1) -> Ast_410.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | Ast_409.Parsetree.Pstr_primitive x0 -> Ast_410.Parsetree.Pstr_primitive (copy_value_description x0) | Ast_409.Parsetree.Pstr_type (x0, x1) -> Ast_410.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_409.Parsetree.Pstr_typext x0 -> Ast_410.Parsetree.Pstr_typext (copy_type_extension x0) | Ast_409.Parsetree.Pstr_exception x0 -> Ast_410.Parsetree.Pstr_exception (copy_type_exception x0) | Ast_409.Parsetree.Pstr_module x0 -> Ast_410.Parsetree.Pstr_module (copy_module_binding x0) | Ast_409.Parsetree.Pstr_recmodule x0 -> Ast_410.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | Ast_409.Parsetree.Pstr_modtype x0 -> Ast_410.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | Ast_409.Parsetree.Pstr_open x0 -> Ast_410.Parsetree.Pstr_open (copy_open_declaration x0) | Ast_409.Parsetree.Pstr_class x0 -> Ast_410.Parsetree.Pstr_class (List.map copy_class_declaration x0) | Ast_409.Parsetree.Pstr_class_type x0 -> Ast_410.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | Ast_409.Parsetree.Pstr_include x0 -> Ast_410.Parsetree.Pstr_include (copy_include_declaration x0) | Ast_409.Parsetree.Pstr_attribute x0 -> Ast_410.Parsetree.Pstr_attribute (copy_attribute x0) | Ast_409.Parsetree.Pstr_extension (x0, x1) -> Ast_410.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : Ast_409.Parsetree.include_declaration -> Ast_410.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : Ast_409.Parsetree.class_declaration -> Ast_410.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : Ast_409.Parsetree.class_expr -> Ast_410.Parsetree.class_expr = fun { Ast_409.Parsetree.pcl_desc = pcl_desc; Ast_409.Parsetree.pcl_loc = pcl_loc; Ast_409.Parsetree.pcl_attributes = pcl_attributes } -> { Ast_410.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); Ast_410.Parsetree.pcl_loc = (copy_location pcl_loc); Ast_410.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : Ast_409.Parsetree.class_expr_desc -> Ast_410.Parsetree.class_expr_desc = function | Ast_409.Parsetree.Pcl_constr (x0, x1) -> Ast_410.Parsetree.Pcl_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Pcl_structure x0 -> Ast_410.Parsetree.Pcl_structure (copy_class_structure x0) | Ast_409.Parsetree.Pcl_fun (x0, x1, x2, x3) -> Ast_410.Parsetree.Pcl_fun ((copy_arg_label x0), (map_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | Ast_409.Parsetree.Pcl_apply (x0, x1) -> Ast_410.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_409.Parsetree.Pcl_let (x0, x1, x2) -> Ast_410.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | Ast_409.Parsetree.Pcl_constraint (x0, x1) -> Ast_410.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | Ast_409.Parsetree.Pcl_extension x0 -> Ast_410.Parsetree.Pcl_extension (copy_extension x0) | Ast_409.Parsetree.Pcl_open (x0, x1) -> Ast_410.Parsetree.Pcl_open ((copy_open_description x0), (copy_class_expr x1)) and copy_class_structure : Ast_409.Parsetree.class_structure -> Ast_410.Parsetree.class_structure = fun { Ast_409.Parsetree.pcstr_self = pcstr_self; Ast_409.Parsetree.pcstr_fields = pcstr_fields } -> { Ast_410.Parsetree.pcstr_self = (copy_pattern pcstr_self); Ast_410.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : Ast_409.Parsetree.class_field -> Ast_410.Parsetree.class_field = fun { Ast_409.Parsetree.pcf_desc = pcf_desc; Ast_409.Parsetree.pcf_loc = pcf_loc; Ast_409.Parsetree.pcf_attributes = pcf_attributes } -> { Ast_410.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); Ast_410.Parsetree.pcf_loc = (copy_location pcf_loc); Ast_410.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : Ast_409.Parsetree.class_field_desc -> Ast_410.Parsetree.class_field_desc = function | Ast_409.Parsetree.Pcf_inherit (x0, x1, x2) -> Ast_410.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (map_option (fun x -> copy_loc (fun x -> x) x) x2)) | Ast_409.Parsetree.Pcf_val x0 -> Ast_410.Parsetree.Pcf_val (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | Ast_409.Parsetree.Pcf_method x0 -> Ast_410.Parsetree.Pcf_method (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | Ast_409.Parsetree.Pcf_constraint x0 -> Ast_410.Parsetree.Pcf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_409.Parsetree.Pcf_initializer x0 -> Ast_410.Parsetree.Pcf_initializer (copy_expression x0) | Ast_409.Parsetree.Pcf_attribute x0 -> Ast_410.Parsetree.Pcf_attribute (copy_attribute x0) | Ast_409.Parsetree.Pcf_extension x0 -> Ast_410.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : Ast_409.Parsetree.class_field_kind -> Ast_410.Parsetree.class_field_kind = function | Ast_409.Parsetree.Cfk_virtual x0 -> Ast_410.Parsetree.Cfk_virtual (copy_core_type x0) | Ast_409.Parsetree.Cfk_concrete (x0, x1) -> Ast_410.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_open_declaration : Ast_409.Parsetree.open_declaration -> Ast_410.Parsetree.open_declaration = fun x -> copy_open_infos copy_module_expr x and copy_module_binding : Ast_409.Parsetree.module_binding -> Ast_410.Parsetree.module_binding = fun { Ast_409.Parsetree.pmb_name = pmb_name; Ast_409.Parsetree.pmb_expr = pmb_expr; Ast_409.Parsetree.pmb_attributes = pmb_attributes; Ast_409.Parsetree.pmb_loc = pmb_loc } -> { Ast_410.Parsetree.pmb_name = (copy_loc (fun x -> Some x) pmb_name); Ast_410.Parsetree.pmb_expr = (copy_module_expr pmb_expr); Ast_410.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); Ast_410.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : Ast_409.Parsetree.module_expr -> Ast_410.Parsetree.module_expr = fun { Ast_409.Parsetree.pmod_desc = pmod_desc; Ast_409.Parsetree.pmod_loc = pmod_loc; Ast_409.Parsetree.pmod_attributes = pmod_attributes } -> { Ast_410.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); Ast_410.Parsetree.pmod_loc = (copy_location pmod_loc); Ast_410.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : Ast_409.Parsetree.module_expr_desc -> Ast_410.Parsetree.module_expr_desc = function | Ast_409.Parsetree.Pmod_ident x0 -> Ast_410.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pmod_structure x0 -> Ast_410.Parsetree.Pmod_structure (copy_structure x0) | Ast_409.Parsetree.Pmod_functor (x0, x1, x2) -> Ast_410.Parsetree.Pmod_functor ((match x0.txt, x1 with | "*", None -> Unit | "_", Some mt -> Named (copy_loc (fun _ -> None) x0, copy_module_type mt) | _, Some mt -> Named (copy_loc (fun x -> Some x) x0, copy_module_type mt) |_ -> assert false), (copy_module_expr x2)) | Ast_409.Parsetree.Pmod_apply (x0, x1) -> Ast_410.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | Ast_409.Parsetree.Pmod_constraint (x0, x1) -> Ast_410.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | Ast_409.Parsetree.Pmod_unpack x0 -> Ast_410.Parsetree.Pmod_unpack (copy_expression x0) | Ast_409.Parsetree.Pmod_extension x0 -> Ast_410.Parsetree.Pmod_extension (copy_extension x0) and copy_module_type : Ast_409.Parsetree.module_type -> Ast_410.Parsetree.module_type = fun { Ast_409.Parsetree.pmty_desc = pmty_desc; Ast_409.Parsetree.pmty_loc = pmty_loc; Ast_409.Parsetree.pmty_attributes = pmty_attributes } -> { Ast_410.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); Ast_410.Parsetree.pmty_loc = (copy_location pmty_loc); Ast_410.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : Ast_409.Parsetree.module_type_desc -> Ast_410.Parsetree.module_type_desc = function | Ast_409.Parsetree.Pmty_ident x0 -> Ast_410.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) | Ast_409.Parsetree.Pmty_signature x0 -> Ast_410.Parsetree.Pmty_signature (copy_signature x0) | Ast_409.Parsetree.Pmty_functor (x0, x1, x2) -> Ast_410.Parsetree.Pmty_functor ((match x0.txt, x1 with | "*", None -> Unit | "_", Some mt -> Named (copy_loc (fun _ -> None) x0, copy_module_type mt) | _, Some mt -> Named (copy_loc (fun x -> Some x) x0, copy_module_type mt) |_ -> assert false), (copy_module_type x2)) | Ast_409.Parsetree.Pmty_with (x0, x1) -> Ast_410.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | Ast_409.Parsetree.Pmty_typeof x0 -> Ast_410.Parsetree.Pmty_typeof (copy_module_expr x0) | Ast_409.Parsetree.Pmty_extension x0 -> Ast_410.Parsetree.Pmty_extension (copy_extension x0) | Ast_409.Parsetree.Pmty_alias x0 -> Ast_410.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) and copy_with_constraint : Ast_409.Parsetree.with_constraint -> Ast_410.Parsetree.with_constraint = function | Ast_409.Parsetree.Pwith_type (x0, x1) -> Ast_410.Parsetree.Pwith_type ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_409.Parsetree.Pwith_module (x0, x1) -> Ast_410.Parsetree.Pwith_module ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) | Ast_409.Parsetree.Pwith_typesubst (x0, x1) -> Ast_410.Parsetree.Pwith_typesubst ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_409.Parsetree.Pwith_modsubst (x0, x1) -> Ast_410.Parsetree.Pwith_modsubst ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) and copy_signature : Ast_409.Parsetree.signature -> Ast_410.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : Ast_409.Parsetree.signature_item -> Ast_410.Parsetree.signature_item = fun { Ast_409.Parsetree.psig_desc = psig_desc; Ast_409.Parsetree.psig_loc = psig_loc } -> { Ast_410.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); Ast_410.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : Ast_409.Parsetree.signature_item_desc -> Ast_410.Parsetree.signature_item_desc = function | Ast_409.Parsetree.Psig_value x0 -> Ast_410.Parsetree.Psig_value (copy_value_description x0) | Ast_409.Parsetree.Psig_type (x0, x1) -> Ast_410.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_409.Parsetree.Psig_typesubst x0 -> Ast_410.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) | Ast_409.Parsetree.Psig_typext x0 -> Ast_410.Parsetree.Psig_typext (copy_type_extension x0) | Ast_409.Parsetree.Psig_exception x0 -> Ast_410.Parsetree.Psig_exception (copy_type_exception x0) | Ast_409.Parsetree.Psig_module x0 -> Ast_410.Parsetree.Psig_module (copy_module_declaration x0) | Ast_409.Parsetree.Psig_modsubst x0 -> Ast_410.Parsetree.Psig_modsubst (copy_module_substitution x0) | Ast_409.Parsetree.Psig_recmodule x0 -> Ast_410.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | Ast_409.Parsetree.Psig_modtype x0 -> Ast_410.Parsetree.Psig_modtype (copy_module_type_declaration x0) | Ast_409.Parsetree.Psig_open x0 -> Ast_410.Parsetree.Psig_open (copy_open_description x0) | Ast_409.Parsetree.Psig_include x0 -> Ast_410.Parsetree.Psig_include (copy_include_description x0) | Ast_409.Parsetree.Psig_class x0 -> Ast_410.Parsetree.Psig_class (List.map copy_class_description x0) | Ast_409.Parsetree.Psig_class_type x0 -> Ast_410.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | Ast_409.Parsetree.Psig_attribute x0 -> Ast_410.Parsetree.Psig_attribute (copy_attribute x0) | Ast_409.Parsetree.Psig_extension (x0, x1) -> Ast_410.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : Ast_409.Parsetree.class_type_declaration -> Ast_410.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : Ast_409.Parsetree.class_description -> Ast_410.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : Ast_409.Parsetree.class_type -> Ast_410.Parsetree.class_type = fun { Ast_409.Parsetree.pcty_desc = pcty_desc; Ast_409.Parsetree.pcty_loc = pcty_loc; Ast_409.Parsetree.pcty_attributes = pcty_attributes } -> { Ast_410.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); Ast_410.Parsetree.pcty_loc = (copy_location pcty_loc); Ast_410.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : Ast_409.Parsetree.class_type_desc -> Ast_410.Parsetree.class_type_desc = function | Ast_409.Parsetree.Pcty_constr (x0, x1) -> Ast_410.Parsetree.Pcty_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_409.Parsetree.Pcty_signature x0 -> Ast_410.Parsetree.Pcty_signature (copy_class_signature x0) | Ast_409.Parsetree.Pcty_arrow (x0, x1, x2) -> Ast_410.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | Ast_409.Parsetree.Pcty_extension x0 -> Ast_410.Parsetree.Pcty_extension (copy_extension x0) | Ast_409.Parsetree.Pcty_open (x0, x1) -> Ast_410.Parsetree.Pcty_open ((copy_open_description x0), (copy_class_type x1)) and copy_class_signature : Ast_409.Parsetree.class_signature -> Ast_410.Parsetree.class_signature = fun { Ast_409.Parsetree.pcsig_self = pcsig_self; Ast_409.Parsetree.pcsig_fields = pcsig_fields } -> { Ast_410.Parsetree.pcsig_self = (copy_core_type pcsig_self); Ast_410.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : Ast_409.Parsetree.class_type_field -> Ast_410.Parsetree.class_type_field = fun { Ast_409.Parsetree.pctf_desc = pctf_desc; Ast_409.Parsetree.pctf_loc = pctf_loc; Ast_409.Parsetree.pctf_attributes = pctf_attributes } -> { Ast_410.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); Ast_410.Parsetree.pctf_loc = (copy_location pctf_loc); Ast_410.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : Ast_409.Parsetree.class_type_field_desc -> Ast_410.Parsetree.class_type_field_desc = function | Ast_409.Parsetree.Pctf_inherit x0 -> Ast_410.Parsetree.Pctf_inherit (copy_class_type x0) | Ast_409.Parsetree.Pctf_val x0 -> Ast_410.Parsetree.Pctf_val (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_409.Parsetree.Pctf_method x0 -> Ast_410.Parsetree.Pctf_method (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_409.Parsetree.Pctf_constraint x0 -> Ast_410.Parsetree.Pctf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_409.Parsetree.Pctf_attribute x0 -> Ast_410.Parsetree.Pctf_attribute (copy_attribute x0) | Ast_409.Parsetree.Pctf_extension x0 -> Ast_410.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : Ast_409.Parsetree.extension -> Ast_410.Parsetree.extension = fun x -> let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.class_infos -> 'g0 Ast_410.Parsetree.class_infos = fun f0 -> fun { Ast_409.Parsetree.pci_virt = pci_virt; Ast_409.Parsetree.pci_params = pci_params; Ast_409.Parsetree.pci_name = pci_name; Ast_409.Parsetree.pci_expr = pci_expr; Ast_409.Parsetree.pci_loc = pci_loc; Ast_409.Parsetree.pci_attributes = pci_attributes } -> { Ast_410.Parsetree.pci_virt = (copy_virtual_flag pci_virt); Ast_410.Parsetree.pci_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); Ast_410.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); Ast_410.Parsetree.pci_expr = (f0 pci_expr); Ast_410.Parsetree.pci_loc = (copy_location pci_loc); Ast_410.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : Ast_409.Asttypes.virtual_flag -> Ast_410.Asttypes.virtual_flag = function | Ast_409.Asttypes.Virtual -> Ast_410.Asttypes.Virtual | Ast_409.Asttypes.Concrete -> Ast_410.Asttypes.Concrete and copy_include_description : Ast_409.Parsetree.include_description -> Ast_410.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.include_infos -> 'g0 Ast_410.Parsetree.include_infos = fun f0 -> fun { Ast_409.Parsetree.pincl_mod = pincl_mod; Ast_409.Parsetree.pincl_loc = pincl_loc; Ast_409.Parsetree.pincl_attributes = pincl_attributes } -> { Ast_410.Parsetree.pincl_mod = (f0 pincl_mod); Ast_410.Parsetree.pincl_loc = (copy_location pincl_loc); Ast_410.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : Ast_409.Parsetree.open_description -> Ast_410.Parsetree.open_description = fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x and copy_open_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Parsetree.open_infos -> 'g0 Ast_410.Parsetree.open_infos = fun f0 -> fun { Ast_409.Parsetree.popen_expr = popen_expr; Ast_409.Parsetree.popen_override = popen_override; Ast_409.Parsetree.popen_loc = popen_loc; Ast_409.Parsetree.popen_attributes = popen_attributes } -> { Ast_410.Parsetree.popen_expr = (f0 popen_expr); Ast_410.Parsetree.popen_override = (copy_override_flag popen_override); Ast_410.Parsetree.popen_loc = (copy_location popen_loc); Ast_410.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : Ast_409.Asttypes.override_flag -> Ast_410.Asttypes.override_flag = function | Ast_409.Asttypes.Override -> Ast_410.Asttypes.Override | Ast_409.Asttypes.Fresh -> Ast_410.Asttypes.Fresh and copy_module_type_declaration : Ast_409.Parsetree.module_type_declaration -> Ast_410.Parsetree.module_type_declaration = fun { Ast_409.Parsetree.pmtd_name = pmtd_name; Ast_409.Parsetree.pmtd_type = pmtd_type; Ast_409.Parsetree.pmtd_attributes = pmtd_attributes; Ast_409.Parsetree.pmtd_loc = pmtd_loc } -> { Ast_410.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); Ast_410.Parsetree.pmtd_type = (map_option copy_module_type pmtd_type); Ast_410.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); Ast_410.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_substitution : Ast_409.Parsetree.module_substitution -> Ast_410.Parsetree.module_substitution = fun { Ast_409.Parsetree.pms_name = pms_name; Ast_409.Parsetree.pms_manifest = pms_manifest; Ast_409.Parsetree.pms_attributes = pms_attributes; Ast_409.Parsetree.pms_loc = pms_loc } -> { Ast_410.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); Ast_410.Parsetree.pms_manifest = (copy_loc copy_Longident_t pms_manifest); Ast_410.Parsetree.pms_attributes = (copy_attributes pms_attributes); Ast_410.Parsetree.pms_loc = (copy_location pms_loc) } and copy_module_declaration : Ast_409.Parsetree.module_declaration -> Ast_410.Parsetree.module_declaration = fun { Ast_409.Parsetree.pmd_name = pmd_name; Ast_409.Parsetree.pmd_type = pmd_type; Ast_409.Parsetree.pmd_attributes = pmd_attributes; Ast_409.Parsetree.pmd_loc = pmd_loc } -> { Ast_410.Parsetree.pmd_name = (copy_loc (fun x -> Some x) pmd_name); Ast_410.Parsetree.pmd_type = (copy_module_type pmd_type); Ast_410.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); Ast_410.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_exception : Ast_409.Parsetree.type_exception -> Ast_410.Parsetree.type_exception = fun { Ast_409.Parsetree.ptyexn_constructor = ptyexn_constructor; Ast_409.Parsetree.ptyexn_loc = ptyexn_loc; Ast_409.Parsetree.ptyexn_attributes = ptyexn_attributes } -> { Ast_410.Parsetree.ptyexn_constructor = (copy_extension_constructor ptyexn_constructor); Ast_410.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); Ast_410.Parsetree.ptyexn_attributes = (copy_attributes ptyexn_attributes) } and copy_type_extension : Ast_409.Parsetree.type_extension -> Ast_410.Parsetree.type_extension = fun { Ast_409.Parsetree.ptyext_path = ptyext_path; Ast_409.Parsetree.ptyext_params = ptyext_params; Ast_409.Parsetree.ptyext_constructors = ptyext_constructors; Ast_409.Parsetree.ptyext_private = ptyext_private; Ast_409.Parsetree.ptyext_loc = ptyext_loc; Ast_409.Parsetree.ptyext_attributes = ptyext_attributes } -> { Ast_410.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); Ast_410.Parsetree.ptyext_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); Ast_410.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); Ast_410.Parsetree.ptyext_private = (copy_private_flag ptyext_private); Ast_410.Parsetree.ptyext_loc = (copy_location ptyext_loc); Ast_410.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : Ast_409.Parsetree.extension_constructor -> Ast_410.Parsetree.extension_constructor = fun { Ast_409.Parsetree.pext_name = pext_name; Ast_409.Parsetree.pext_kind = pext_kind; Ast_409.Parsetree.pext_loc = pext_loc; Ast_409.Parsetree.pext_attributes = pext_attributes } -> { Ast_410.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); Ast_410.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); Ast_410.Parsetree.pext_loc = (copy_location pext_loc); Ast_410.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : Ast_409.Parsetree.extension_constructor_kind -> Ast_410.Parsetree.extension_constructor_kind = function | Ast_409.Parsetree.Pext_decl (x0, x1) -> Ast_410.Parsetree.Pext_decl ((copy_constructor_arguments x0), (map_option copy_core_type x1)) | Ast_409.Parsetree.Pext_rebind x0 -> Ast_410.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) and copy_type_declaration : Ast_409.Parsetree.type_declaration -> Ast_410.Parsetree.type_declaration = fun { Ast_409.Parsetree.ptype_name = ptype_name; Ast_409.Parsetree.ptype_params = ptype_params; Ast_409.Parsetree.ptype_cstrs = ptype_cstrs; Ast_409.Parsetree.ptype_kind = ptype_kind; Ast_409.Parsetree.ptype_private = ptype_private; Ast_409.Parsetree.ptype_manifest = ptype_manifest; Ast_409.Parsetree.ptype_attributes = ptype_attributes; Ast_409.Parsetree.ptype_loc = ptype_loc } -> { Ast_410.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); Ast_410.Parsetree.ptype_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); Ast_410.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0, x1, x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); Ast_410.Parsetree.ptype_kind = (copy_type_kind ptype_kind); Ast_410.Parsetree.ptype_private = (copy_private_flag ptype_private); Ast_410.Parsetree.ptype_manifest = (map_option copy_core_type ptype_manifest); Ast_410.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); Ast_410.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : Ast_409.Asttypes.private_flag -> Ast_410.Asttypes.private_flag = function | Ast_409.Asttypes.Private -> Ast_410.Asttypes.Private | Ast_409.Asttypes.Public -> Ast_410.Asttypes.Public and copy_type_kind : Ast_409.Parsetree.type_kind -> Ast_410.Parsetree.type_kind = function | Ast_409.Parsetree.Ptype_abstract -> Ast_410.Parsetree.Ptype_abstract | Ast_409.Parsetree.Ptype_variant x0 -> Ast_410.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | Ast_409.Parsetree.Ptype_record x0 -> Ast_410.Parsetree.Ptype_record (List.map copy_label_declaration x0) | Ast_409.Parsetree.Ptype_open -> Ast_410.Parsetree.Ptype_open and copy_constructor_declaration : Ast_409.Parsetree.constructor_declaration -> Ast_410.Parsetree.constructor_declaration = fun { Ast_409.Parsetree.pcd_name = pcd_name; Ast_409.Parsetree.pcd_args = pcd_args; Ast_409.Parsetree.pcd_res = pcd_res; Ast_409.Parsetree.pcd_loc = pcd_loc; Ast_409.Parsetree.pcd_attributes = pcd_attributes } -> { Ast_410.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); Ast_410.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); Ast_410.Parsetree.pcd_res = (map_option copy_core_type pcd_res); Ast_410.Parsetree.pcd_loc = (copy_location pcd_loc); Ast_410.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : Ast_409.Parsetree.constructor_arguments -> Ast_410.Parsetree.constructor_arguments = function | Ast_409.Parsetree.Pcstr_tuple x0 -> Ast_410.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | Ast_409.Parsetree.Pcstr_record x0 -> Ast_410.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : Ast_409.Parsetree.label_declaration -> Ast_410.Parsetree.label_declaration = fun { Ast_409.Parsetree.pld_name = pld_name; Ast_409.Parsetree.pld_mutable = pld_mutable; Ast_409.Parsetree.pld_type = pld_type; Ast_409.Parsetree.pld_loc = pld_loc; Ast_409.Parsetree.pld_attributes = pld_attributes } -> { Ast_410.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); Ast_410.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); Ast_410.Parsetree.pld_type = (copy_core_type pld_type); Ast_410.Parsetree.pld_loc = (copy_location pld_loc); Ast_410.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : Ast_409.Asttypes.mutable_flag -> Ast_410.Asttypes.mutable_flag = function | Ast_409.Asttypes.Immutable -> Ast_410.Asttypes.Immutable | Ast_409.Asttypes.Mutable -> Ast_410.Asttypes.Mutable and copy_variance : Ast_409.Asttypes.variance -> Ast_410.Asttypes.variance = function | Ast_409.Asttypes.Covariant -> Ast_410.Asttypes.Covariant | Ast_409.Asttypes.Contravariant -> Ast_410.Asttypes.Contravariant | Ast_409.Asttypes.Invariant -> Ast_410.Asttypes.Invariant and copy_value_description : Ast_409.Parsetree.value_description -> Ast_410.Parsetree.value_description = fun { Ast_409.Parsetree.pval_name = pval_name; Ast_409.Parsetree.pval_type = pval_type; Ast_409.Parsetree.pval_prim = pval_prim; Ast_409.Parsetree.pval_attributes = pval_attributes; Ast_409.Parsetree.pval_loc = pval_loc } -> { Ast_410.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); Ast_410.Parsetree.pval_type = (copy_core_type pval_type); Ast_410.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); Ast_410.Parsetree.pval_attributes = (copy_attributes pval_attributes); Ast_410.Parsetree.pval_loc = (copy_location pval_loc) } and copy_object_field_desc : Ast_409.Parsetree.object_field_desc -> Ast_410.Parsetree.object_field_desc = function | Ast_409.Parsetree.Otag (x0, x1) -> Ast_410.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) | Ast_409.Parsetree.Oinherit x0 -> Ast_410.Parsetree.Oinherit (copy_core_type x0) and copy_arg_label : Ast_409.Asttypes.arg_label -> Ast_410.Asttypes.arg_label = function | Ast_409.Asttypes.Nolabel -> Ast_410.Asttypes.Nolabel | Ast_409.Asttypes.Labelled x0 -> Ast_410.Asttypes.Labelled x0 | Ast_409.Asttypes.Optional x0 -> Ast_410.Asttypes.Optional x0 and copy_closed_flag : Ast_409.Asttypes.closed_flag -> Ast_410.Asttypes.closed_flag = function | Ast_409.Asttypes.Closed -> Ast_410.Asttypes.Closed | Ast_409.Asttypes.Open -> Ast_410.Asttypes.Open and copy_label : Ast_409.Asttypes.label -> Ast_410.Asttypes.label = fun x -> x and copy_rec_flag : Ast_409.Asttypes.rec_flag -> Ast_410.Asttypes.rec_flag = function | Ast_409.Asttypes.Nonrecursive -> Ast_410.Asttypes.Nonrecursive | Ast_409.Asttypes.Recursive -> Ast_410.Asttypes.Recursive and copy_constant : Ast_409.Parsetree.constant -> Ast_410.Parsetree.constant = function | Ast_409.Parsetree.Pconst_integer (x0, x1) -> Ast_410.Parsetree.Pconst_integer (x0, (map_option (fun x -> x) x1)) | Ast_409.Parsetree.Pconst_char x0 -> Ast_410.Parsetree.Pconst_char x0 | Ast_409.Parsetree.Pconst_string (x0, x1) -> Ast_410.Parsetree.Pconst_string (x0, (map_option (fun x -> x) x1)) | Ast_409.Parsetree.Pconst_float (x0, x1) -> Ast_410.Parsetree.Pconst_float (x0, (map_option (fun x -> x) x1)) and copy_Longident_t : Ast_409.Longident.t -> Ast_410.Longident.t = function | Ast_409.Longident.Lident x0 -> Ast_410.Longident.Lident x0 | Ast_409.Longident.Ldot (x0, x1) -> Ast_410.Longident.Ldot ((copy_Longident_t x0), x1) | Ast_409.Longident.Lapply (x0, x1) -> Ast_410.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_409.Asttypes.loc -> 'g0 Ast_410.Asttypes.loc = fun f0 -> fun { Ast_409.Asttypes.txt = txt; Ast_409.Asttypes.loc = loc } -> { Ast_410.Asttypes.txt = (f0 txt); Ast_410.Asttypes.loc = (copy_location loc) } and copy_location : Ast_409.Location.t -> Ast_410.Location.t = fun { Ast_409.Location.loc_start = loc_start; Ast_409.Location.loc_end = loc_end; Ast_409.Location.loc_ghost = loc_ghost } -> { Ast_410.Location.loc_start = (copy_position loc_start); Ast_410.Location.loc_end = (copy_position loc_end); Ast_410.Location.loc_ghost = loc_ghost } and copy_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let copy_expr = copy_expression let copy_pat = copy_pattern let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_410_409.ml000066400000000000000000000171161356450464700240550ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) include Migrate_parsetree_410_409_migrate (*$ open Printf let fields = [ "attribute"; "attributes"; "case"; "cases"; "class_declaration"; "class_description"; "class_expr"; "class_field"; "class_signature"; "class_structure"; "class_type"; "class_type_declaration"; "class_type_field"; "constructor_declaration"; "expr"; "extension"; "extension_constructor"; "include_declaration"; "include_description"; "label_declaration"; "location"; "module_binding"; "module_declaration"; "module_expr"; "module_type"; "module_type_declaration"; "open_description"; "pat"; "signature"; "signature_item"; "structure"; "structure_item"; "typ"; "type_declaration"; "type_extension"; "type_kind"; "value_binding"; "value_description"; "with_constraint"; "payload"; "binding_op"; "module_substitution"; "open_declaration"; "type_exception" ] let foreach_field f = printf "\n"; List.iter f fields *)(*$*) let copy_mapper = fun ({ From.Ast_mapper. (*$ foreach_field (printf "%s;\n")*) attribute; attributes; case; cases; class_declaration; class_description; class_expr; class_field; class_signature; class_structure; class_type; class_type_declaration; class_type_field; constructor_declaration; expr; extension; extension_constructor; include_declaration; include_description; label_declaration; location; module_binding; module_declaration; module_expr; module_type; module_type_declaration; open_description; pat; signature; signature_item; structure; structure_item; typ; type_declaration; type_extension; type_kind; value_binding; value_description; with_constraint; payload; binding_op; module_substitution; open_declaration; type_exception; (*$*) } as mapper) -> let module Def = Migrate_parsetree_def in let module R = Migrate_parsetree_409_410_migrate in { To.Ast_mapper. (*$ foreach_field (fun s -> printf "%s = (fun _ x -> copy_%s (%s mapper (R.copy_%s x)));\n" s s s s) *) attribute = (fun _ x -> copy_attribute (attribute mapper (R.copy_attribute x))); attributes = (fun _ x -> copy_attributes (attributes mapper (R.copy_attributes x))); case = (fun _ x -> copy_case (case mapper (R.copy_case x))); cases = (fun _ x -> copy_cases (cases mapper (R.copy_cases x))); class_declaration = (fun _ x -> copy_class_declaration (class_declaration mapper (R.copy_class_declaration x))); class_description = (fun _ x -> copy_class_description (class_description mapper (R.copy_class_description x))); class_expr = (fun _ x -> copy_class_expr (class_expr mapper (R.copy_class_expr x))); class_field = (fun _ x -> copy_class_field (class_field mapper (R.copy_class_field x))); class_signature = (fun _ x -> copy_class_signature (class_signature mapper (R.copy_class_signature x))); class_structure = (fun _ x -> copy_class_structure (class_structure mapper (R.copy_class_structure x))); class_type = (fun _ x -> copy_class_type (class_type mapper (R.copy_class_type x))); class_type_declaration = (fun _ x -> copy_class_type_declaration (class_type_declaration mapper (R.copy_class_type_declaration x))); class_type_field = (fun _ x -> copy_class_type_field (class_type_field mapper (R.copy_class_type_field x))); constructor_declaration = (fun _ x -> copy_constructor_declaration (constructor_declaration mapper (R.copy_constructor_declaration x))); expr = (fun _ x -> copy_expr (expr mapper (R.copy_expr x))); extension = (fun _ x -> copy_extension (extension mapper (R.copy_extension x))); extension_constructor = (fun _ x -> copy_extension_constructor (extension_constructor mapper (R.copy_extension_constructor x))); include_declaration = (fun _ x -> copy_include_declaration (include_declaration mapper (R.copy_include_declaration x))); include_description = (fun _ x -> copy_include_description (include_description mapper (R.copy_include_description x))); label_declaration = (fun _ x -> copy_label_declaration (label_declaration mapper (R.copy_label_declaration x))); location = (fun _ x -> copy_location (location mapper (R.copy_location x))); module_binding = (fun _ x -> copy_module_binding (module_binding mapper (R.copy_module_binding x))); module_declaration = (fun _ x -> copy_module_declaration (module_declaration mapper (R.copy_module_declaration x))); module_expr = (fun _ x -> copy_module_expr (module_expr mapper (R.copy_module_expr x))); module_type = (fun _ x -> copy_module_type (module_type mapper (R.copy_module_type x))); module_type_declaration = (fun _ x -> copy_module_type_declaration (module_type_declaration mapper (R.copy_module_type_declaration x))); open_description = (fun _ x -> copy_open_description (open_description mapper (R.copy_open_description x))); pat = (fun _ x -> copy_pat (pat mapper (R.copy_pat x))); signature = (fun _ x -> copy_signature (signature mapper (R.copy_signature x))); signature_item = (fun _ x -> copy_signature_item (signature_item mapper (R.copy_signature_item x))); structure = (fun _ x -> copy_structure (structure mapper (R.copy_structure x))); structure_item = (fun _ x -> copy_structure_item (structure_item mapper (R.copy_structure_item x))); typ = (fun _ x -> copy_typ (typ mapper (R.copy_typ x))); type_declaration = (fun _ x -> copy_type_declaration (type_declaration mapper (R.copy_type_declaration x))); type_extension = (fun _ x -> copy_type_extension (type_extension mapper (R.copy_type_extension x))); type_kind = (fun _ x -> copy_type_kind (type_kind mapper (R.copy_type_kind x))); value_binding = (fun _ x -> copy_value_binding (value_binding mapper (R.copy_value_binding x))); value_description = (fun _ x -> copy_value_description (value_description mapper (R.copy_value_description x))); with_constraint = (fun _ x -> copy_with_constraint (with_constraint mapper (R.copy_with_constraint x))); payload = (fun _ x -> copy_payload (payload mapper (R.copy_payload x))); binding_op = (fun _ x -> copy_binding_op (binding_op mapper (R.copy_binding_op x))); module_substitution = (fun _ x -> copy_module_substitution (module_substitution mapper (R.copy_module_substitution x))); open_declaration = (fun _ x -> copy_open_declaration (open_declaration mapper (R.copy_open_declaration x))); type_exception = (fun _ x -> copy_type_exception (type_exception mapper (R.copy_type_exception x))); (*$*) } ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_410_409_migrate.ml000066400000000000000000002011651356450464700255640ustar00rootroot00000000000000module From = Ast_410 module To = Ast_409 module Def = Migrate_parsetree_def let migration_error location feature = raise (Def.Migration_error (feature, location)) let map_option f x = match x with | None -> None | Some x -> Some (f x) let rec copy_out_type_extension : Ast_410.Outcometree.out_type_extension -> Ast_409.Outcometree.out_type_extension = fun { Ast_410.Outcometree.otyext_name = otyext_name; Ast_410.Outcometree.otyext_params = otyext_params; Ast_410.Outcometree.otyext_constructors = otyext_constructors; Ast_410.Outcometree.otyext_private = otyext_private } -> { Ast_409.Outcometree.otyext_name = otyext_name; Ast_409.Outcometree.otyext_params = (List.map (fun x -> x) otyext_params); Ast_409.Outcometree.otyext_constructors = (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (map_option copy_out_type x2))) otyext_constructors); Ast_409.Outcometree.otyext_private = (copy_private_flag otyext_private) } and copy_out_phrase : Ast_410.Outcometree.out_phrase -> Ast_409.Outcometree.out_phrase = function | Ast_410.Outcometree.Ophr_eval (x0, x1) -> Ast_409.Outcometree.Ophr_eval ((copy_out_value x0), (copy_out_type x1)) | Ast_410.Outcometree.Ophr_signature x0 -> Ast_409.Outcometree.Ophr_signature (List.map (fun x -> let (x0, x1) = x in ((copy_out_sig_item x0), (map_option copy_out_value x1))) x0) | Ast_410.Outcometree.Ophr_exception x0 -> Ast_409.Outcometree.Ophr_exception (let (x0, x1) = x0 in (x0, (copy_out_value x1))) and copy_out_sig_item : Ast_410.Outcometree.out_sig_item -> Ast_409.Outcometree.out_sig_item = function | Ast_410.Outcometree.Osig_class (x0, x1, x2, x3, x4) -> Ast_409.Outcometree.Osig_class (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_410.Outcometree.Osig_class_type (x0, x1, x2, x3, x4) -> Ast_409.Outcometree.Osig_class_type (x0, x1, (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) x2), (copy_out_class_type x3), (copy_out_rec_status x4)) | Ast_410.Outcometree.Osig_typext (x0, x1) -> Ast_409.Outcometree.Osig_typext ((copy_out_extension_constructor x0), (copy_out_ext_status x1)) | Ast_410.Outcometree.Osig_modtype (x0, x1) -> Ast_409.Outcometree.Osig_modtype (x0, (copy_out_module_type x1)) | Ast_410.Outcometree.Osig_module (x0, x1, x2) -> Ast_409.Outcometree.Osig_module (x0, (copy_out_module_type x1), (copy_out_rec_status x2)) | Ast_410.Outcometree.Osig_type (x0, x1) -> Ast_409.Outcometree.Osig_type ((copy_out_type_decl x0), (copy_out_rec_status x1)) | Ast_410.Outcometree.Osig_value x0 -> Ast_409.Outcometree.Osig_value (copy_out_val_decl x0) | Ast_410.Outcometree.Osig_ellipsis -> Ast_409.Outcometree.Osig_ellipsis and copy_out_val_decl : Ast_410.Outcometree.out_val_decl -> Ast_409.Outcometree.out_val_decl = fun { Ast_410.Outcometree.oval_name = oval_name; Ast_410.Outcometree.oval_type = oval_type; Ast_410.Outcometree.oval_prims = oval_prims; Ast_410.Outcometree.oval_attributes = oval_attributes } -> { Ast_409.Outcometree.oval_name = oval_name; Ast_409.Outcometree.oval_type = (copy_out_type oval_type); Ast_409.Outcometree.oval_prims = (List.map (fun x -> x) oval_prims); Ast_409.Outcometree.oval_attributes = (List.map copy_out_attribute oval_attributes) } and copy_out_type_decl : Ast_410.Outcometree.out_type_decl -> Ast_409.Outcometree.out_type_decl = fun { Ast_410.Outcometree.otype_name = otype_name; Ast_410.Outcometree.otype_params = otype_params; Ast_410.Outcometree.otype_type = otype_type; Ast_410.Outcometree.otype_private = otype_private; Ast_410.Outcometree.otype_immediate = otype_immediate; Ast_410.Outcometree.otype_unboxed = otype_unboxed; Ast_410.Outcometree.otype_cstrs = otype_cstrs } -> { Ast_409.Outcometree.otype_name = otype_name; Ast_409.Outcometree.otype_params = (List.map (fun x -> let (x0, x1) = x in (x0, (let (x0, x1) = x1 in (x0, x1)))) otype_params); Ast_409.Outcometree.otype_type = (copy_out_type otype_type); Ast_409.Outcometree.otype_private = (copy_private_flag otype_private); Ast_409.Outcometree.otype_immediate = (copy_Type_immediacy_t otype_immediate); Ast_409.Outcometree.otype_unboxed = otype_unboxed; Ast_409.Outcometree.otype_cstrs = (List.map (fun x -> let (x0, x1) = x in ((copy_out_type x0), (copy_out_type x1))) otype_cstrs) } and copy_Type_immediacy_t : Ast_410.Type_immediacy.t -> bool = function | Ast_410.Type_immediacy.Unknown -> false | Ast_410.Type_immediacy.Always -> true | Ast_410.Type_immediacy.Always_on_64bits -> migration_error Location.none Immediate64 and copy_out_module_type : Ast_410.Outcometree.out_module_type -> Ast_409.Outcometree.out_module_type = function | Ast_410.Outcometree.Omty_abstract -> Ast_409.Outcometree.Omty_abstract | Ast_410.Outcometree.Omty_functor (x0, x1) -> let name, mt = match x0 with | None -> "*", None | Some (None, mt) -> "_", Some (copy_out_module_type mt) | Some (Some s, mt) -> s, Some (copy_out_module_type mt) in Ast_409.Outcometree.Omty_functor (name, mt, copy_out_module_type x1) | Ast_410.Outcometree.Omty_ident x0 -> Ast_409.Outcometree.Omty_ident (copy_out_ident x0) | Ast_410.Outcometree.Omty_signature x0 -> Ast_409.Outcometree.Omty_signature (List.map copy_out_sig_item x0) | Ast_410.Outcometree.Omty_alias x0 -> Ast_409.Outcometree.Omty_alias (copy_out_ident x0) and copy_out_ext_status : Ast_410.Outcometree.out_ext_status -> Ast_409.Outcometree.out_ext_status = function | Ast_410.Outcometree.Oext_first -> Ast_409.Outcometree.Oext_first | Ast_410.Outcometree.Oext_next -> Ast_409.Outcometree.Oext_next | Ast_410.Outcometree.Oext_exception -> Ast_409.Outcometree.Oext_exception and copy_out_extension_constructor : Ast_410.Outcometree.out_extension_constructor -> Ast_409.Outcometree.out_extension_constructor = fun { Ast_410.Outcometree.oext_name = oext_name; Ast_410.Outcometree.oext_type_name = oext_type_name; Ast_410.Outcometree.oext_type_params = oext_type_params; Ast_410.Outcometree.oext_args = oext_args; Ast_410.Outcometree.oext_ret_type = oext_ret_type; Ast_410.Outcometree.oext_private = oext_private } -> { Ast_409.Outcometree.oext_name = oext_name; Ast_409.Outcometree.oext_type_name = oext_type_name; Ast_409.Outcometree.oext_type_params = (List.map (fun x -> x) oext_type_params); Ast_409.Outcometree.oext_args = (List.map copy_out_type oext_args); Ast_409.Outcometree.oext_ret_type = (map_option copy_out_type oext_ret_type); Ast_409.Outcometree.oext_private = (copy_private_flag oext_private) } and copy_out_rec_status : Ast_410.Outcometree.out_rec_status -> Ast_409.Outcometree.out_rec_status = function | Ast_410.Outcometree.Orec_not -> Ast_409.Outcometree.Orec_not | Ast_410.Outcometree.Orec_first -> Ast_409.Outcometree.Orec_first | Ast_410.Outcometree.Orec_next -> Ast_409.Outcometree.Orec_next and copy_out_class_type : Ast_410.Outcometree.out_class_type -> Ast_409.Outcometree.out_class_type = function | Ast_410.Outcometree.Octy_constr (x0, x1) -> Ast_409.Outcometree.Octy_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_410.Outcometree.Octy_arrow (x0, x1, x2) -> Ast_409.Outcometree.Octy_arrow (x0, (copy_out_type x1), (copy_out_class_type x2)) | Ast_410.Outcometree.Octy_signature (x0, x1) -> Ast_409.Outcometree.Octy_signature ((map_option copy_out_type x0), (List.map copy_out_class_sig_item x1)) and copy_out_class_sig_item : Ast_410.Outcometree.out_class_sig_item -> Ast_409.Outcometree.out_class_sig_item = function | Ast_410.Outcometree.Ocsg_constraint (x0, x1) -> Ast_409.Outcometree.Ocsg_constraint ((copy_out_type x0), (copy_out_type x1)) | Ast_410.Outcometree.Ocsg_method (x0, x1, x2, x3) -> Ast_409.Outcometree.Ocsg_method (x0, x1, x2, (copy_out_type x3)) | Ast_410.Outcometree.Ocsg_value (x0, x1, x2, x3) -> Ast_409.Outcometree.Ocsg_value (x0, x1, x2, (copy_out_type x3)) and copy_out_type : Ast_410.Outcometree.out_type -> Ast_409.Outcometree.out_type = function | Ast_410.Outcometree.Otyp_abstract -> Ast_409.Outcometree.Otyp_abstract | Ast_410.Outcometree.Otyp_open -> Ast_409.Outcometree.Otyp_open | Ast_410.Outcometree.Otyp_alias (x0, x1) -> Ast_409.Outcometree.Otyp_alias ((copy_out_type x0), x1) | Ast_410.Outcometree.Otyp_arrow (x0, x1, x2) -> Ast_409.Outcometree.Otyp_arrow (x0, (copy_out_type x1), (copy_out_type x2)) | Ast_410.Outcometree.Otyp_class (x0, x1, x2) -> Ast_409.Outcometree.Otyp_class (x0, (copy_out_ident x1), (List.map copy_out_type x2)) | Ast_410.Outcometree.Otyp_constr (x0, x1) -> Ast_409.Outcometree.Otyp_constr ((copy_out_ident x0), (List.map copy_out_type x1)) | Ast_410.Outcometree.Otyp_manifest (x0, x1) -> Ast_409.Outcometree.Otyp_manifest ((copy_out_type x0), (copy_out_type x1)) | Ast_410.Outcometree.Otyp_object (x0, x1) -> Ast_409.Outcometree.Otyp_object ((List.map (fun x -> let (x0, x1) = x in (x0, (copy_out_type x1))) x0), (map_option (fun x -> x) x1)) | Ast_410.Outcometree.Otyp_record x0 -> Ast_409.Outcometree.Otyp_record (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (copy_out_type x2))) x0) | Ast_410.Outcometree.Otyp_stuff x0 -> Ast_409.Outcometree.Otyp_stuff x0 | Ast_410.Outcometree.Otyp_sum x0 -> Ast_409.Outcometree.Otyp_sum (List.map (fun x -> let (x0, x1, x2) = x in (x0, (List.map copy_out_type x1), (map_option copy_out_type x2))) x0) | Ast_410.Outcometree.Otyp_tuple x0 -> Ast_409.Outcometree.Otyp_tuple (List.map copy_out_type x0) | Ast_410.Outcometree.Otyp_var (x0, x1) -> Ast_409.Outcometree.Otyp_var (x0, x1) | Ast_410.Outcometree.Otyp_variant (x0, x1, x2, x3) -> Ast_409.Outcometree.Otyp_variant (x0, (copy_out_variant x1), x2, (map_option (fun x -> List.map (fun x -> x) x) x3)) | Ast_410.Outcometree.Otyp_poly (x0, x1) -> Ast_409.Outcometree.Otyp_poly ((List.map (fun x -> x) x0), (copy_out_type x1)) | Ast_410.Outcometree.Otyp_module (x0, x1, x2) -> Ast_409.Outcometree.Otyp_module ((copy_out_ident x0), (List.map (fun x -> x) x1), (List.map copy_out_type x2)) | Ast_410.Outcometree.Otyp_attribute (x0, x1) -> Ast_409.Outcometree.Otyp_attribute ((copy_out_type x0), (copy_out_attribute x1)) and copy_out_attribute : Ast_410.Outcometree.out_attribute -> Ast_409.Outcometree.out_attribute = fun { Ast_410.Outcometree.oattr_name = oattr_name } -> { Ast_409.Outcometree.oattr_name = oattr_name } and copy_out_variant : Ast_410.Outcometree.out_variant -> Ast_409.Outcometree.out_variant = function | Ast_410.Outcometree.Ovar_fields x0 -> Ast_409.Outcometree.Ovar_fields (List.map (fun x -> let (x0, x1, x2) = x in (x0, x1, (List.map copy_out_type x2))) x0) | Ast_410.Outcometree.Ovar_typ x0 -> Ast_409.Outcometree.Ovar_typ (copy_out_type x0) and copy_out_value : Ast_410.Outcometree.out_value -> Ast_409.Outcometree.out_value = function | Ast_410.Outcometree.Oval_array x0 -> Ast_409.Outcometree.Oval_array (List.map copy_out_value x0) | Ast_410.Outcometree.Oval_char x0 -> Ast_409.Outcometree.Oval_char x0 | Ast_410.Outcometree.Oval_constr (x0, x1) -> Ast_409.Outcometree.Oval_constr ((copy_out_ident x0), (List.map copy_out_value x1)) | Ast_410.Outcometree.Oval_ellipsis -> Ast_409.Outcometree.Oval_ellipsis | Ast_410.Outcometree.Oval_float x0 -> Ast_409.Outcometree.Oval_float x0 | Ast_410.Outcometree.Oval_int x0 -> Ast_409.Outcometree.Oval_int x0 | Ast_410.Outcometree.Oval_int32 x0 -> Ast_409.Outcometree.Oval_int32 x0 | Ast_410.Outcometree.Oval_int64 x0 -> Ast_409.Outcometree.Oval_int64 x0 | Ast_410.Outcometree.Oval_nativeint x0 -> Ast_409.Outcometree.Oval_nativeint x0 | Ast_410.Outcometree.Oval_list x0 -> Ast_409.Outcometree.Oval_list (List.map copy_out_value x0) | Ast_410.Outcometree.Oval_printer x0 -> Ast_409.Outcometree.Oval_printer x0 | Ast_410.Outcometree.Oval_record x0 -> Ast_409.Outcometree.Oval_record (List.map (fun x -> let (x0, x1) = x in ((copy_out_ident x0), (copy_out_value x1))) x0) | Ast_410.Outcometree.Oval_string (x0, x1, x2) -> Ast_409.Outcometree.Oval_string (x0, x1, (copy_out_string x2)) | Ast_410.Outcometree.Oval_stuff x0 -> Ast_409.Outcometree.Oval_stuff x0 | Ast_410.Outcometree.Oval_tuple x0 -> Ast_409.Outcometree.Oval_tuple (List.map copy_out_value x0) | Ast_410.Outcometree.Oval_variant (x0, x1) -> Ast_409.Outcometree.Oval_variant (x0, (map_option copy_out_value x1)) and copy_out_string : Ast_410.Outcometree.out_string -> Ast_409.Outcometree.out_string = function | Ast_410.Outcometree.Ostr_string -> Ast_409.Outcometree.Ostr_string | Ast_410.Outcometree.Ostr_bytes -> Ast_409.Outcometree.Ostr_bytes and copy_out_ident : Ast_410.Outcometree.out_ident -> Ast_409.Outcometree.out_ident = function | Ast_410.Outcometree.Oide_apply (x0, x1) -> Ast_409.Outcometree.Oide_apply ((copy_out_ident x0), (copy_out_ident x1)) | Ast_410.Outcometree.Oide_dot (x0, x1) -> Ast_409.Outcometree.Oide_dot ((copy_out_ident x0), x1) | Ast_410.Outcometree.Oide_ident x0 -> Ast_409.Outcometree.Oide_ident (copy_out_name x0) and copy_out_name : Ast_410.Outcometree.out_name -> Ast_409.Outcometree.out_name = fun { Ast_410.Outcometree.printed_name = printed_name } -> { Ast_409.Outcometree.printed_name = printed_name } and copy_toplevel_phrase : Ast_410.Parsetree.toplevel_phrase -> Ast_409.Parsetree.toplevel_phrase = function | Ast_410.Parsetree.Ptop_def x0 -> Ast_409.Parsetree.Ptop_def (copy_structure x0) | Ast_410.Parsetree.Ptop_dir x0 -> Ast_409.Parsetree.Ptop_dir (copy_toplevel_directive x0) and copy_toplevel_directive : Ast_410.Parsetree.toplevel_directive -> Ast_409.Parsetree.toplevel_directive = fun { Ast_410.Parsetree.pdir_name = pdir_name; Ast_410.Parsetree.pdir_arg = pdir_arg; Ast_410.Parsetree.pdir_loc = pdir_loc } -> { Ast_409.Parsetree.pdir_name = (copy_loc (fun x -> x) pdir_name); Ast_409.Parsetree.pdir_arg = (map_option copy_directive_argument pdir_arg); Ast_409.Parsetree.pdir_loc = (copy_location pdir_loc) } and copy_directive_argument : Ast_410.Parsetree.directive_argument -> Ast_409.Parsetree.directive_argument = fun { Ast_410.Parsetree.pdira_desc = pdira_desc; Ast_410.Parsetree.pdira_loc = pdira_loc } -> { Ast_409.Parsetree.pdira_desc = (copy_directive_argument_desc pdira_desc); Ast_409.Parsetree.pdira_loc = (copy_location pdira_loc) } and copy_directive_argument_desc : Ast_410.Parsetree.directive_argument_desc -> Ast_409.Parsetree.directive_argument_desc = function | Ast_410.Parsetree.Pdir_string x0 -> Ast_409.Parsetree.Pdir_string x0 | Ast_410.Parsetree.Pdir_int (x0, x1) -> Ast_409.Parsetree.Pdir_int (x0, (map_option (fun x -> x) x1)) | Ast_410.Parsetree.Pdir_ident x0 -> Ast_409.Parsetree.Pdir_ident (copy_Longident_t x0) | Ast_410.Parsetree.Pdir_bool x0 -> Ast_409.Parsetree.Pdir_bool x0 and copy_expression : Ast_410.Parsetree.expression -> Ast_409.Parsetree.expression = fun { Ast_410.Parsetree.pexp_desc = pexp_desc; Ast_410.Parsetree.pexp_loc = pexp_loc; Ast_410.Parsetree.pexp_loc_stack = pexp_loc_stack; Ast_410.Parsetree.pexp_attributes = pexp_attributes } -> { Ast_409.Parsetree.pexp_desc = (copy_expression_desc pexp_desc); Ast_409.Parsetree.pexp_loc = (copy_location pexp_loc); Ast_409.Parsetree.pexp_loc_stack = (copy_location_stack pexp_loc_stack); Ast_409.Parsetree.pexp_attributes = (copy_attributes pexp_attributes) } and copy_expression_desc : Ast_410.Parsetree.expression_desc -> Ast_409.Parsetree.expression_desc = function | Ast_410.Parsetree.Pexp_ident x0 -> Ast_409.Parsetree.Pexp_ident (copy_loc copy_Longident_t x0) | Ast_410.Parsetree.Pexp_constant x0 -> Ast_409.Parsetree.Pexp_constant (copy_constant x0) | Ast_410.Parsetree.Pexp_let (x0, x1, x2) -> Ast_409.Parsetree.Pexp_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_expression x2)) | Ast_410.Parsetree.Pexp_function x0 -> Ast_409.Parsetree.Pexp_function (List.map copy_case x0) | Ast_410.Parsetree.Pexp_fun (x0, x1, x2, x3) -> Ast_409.Parsetree.Pexp_fun ((copy_arg_label x0), (map_option copy_expression x1), (copy_pattern x2), (copy_expression x3)) | Ast_410.Parsetree.Pexp_apply (x0, x1) -> Ast_409.Parsetree.Pexp_apply ((copy_expression x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_410.Parsetree.Pexp_match (x0, x1) -> Ast_409.Parsetree.Pexp_match ((copy_expression x0), (List.map copy_case x1)) | Ast_410.Parsetree.Pexp_try (x0, x1) -> Ast_409.Parsetree.Pexp_try ((copy_expression x0), (List.map copy_case x1)) | Ast_410.Parsetree.Pexp_tuple x0 -> Ast_409.Parsetree.Pexp_tuple (List.map copy_expression x0) | Ast_410.Parsetree.Pexp_construct (x0, x1) -> Ast_409.Parsetree.Pexp_construct ((copy_loc copy_Longident_t x0), (map_option copy_expression x1)) | Ast_410.Parsetree.Pexp_variant (x0, x1) -> Ast_409.Parsetree.Pexp_variant ((copy_label x0), (map_option copy_expression x1)) | Ast_410.Parsetree.Pexp_record (x0, x1) -> Ast_409.Parsetree.Pexp_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_expression x1))) x0), (map_option copy_expression x1)) | Ast_410.Parsetree.Pexp_field (x0, x1) -> Ast_409.Parsetree.Pexp_field ((copy_expression x0), (copy_loc copy_Longident_t x1)) | Ast_410.Parsetree.Pexp_setfield (x0, x1, x2) -> Ast_409.Parsetree.Pexp_setfield ((copy_expression x0), (copy_loc copy_Longident_t x1), (copy_expression x2)) | Ast_410.Parsetree.Pexp_array x0 -> Ast_409.Parsetree.Pexp_array (List.map copy_expression x0) | Ast_410.Parsetree.Pexp_ifthenelse (x0, x1, x2) -> Ast_409.Parsetree.Pexp_ifthenelse ((copy_expression x0), (copy_expression x1), (map_option copy_expression x2)) | Ast_410.Parsetree.Pexp_sequence (x0, x1) -> Ast_409.Parsetree.Pexp_sequence ((copy_expression x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_while (x0, x1) -> Ast_409.Parsetree.Pexp_while ((copy_expression x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_for (x0, x1, x2, x3, x4) -> Ast_409.Parsetree.Pexp_for ((copy_pattern x0), (copy_expression x1), (copy_expression x2), (copy_direction_flag x3), (copy_expression x4)) | Ast_410.Parsetree.Pexp_constraint (x0, x1) -> Ast_409.Parsetree.Pexp_constraint ((copy_expression x0), (copy_core_type x1)) | Ast_410.Parsetree.Pexp_coerce (x0, x1, x2) -> Ast_409.Parsetree.Pexp_coerce ((copy_expression x0), (map_option copy_core_type x1), (copy_core_type x2)) | Ast_410.Parsetree.Pexp_send (x0, x1) -> Ast_409.Parsetree.Pexp_send ((copy_expression x0), (copy_loc copy_label x1)) | Ast_410.Parsetree.Pexp_new x0 -> Ast_409.Parsetree.Pexp_new (copy_loc copy_Longident_t x0) | Ast_410.Parsetree.Pexp_setinstvar (x0, x1) -> Ast_409.Parsetree.Pexp_setinstvar ((copy_loc copy_label x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_override x0 -> Ast_409.Parsetree.Pexp_override (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_label x0), (copy_expression x1))) x0) | Ast_410.Parsetree.Pexp_letmodule (x0, x1, x2) -> Ast_409.Parsetree.Pexp_letmodule ((copy_loc (function | None -> migration_error x0.loc Anonymous_let_module | Some x -> x) x0), (copy_module_expr x1), (copy_expression x2)) | Ast_410.Parsetree.Pexp_letexception (x0, x1) -> Ast_409.Parsetree.Pexp_letexception ((copy_extension_constructor x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_assert x0 -> Ast_409.Parsetree.Pexp_assert (copy_expression x0) | Ast_410.Parsetree.Pexp_lazy x0 -> Ast_409.Parsetree.Pexp_lazy (copy_expression x0) | Ast_410.Parsetree.Pexp_poly (x0, x1) -> Ast_409.Parsetree.Pexp_poly ((copy_expression x0), (map_option copy_core_type x1)) | Ast_410.Parsetree.Pexp_object x0 -> Ast_409.Parsetree.Pexp_object (copy_class_structure x0) | Ast_410.Parsetree.Pexp_newtype (x0, x1) -> Ast_409.Parsetree.Pexp_newtype ((copy_loc (fun x -> x) x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_pack x0 -> Ast_409.Parsetree.Pexp_pack (copy_module_expr x0) | Ast_410.Parsetree.Pexp_open (x0, x1) -> Ast_409.Parsetree.Pexp_open ((copy_open_declaration x0), (copy_expression x1)) | Ast_410.Parsetree.Pexp_letop x0 -> Ast_409.Parsetree.Pexp_letop (copy_letop x0) | Ast_410.Parsetree.Pexp_extension x0 -> Ast_409.Parsetree.Pexp_extension (copy_extension x0) | Ast_410.Parsetree.Pexp_unreachable -> Ast_409.Parsetree.Pexp_unreachable and copy_letop : Ast_410.Parsetree.letop -> Ast_409.Parsetree.letop = fun { Ast_410.Parsetree.let_ = let_; Ast_410.Parsetree.ands = ands; Ast_410.Parsetree.body = body } -> { Ast_409.Parsetree.let_ = (copy_binding_op let_); Ast_409.Parsetree.ands = (List.map copy_binding_op ands); Ast_409.Parsetree.body = (copy_expression body) } and copy_binding_op : Ast_410.Parsetree.binding_op -> Ast_409.Parsetree.binding_op = fun { Ast_410.Parsetree.pbop_op = pbop_op; Ast_410.Parsetree.pbop_pat = pbop_pat; Ast_410.Parsetree.pbop_exp = pbop_exp; Ast_410.Parsetree.pbop_loc = pbop_loc } -> { Ast_409.Parsetree.pbop_op = (copy_loc (fun x -> x) pbop_op); Ast_409.Parsetree.pbop_pat = (copy_pattern pbop_pat); Ast_409.Parsetree.pbop_exp = (copy_expression pbop_exp); Ast_409.Parsetree.pbop_loc = (copy_location pbop_loc) } and copy_direction_flag : Ast_410.Asttypes.direction_flag -> Ast_409.Asttypes.direction_flag = function | Ast_410.Asttypes.Upto -> Ast_409.Asttypes.Upto | Ast_410.Asttypes.Downto -> Ast_409.Asttypes.Downto and copy_case : Ast_410.Parsetree.case -> Ast_409.Parsetree.case = fun { Ast_410.Parsetree.pc_lhs = pc_lhs; Ast_410.Parsetree.pc_guard = pc_guard; Ast_410.Parsetree.pc_rhs = pc_rhs } -> { Ast_409.Parsetree.pc_lhs = (copy_pattern pc_lhs); Ast_409.Parsetree.pc_guard = (map_option copy_expression pc_guard); Ast_409.Parsetree.pc_rhs = (copy_expression pc_rhs) } and copy_cases : Ast_410.Parsetree.case list -> Ast_409.Parsetree.cases = fun x -> List.map copy_case x and copy_value_binding : Ast_410.Parsetree.value_binding -> Ast_409.Parsetree.value_binding = fun { Ast_410.Parsetree.pvb_pat = pvb_pat; Ast_410.Parsetree.pvb_expr = pvb_expr; Ast_410.Parsetree.pvb_attributes = pvb_attributes; Ast_410.Parsetree.pvb_loc = pvb_loc } -> { Ast_409.Parsetree.pvb_pat = (copy_pattern pvb_pat); Ast_409.Parsetree.pvb_expr = (copy_expression pvb_expr); Ast_409.Parsetree.pvb_attributes = (copy_attributes pvb_attributes); Ast_409.Parsetree.pvb_loc = (copy_location pvb_loc) } and copy_pattern : Ast_410.Parsetree.pattern -> Ast_409.Parsetree.pattern = fun { Ast_410.Parsetree.ppat_desc = ppat_desc; Ast_410.Parsetree.ppat_loc = ppat_loc; Ast_410.Parsetree.ppat_loc_stack = ppat_loc_stack; Ast_410.Parsetree.ppat_attributes = ppat_attributes } -> { Ast_409.Parsetree.ppat_desc = (copy_pattern_desc ppat_desc); Ast_409.Parsetree.ppat_loc = (copy_location ppat_loc); Ast_409.Parsetree.ppat_loc_stack = (copy_location_stack ppat_loc_stack); Ast_409.Parsetree.ppat_attributes = (copy_attributes ppat_attributes) } and copy_pattern_desc : Ast_410.Parsetree.pattern_desc -> Ast_409.Parsetree.pattern_desc = function | Ast_410.Parsetree.Ppat_any -> Ast_409.Parsetree.Ppat_any | Ast_410.Parsetree.Ppat_var x0 -> Ast_409.Parsetree.Ppat_var (copy_loc (fun x -> x) x0) | Ast_410.Parsetree.Ppat_alias (x0, x1) -> Ast_409.Parsetree.Ppat_alias ((copy_pattern x0), (copy_loc (fun x -> x) x1)) | Ast_410.Parsetree.Ppat_constant x0 -> Ast_409.Parsetree.Ppat_constant (copy_constant x0) | Ast_410.Parsetree.Ppat_interval (x0, x1) -> Ast_409.Parsetree.Ppat_interval ((copy_constant x0), (copy_constant x1)) | Ast_410.Parsetree.Ppat_tuple x0 -> Ast_409.Parsetree.Ppat_tuple (List.map copy_pattern x0) | Ast_410.Parsetree.Ppat_construct (x0, x1) -> Ast_409.Parsetree.Ppat_construct ((copy_loc copy_Longident_t x0), (map_option copy_pattern x1)) | Ast_410.Parsetree.Ppat_variant (x0, x1) -> Ast_409.Parsetree.Ppat_variant ((copy_label x0), (map_option copy_pattern x1)) | Ast_410.Parsetree.Ppat_record (x0, x1) -> Ast_409.Parsetree.Ppat_record ((List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_pattern x1))) x0), (copy_closed_flag x1)) | Ast_410.Parsetree.Ppat_array x0 -> Ast_409.Parsetree.Ppat_array (List.map copy_pattern x0) | Ast_410.Parsetree.Ppat_or (x0, x1) -> Ast_409.Parsetree.Ppat_or ((copy_pattern x0), (copy_pattern x1)) | Ast_410.Parsetree.Ppat_constraint (x0, x1) -> Ast_409.Parsetree.Ppat_constraint ((copy_pattern x0), (copy_core_type x1)) | Ast_410.Parsetree.Ppat_type x0 -> Ast_409.Parsetree.Ppat_type (copy_loc copy_Longident_t x0) | Ast_410.Parsetree.Ppat_lazy x0 -> Ast_409.Parsetree.Ppat_lazy (copy_pattern x0) | Ast_410.Parsetree.Ppat_unpack x0 -> Ast_409.Parsetree.Ppat_unpack (copy_loc (function | None -> migration_error x0.loc Anonymous_unpack | Some x -> x) x0) | Ast_410.Parsetree.Ppat_exception x0 -> Ast_409.Parsetree.Ppat_exception (copy_pattern x0) | Ast_410.Parsetree.Ppat_extension x0 -> Ast_409.Parsetree.Ppat_extension (copy_extension x0) | Ast_410.Parsetree.Ppat_open (x0, x1) -> Ast_409.Parsetree.Ppat_open ((copy_loc copy_Longident_t x0), (copy_pattern x1)) and copy_core_type : Ast_410.Parsetree.core_type -> Ast_409.Parsetree.core_type = fun { Ast_410.Parsetree.ptyp_desc = ptyp_desc; Ast_410.Parsetree.ptyp_loc = ptyp_loc; Ast_410.Parsetree.ptyp_loc_stack = ptyp_loc_stack; Ast_410.Parsetree.ptyp_attributes = ptyp_attributes } -> { Ast_409.Parsetree.ptyp_desc = (copy_core_type_desc ptyp_desc); Ast_409.Parsetree.ptyp_loc = (copy_location ptyp_loc); Ast_409.Parsetree.ptyp_loc_stack = (copy_location_stack ptyp_loc_stack); Ast_409.Parsetree.ptyp_attributes = (copy_attributes ptyp_attributes) } and copy_location_stack : Ast_410.Parsetree.location_stack -> Ast_409.Location.t list = fun x -> List.map copy_location x and copy_core_type_desc : Ast_410.Parsetree.core_type_desc -> Ast_409.Parsetree.core_type_desc = function | Ast_410.Parsetree.Ptyp_any -> Ast_409.Parsetree.Ptyp_any | Ast_410.Parsetree.Ptyp_var x0 -> Ast_409.Parsetree.Ptyp_var x0 | Ast_410.Parsetree.Ptyp_arrow (x0, x1, x2) -> Ast_409.Parsetree.Ptyp_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_core_type x2)) | Ast_410.Parsetree.Ptyp_tuple x0 -> Ast_409.Parsetree.Ptyp_tuple (List.map copy_core_type x0) | Ast_410.Parsetree.Ptyp_constr (x0, x1) -> Ast_409.Parsetree.Ptyp_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_410.Parsetree.Ptyp_object (x0, x1) -> Ast_409.Parsetree.Ptyp_object ((List.map copy_object_field x0), (copy_closed_flag x1)) | Ast_410.Parsetree.Ptyp_class (x0, x1) -> Ast_409.Parsetree.Ptyp_class ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_410.Parsetree.Ptyp_alias (x0, x1) -> Ast_409.Parsetree.Ptyp_alias ((copy_core_type x0), x1) | Ast_410.Parsetree.Ptyp_variant (x0, x1, x2) -> Ast_409.Parsetree.Ptyp_variant ((List.map copy_row_field x0), (copy_closed_flag x1), (map_option (fun x -> List.map copy_label x) x2)) | Ast_410.Parsetree.Ptyp_poly (x0, x1) -> Ast_409.Parsetree.Ptyp_poly ((List.map (fun x -> copy_loc (fun x -> x) x) x0), (copy_core_type x1)) | Ast_410.Parsetree.Ptyp_package x0 -> Ast_409.Parsetree.Ptyp_package (copy_package_type x0) | Ast_410.Parsetree.Ptyp_extension x0 -> Ast_409.Parsetree.Ptyp_extension (copy_extension x0) and copy_package_type : Ast_410.Parsetree.package_type -> Ast_409.Parsetree.package_type = fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (List.map (fun x -> let (x0, x1) = x in ((copy_loc copy_Longident_t x0), (copy_core_type x1))) x1)) and copy_row_field : Ast_410.Parsetree.row_field -> Ast_409.Parsetree.row_field = fun { Ast_410.Parsetree.prf_desc = prf_desc; Ast_410.Parsetree.prf_loc = prf_loc; Ast_410.Parsetree.prf_attributes = prf_attributes } -> { Ast_409.Parsetree.prf_desc = (copy_row_field_desc prf_desc); Ast_409.Parsetree.prf_loc = (copy_location prf_loc); Ast_409.Parsetree.prf_attributes = (copy_attributes prf_attributes) } and copy_row_field_desc : Ast_410.Parsetree.row_field_desc -> Ast_409.Parsetree.row_field_desc = function | Ast_410.Parsetree.Rtag (x0, x1, x2) -> Ast_409.Parsetree.Rtag ((copy_loc copy_label x0), x1, (List.map copy_core_type x2)) | Ast_410.Parsetree.Rinherit x0 -> Ast_409.Parsetree.Rinherit (copy_core_type x0) and copy_object_field : Ast_410.Parsetree.object_field -> Ast_409.Parsetree.object_field = fun { Ast_410.Parsetree.pof_desc = pof_desc; Ast_410.Parsetree.pof_loc = pof_loc; Ast_410.Parsetree.pof_attributes = pof_attributes } -> { Ast_409.Parsetree.pof_desc = (copy_object_field_desc pof_desc); Ast_409.Parsetree.pof_loc = (copy_location pof_loc); Ast_409.Parsetree.pof_attributes = (copy_attributes pof_attributes) } and copy_attributes : Ast_410.Parsetree.attributes -> Ast_409.Parsetree.attributes = fun x -> List.map copy_attribute x and copy_attribute : Ast_410.Parsetree.attribute -> Ast_409.Parsetree.attribute = fun { Ast_410.Parsetree.attr_name = attr_name; Ast_410.Parsetree.attr_payload = attr_payload; Ast_410.Parsetree.attr_loc = attr_loc } -> { Ast_409.Parsetree.attr_name = (copy_loc (fun x -> x) attr_name); Ast_409.Parsetree.attr_payload = (copy_payload attr_payload); Ast_409.Parsetree.attr_loc = (copy_location attr_loc) } and copy_payload : Ast_410.Parsetree.payload -> Ast_409.Parsetree.payload = function | Ast_410.Parsetree.PStr x0 -> Ast_409.Parsetree.PStr (copy_structure x0) | Ast_410.Parsetree.PSig x0 -> Ast_409.Parsetree.PSig (copy_signature x0) | Ast_410.Parsetree.PTyp x0 -> Ast_409.Parsetree.PTyp (copy_core_type x0) | Ast_410.Parsetree.PPat (x0, x1) -> Ast_409.Parsetree.PPat ((copy_pattern x0), (map_option copy_expression x1)) and copy_structure : Ast_410.Parsetree.structure -> Ast_409.Parsetree.structure = fun x -> List.map copy_structure_item x and copy_structure_item : Ast_410.Parsetree.structure_item -> Ast_409.Parsetree.structure_item = fun { Ast_410.Parsetree.pstr_desc = pstr_desc; Ast_410.Parsetree.pstr_loc = pstr_loc } -> { Ast_409.Parsetree.pstr_desc = (copy_structure_item_desc pstr_desc); Ast_409.Parsetree.pstr_loc = (copy_location pstr_loc) } and copy_structure_item_desc : Ast_410.Parsetree.structure_item_desc -> Ast_409.Parsetree.structure_item_desc = function | Ast_410.Parsetree.Pstr_eval (x0, x1) -> Ast_409.Parsetree.Pstr_eval ((copy_expression x0), (copy_attributes x1)) | Ast_410.Parsetree.Pstr_value (x0, x1) -> Ast_409.Parsetree.Pstr_value ((copy_rec_flag x0), (List.map copy_value_binding x1)) | Ast_410.Parsetree.Pstr_primitive x0 -> Ast_409.Parsetree.Pstr_primitive (copy_value_description x0) | Ast_410.Parsetree.Pstr_type (x0, x1) -> Ast_409.Parsetree.Pstr_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_410.Parsetree.Pstr_typext x0 -> Ast_409.Parsetree.Pstr_typext (copy_type_extension x0) | Ast_410.Parsetree.Pstr_exception x0 -> Ast_409.Parsetree.Pstr_exception (copy_type_exception x0) | Ast_410.Parsetree.Pstr_module x0 -> Ast_409.Parsetree.Pstr_module (copy_module_binding x0) | Ast_410.Parsetree.Pstr_recmodule x0 -> Ast_409.Parsetree.Pstr_recmodule (List.map copy_module_binding x0) | Ast_410.Parsetree.Pstr_modtype x0 -> Ast_409.Parsetree.Pstr_modtype (copy_module_type_declaration x0) | Ast_410.Parsetree.Pstr_open x0 -> Ast_409.Parsetree.Pstr_open (copy_open_declaration x0) | Ast_410.Parsetree.Pstr_class x0 -> Ast_409.Parsetree.Pstr_class (List.map copy_class_declaration x0) | Ast_410.Parsetree.Pstr_class_type x0 -> Ast_409.Parsetree.Pstr_class_type (List.map copy_class_type_declaration x0) | Ast_410.Parsetree.Pstr_include x0 -> Ast_409.Parsetree.Pstr_include (copy_include_declaration x0) | Ast_410.Parsetree.Pstr_attribute x0 -> Ast_409.Parsetree.Pstr_attribute (copy_attribute x0) | Ast_410.Parsetree.Pstr_extension (x0, x1) -> Ast_409.Parsetree.Pstr_extension ((copy_extension x0), (copy_attributes x1)) and copy_include_declaration : Ast_410.Parsetree.include_declaration -> Ast_409.Parsetree.include_declaration = fun x -> copy_include_infos copy_module_expr x and copy_class_declaration : Ast_410.Parsetree.class_declaration -> Ast_409.Parsetree.class_declaration = fun x -> copy_class_infos copy_class_expr x and copy_class_expr : Ast_410.Parsetree.class_expr -> Ast_409.Parsetree.class_expr = fun { Ast_410.Parsetree.pcl_desc = pcl_desc; Ast_410.Parsetree.pcl_loc = pcl_loc; Ast_410.Parsetree.pcl_attributes = pcl_attributes } -> { Ast_409.Parsetree.pcl_desc = (copy_class_expr_desc pcl_desc); Ast_409.Parsetree.pcl_loc = (copy_location pcl_loc); Ast_409.Parsetree.pcl_attributes = (copy_attributes pcl_attributes) } and copy_class_expr_desc : Ast_410.Parsetree.class_expr_desc -> Ast_409.Parsetree.class_expr_desc = function | Ast_410.Parsetree.Pcl_constr (x0, x1) -> Ast_409.Parsetree.Pcl_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_410.Parsetree.Pcl_structure x0 -> Ast_409.Parsetree.Pcl_structure (copy_class_structure x0) | Ast_410.Parsetree.Pcl_fun (x0, x1, x2, x3) -> Ast_409.Parsetree.Pcl_fun ((copy_arg_label x0), (map_option copy_expression x1), (copy_pattern x2), (copy_class_expr x3)) | Ast_410.Parsetree.Pcl_apply (x0, x1) -> Ast_409.Parsetree.Pcl_apply ((copy_class_expr x0), (List.map (fun x -> let (x0, x1) = x in ((copy_arg_label x0), (copy_expression x1))) x1)) | Ast_410.Parsetree.Pcl_let (x0, x1, x2) -> Ast_409.Parsetree.Pcl_let ((copy_rec_flag x0), (List.map copy_value_binding x1), (copy_class_expr x2)) | Ast_410.Parsetree.Pcl_constraint (x0, x1) -> Ast_409.Parsetree.Pcl_constraint ((copy_class_expr x0), (copy_class_type x1)) | Ast_410.Parsetree.Pcl_extension x0 -> Ast_409.Parsetree.Pcl_extension (copy_extension x0) | Ast_410.Parsetree.Pcl_open (x0, x1) -> Ast_409.Parsetree.Pcl_open ((copy_open_description x0), (copy_class_expr x1)) and copy_class_structure : Ast_410.Parsetree.class_structure -> Ast_409.Parsetree.class_structure = fun { Ast_410.Parsetree.pcstr_self = pcstr_self; Ast_410.Parsetree.pcstr_fields = pcstr_fields } -> { Ast_409.Parsetree.pcstr_self = (copy_pattern pcstr_self); Ast_409.Parsetree.pcstr_fields = (List.map copy_class_field pcstr_fields) } and copy_class_field : Ast_410.Parsetree.class_field -> Ast_409.Parsetree.class_field = fun { Ast_410.Parsetree.pcf_desc = pcf_desc; Ast_410.Parsetree.pcf_loc = pcf_loc; Ast_410.Parsetree.pcf_attributes = pcf_attributes } -> { Ast_409.Parsetree.pcf_desc = (copy_class_field_desc pcf_desc); Ast_409.Parsetree.pcf_loc = (copy_location pcf_loc); Ast_409.Parsetree.pcf_attributes = (copy_attributes pcf_attributes) } and copy_class_field_desc : Ast_410.Parsetree.class_field_desc -> Ast_409.Parsetree.class_field_desc = function | Ast_410.Parsetree.Pcf_inherit (x0, x1, x2) -> Ast_409.Parsetree.Pcf_inherit ((copy_override_flag x0), (copy_class_expr x1), (map_option (fun x -> copy_loc (fun x -> x) x) x2)) | Ast_410.Parsetree.Pcf_val x0 -> Ast_409.Parsetree.Pcf_val (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_class_field_kind x2))) | Ast_410.Parsetree.Pcf_method x0 -> Ast_409.Parsetree.Pcf_method (let (x0, x1, x2) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_class_field_kind x2))) | Ast_410.Parsetree.Pcf_constraint x0 -> Ast_409.Parsetree.Pcf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_410.Parsetree.Pcf_initializer x0 -> Ast_409.Parsetree.Pcf_initializer (copy_expression x0) | Ast_410.Parsetree.Pcf_attribute x0 -> Ast_409.Parsetree.Pcf_attribute (copy_attribute x0) | Ast_410.Parsetree.Pcf_extension x0 -> Ast_409.Parsetree.Pcf_extension (copy_extension x0) and copy_class_field_kind : Ast_410.Parsetree.class_field_kind -> Ast_409.Parsetree.class_field_kind = function | Ast_410.Parsetree.Cfk_virtual x0 -> Ast_409.Parsetree.Cfk_virtual (copy_core_type x0) | Ast_410.Parsetree.Cfk_concrete (x0, x1) -> Ast_409.Parsetree.Cfk_concrete ((copy_override_flag x0), (copy_expression x1)) and copy_open_declaration : Ast_410.Parsetree.open_declaration -> Ast_409.Parsetree.open_declaration = fun x -> copy_open_infos copy_module_expr x and copy_module_binding : Ast_410.Parsetree.module_binding -> Ast_409.Parsetree.module_binding = fun { Ast_410.Parsetree.pmb_name = pmb_name; Ast_410.Parsetree.pmb_expr = pmb_expr; Ast_410.Parsetree.pmb_attributes = pmb_attributes; Ast_410.Parsetree.pmb_loc = pmb_loc } -> { Ast_409.Parsetree.pmb_name = (copy_loc (function Some x -> x | None -> migration_error pmb_name.loc Anonymous_module_binding) pmb_name); Ast_409.Parsetree.pmb_expr = (copy_module_expr pmb_expr); Ast_409.Parsetree.pmb_attributes = (copy_attributes pmb_attributes); Ast_409.Parsetree.pmb_loc = (copy_location pmb_loc) } and copy_module_expr : Ast_410.Parsetree.module_expr -> Ast_409.Parsetree.module_expr = fun { Ast_410.Parsetree.pmod_desc = pmod_desc; Ast_410.Parsetree.pmod_loc = pmod_loc; Ast_410.Parsetree.pmod_attributes = pmod_attributes } -> { Ast_409.Parsetree.pmod_desc = (copy_module_expr_desc pmod_desc); Ast_409.Parsetree.pmod_loc = (copy_location pmod_loc); Ast_409.Parsetree.pmod_attributes = (copy_attributes pmod_attributes) } and copy_module_expr_desc : Ast_410.Parsetree.module_expr_desc -> Ast_409.Parsetree.module_expr_desc = function | Ast_410.Parsetree.Pmod_ident x0 -> Ast_409.Parsetree.Pmod_ident (copy_loc copy_Longident_t x0) | Ast_410.Parsetree.Pmod_structure x0 -> Ast_409.Parsetree.Pmod_structure (copy_structure x0) | Ast_410.Parsetree.Pmod_functor (x0, x1) -> let x, y = copy_functor_parameter x0 in Ast_409.Parsetree.Pmod_functor (x, y, (copy_module_expr x1)) | Ast_410.Parsetree.Pmod_apply (x0, x1) -> Ast_409.Parsetree.Pmod_apply ((copy_module_expr x0), (copy_module_expr x1)) | Ast_410.Parsetree.Pmod_constraint (x0, x1) -> Ast_409.Parsetree.Pmod_constraint ((copy_module_expr x0), (copy_module_type x1)) | Ast_410.Parsetree.Pmod_unpack x0 -> Ast_409.Parsetree.Pmod_unpack (copy_expression x0) | Ast_410.Parsetree.Pmod_extension x0 -> Ast_409.Parsetree.Pmod_extension (copy_extension x0) and copy_functor_parameter : Ast_410.Parsetree.functor_parameter -> string Ast_409.Asttypes.loc * Ast_409.Parsetree.module_type option = function | Ast_410.Parsetree.Unit -> ({ loc = Location.none; txt = "*" }, None) | Ast_410.Parsetree.Named (x0, x1) -> ((copy_loc (function | None -> "_" | Some x -> x) x0, Some (copy_module_type x1))) and copy_module_type : Ast_410.Parsetree.module_type -> Ast_409.Parsetree.module_type = fun { Ast_410.Parsetree.pmty_desc = pmty_desc; Ast_410.Parsetree.pmty_loc = pmty_loc; Ast_410.Parsetree.pmty_attributes = pmty_attributes } -> { Ast_409.Parsetree.pmty_desc = (copy_module_type_desc pmty_desc); Ast_409.Parsetree.pmty_loc = (copy_location pmty_loc); Ast_409.Parsetree.pmty_attributes = (copy_attributes pmty_attributes) } and copy_module_type_desc : Ast_410.Parsetree.module_type_desc -> Ast_409.Parsetree.module_type_desc = function | Ast_410.Parsetree.Pmty_ident x0 -> Ast_409.Parsetree.Pmty_ident (copy_loc copy_Longident_t x0) | Ast_410.Parsetree.Pmty_signature x0 -> Ast_409.Parsetree.Pmty_signature (copy_signature x0) | Ast_410.Parsetree.Pmty_functor (x0, x1) -> let x, y = copy_functor_parameter x0 in Ast_409.Parsetree.Pmty_functor (x, y, (copy_module_type x1)) | Ast_410.Parsetree.Pmty_with (x0, x1) -> Ast_409.Parsetree.Pmty_with ((copy_module_type x0), (List.map copy_with_constraint x1)) | Ast_410.Parsetree.Pmty_typeof x0 -> Ast_409.Parsetree.Pmty_typeof (copy_module_expr x0) | Ast_410.Parsetree.Pmty_extension x0 -> Ast_409.Parsetree.Pmty_extension (copy_extension x0) | Ast_410.Parsetree.Pmty_alias x0 -> Ast_409.Parsetree.Pmty_alias (copy_loc copy_Longident_t x0) and copy_with_constraint : Ast_410.Parsetree.with_constraint -> Ast_409.Parsetree.with_constraint = function | Ast_410.Parsetree.Pwith_type (x0, x1) -> Ast_409.Parsetree.Pwith_type ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_410.Parsetree.Pwith_module (x0, x1) -> Ast_409.Parsetree.Pwith_module ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) | Ast_410.Parsetree.Pwith_typesubst (x0, x1) -> Ast_409.Parsetree.Pwith_typesubst ((copy_loc copy_Longident_t x0), (copy_type_declaration x1)) | Ast_410.Parsetree.Pwith_modsubst (x0, x1) -> Ast_409.Parsetree.Pwith_modsubst ((copy_loc copy_Longident_t x0), (copy_loc copy_Longident_t x1)) and copy_signature : Ast_410.Parsetree.signature -> Ast_409.Parsetree.signature = fun x -> List.map copy_signature_item x and copy_signature_item : Ast_410.Parsetree.signature_item -> Ast_409.Parsetree.signature_item = fun { Ast_410.Parsetree.psig_desc = psig_desc; Ast_410.Parsetree.psig_loc = psig_loc } -> { Ast_409.Parsetree.psig_desc = (copy_signature_item_desc psig_desc); Ast_409.Parsetree.psig_loc = (copy_location psig_loc) } and copy_signature_item_desc : Ast_410.Parsetree.signature_item_desc -> Ast_409.Parsetree.signature_item_desc = function | Ast_410.Parsetree.Psig_value x0 -> Ast_409.Parsetree.Psig_value (copy_value_description x0) | Ast_410.Parsetree.Psig_type (x0, x1) -> Ast_409.Parsetree.Psig_type ((copy_rec_flag x0), (List.map copy_type_declaration x1)) | Ast_410.Parsetree.Psig_typesubst x0 -> Ast_409.Parsetree.Psig_typesubst (List.map copy_type_declaration x0) | Ast_410.Parsetree.Psig_typext x0 -> Ast_409.Parsetree.Psig_typext (copy_type_extension x0) | Ast_410.Parsetree.Psig_exception x0 -> Ast_409.Parsetree.Psig_exception (copy_type_exception x0) | Ast_410.Parsetree.Psig_module x0 -> Ast_409.Parsetree.Psig_module (copy_module_declaration x0) | Ast_410.Parsetree.Psig_modsubst x0 -> Ast_409.Parsetree.Psig_modsubst (copy_module_substitution x0) | Ast_410.Parsetree.Psig_recmodule x0 -> Ast_409.Parsetree.Psig_recmodule (List.map copy_module_declaration x0) | Ast_410.Parsetree.Psig_modtype x0 -> Ast_409.Parsetree.Psig_modtype (copy_module_type_declaration x0) | Ast_410.Parsetree.Psig_open x0 -> Ast_409.Parsetree.Psig_open (copy_open_description x0) | Ast_410.Parsetree.Psig_include x0 -> Ast_409.Parsetree.Psig_include (copy_include_description x0) | Ast_410.Parsetree.Psig_class x0 -> Ast_409.Parsetree.Psig_class (List.map copy_class_description x0) | Ast_410.Parsetree.Psig_class_type x0 -> Ast_409.Parsetree.Psig_class_type (List.map copy_class_type_declaration x0) | Ast_410.Parsetree.Psig_attribute x0 -> Ast_409.Parsetree.Psig_attribute (copy_attribute x0) | Ast_410.Parsetree.Psig_extension (x0, x1) -> Ast_409.Parsetree.Psig_extension ((copy_extension x0), (copy_attributes x1)) and copy_class_type_declaration : Ast_410.Parsetree.class_type_declaration -> Ast_409.Parsetree.class_type_declaration = fun x -> copy_class_infos copy_class_type x and copy_class_description : Ast_410.Parsetree.class_description -> Ast_409.Parsetree.class_description = fun x -> copy_class_infos copy_class_type x and copy_class_type : Ast_410.Parsetree.class_type -> Ast_409.Parsetree.class_type = fun { Ast_410.Parsetree.pcty_desc = pcty_desc; Ast_410.Parsetree.pcty_loc = pcty_loc; Ast_410.Parsetree.pcty_attributes = pcty_attributes } -> { Ast_409.Parsetree.pcty_desc = (copy_class_type_desc pcty_desc); Ast_409.Parsetree.pcty_loc = (copy_location pcty_loc); Ast_409.Parsetree.pcty_attributes = (copy_attributes pcty_attributes) } and copy_class_type_desc : Ast_410.Parsetree.class_type_desc -> Ast_409.Parsetree.class_type_desc = function | Ast_410.Parsetree.Pcty_constr (x0, x1) -> Ast_409.Parsetree.Pcty_constr ((copy_loc copy_Longident_t x0), (List.map copy_core_type x1)) | Ast_410.Parsetree.Pcty_signature x0 -> Ast_409.Parsetree.Pcty_signature (copy_class_signature x0) | Ast_410.Parsetree.Pcty_arrow (x0, x1, x2) -> Ast_409.Parsetree.Pcty_arrow ((copy_arg_label x0), (copy_core_type x1), (copy_class_type x2)) | Ast_410.Parsetree.Pcty_extension x0 -> Ast_409.Parsetree.Pcty_extension (copy_extension x0) | Ast_410.Parsetree.Pcty_open (x0, x1) -> Ast_409.Parsetree.Pcty_open ((copy_open_description x0), (copy_class_type x1)) and copy_class_signature : Ast_410.Parsetree.class_signature -> Ast_409.Parsetree.class_signature = fun { Ast_410.Parsetree.pcsig_self = pcsig_self; Ast_410.Parsetree.pcsig_fields = pcsig_fields } -> { Ast_409.Parsetree.pcsig_self = (copy_core_type pcsig_self); Ast_409.Parsetree.pcsig_fields = (List.map copy_class_type_field pcsig_fields) } and copy_class_type_field : Ast_410.Parsetree.class_type_field -> Ast_409.Parsetree.class_type_field = fun { Ast_410.Parsetree.pctf_desc = pctf_desc; Ast_410.Parsetree.pctf_loc = pctf_loc; Ast_410.Parsetree.pctf_attributes = pctf_attributes } -> { Ast_409.Parsetree.pctf_desc = (copy_class_type_field_desc pctf_desc); Ast_409.Parsetree.pctf_loc = (copy_location pctf_loc); Ast_409.Parsetree.pctf_attributes = (copy_attributes pctf_attributes) } and copy_class_type_field_desc : Ast_410.Parsetree.class_type_field_desc -> Ast_409.Parsetree.class_type_field_desc = function | Ast_410.Parsetree.Pctf_inherit x0 -> Ast_409.Parsetree.Pctf_inherit (copy_class_type x0) | Ast_410.Parsetree.Pctf_val x0 -> Ast_409.Parsetree.Pctf_val (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_mutable_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_410.Parsetree.Pctf_method x0 -> Ast_409.Parsetree.Pctf_method (let (x0, x1, x2, x3) = x0 in ((copy_loc copy_label x0), (copy_private_flag x1), (copy_virtual_flag x2), (copy_core_type x3))) | Ast_410.Parsetree.Pctf_constraint x0 -> Ast_409.Parsetree.Pctf_constraint (let (x0, x1) = x0 in ((copy_core_type x0), (copy_core_type x1))) | Ast_410.Parsetree.Pctf_attribute x0 -> Ast_409.Parsetree.Pctf_attribute (copy_attribute x0) | Ast_410.Parsetree.Pctf_extension x0 -> Ast_409.Parsetree.Pctf_extension (copy_extension x0) and copy_extension : Ast_410.Parsetree.extension -> Ast_409.Parsetree.extension = fun x -> let (x0, x1) = x in ((copy_loc (fun x -> x) x0), (copy_payload x1)) and copy_class_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_410.Parsetree.class_infos -> 'g0 Ast_409.Parsetree.class_infos = fun f0 -> fun { Ast_410.Parsetree.pci_virt = pci_virt; Ast_410.Parsetree.pci_params = pci_params; Ast_410.Parsetree.pci_name = pci_name; Ast_410.Parsetree.pci_expr = pci_expr; Ast_410.Parsetree.pci_loc = pci_loc; Ast_410.Parsetree.pci_attributes = pci_attributes } -> { Ast_409.Parsetree.pci_virt = (copy_virtual_flag pci_virt); Ast_409.Parsetree.pci_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) pci_params); Ast_409.Parsetree.pci_name = (copy_loc (fun x -> x) pci_name); Ast_409.Parsetree.pci_expr = (f0 pci_expr); Ast_409.Parsetree.pci_loc = (copy_location pci_loc); Ast_409.Parsetree.pci_attributes = (copy_attributes pci_attributes) } and copy_virtual_flag : Ast_410.Asttypes.virtual_flag -> Ast_409.Asttypes.virtual_flag = function | Ast_410.Asttypes.Virtual -> Ast_409.Asttypes.Virtual | Ast_410.Asttypes.Concrete -> Ast_409.Asttypes.Concrete and copy_include_description : Ast_410.Parsetree.include_description -> Ast_409.Parsetree.include_description = fun x -> copy_include_infos copy_module_type x and copy_include_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_410.Parsetree.include_infos -> 'g0 Ast_409.Parsetree.include_infos = fun f0 -> fun { Ast_410.Parsetree.pincl_mod = pincl_mod; Ast_410.Parsetree.pincl_loc = pincl_loc; Ast_410.Parsetree.pincl_attributes = pincl_attributes } -> { Ast_409.Parsetree.pincl_mod = (f0 pincl_mod); Ast_409.Parsetree.pincl_loc = (copy_location pincl_loc); Ast_409.Parsetree.pincl_attributes = (copy_attributes pincl_attributes) } and copy_open_description : Ast_410.Parsetree.open_description -> Ast_409.Parsetree.open_description = fun x -> copy_open_infos (fun x -> copy_loc copy_Longident_t x) x and copy_open_infos : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_410.Parsetree.open_infos -> 'g0 Ast_409.Parsetree.open_infos = fun f0 -> fun { Ast_410.Parsetree.popen_expr = popen_expr; Ast_410.Parsetree.popen_override = popen_override; Ast_410.Parsetree.popen_loc = popen_loc; Ast_410.Parsetree.popen_attributes = popen_attributes } -> { Ast_409.Parsetree.popen_expr = (f0 popen_expr); Ast_409.Parsetree.popen_override = (copy_override_flag popen_override); Ast_409.Parsetree.popen_loc = (copy_location popen_loc); Ast_409.Parsetree.popen_attributes = (copy_attributes popen_attributes) } and copy_override_flag : Ast_410.Asttypes.override_flag -> Ast_409.Asttypes.override_flag = function | Ast_410.Asttypes.Override -> Ast_409.Asttypes.Override | Ast_410.Asttypes.Fresh -> Ast_409.Asttypes.Fresh and copy_module_type_declaration : Ast_410.Parsetree.module_type_declaration -> Ast_409.Parsetree.module_type_declaration = fun { Ast_410.Parsetree.pmtd_name = pmtd_name; Ast_410.Parsetree.pmtd_type = pmtd_type; Ast_410.Parsetree.pmtd_attributes = pmtd_attributes; Ast_410.Parsetree.pmtd_loc = pmtd_loc } -> { Ast_409.Parsetree.pmtd_name = (copy_loc (fun x -> x) pmtd_name); Ast_409.Parsetree.pmtd_type = (map_option copy_module_type pmtd_type); Ast_409.Parsetree.pmtd_attributes = (copy_attributes pmtd_attributes); Ast_409.Parsetree.pmtd_loc = (copy_location pmtd_loc) } and copy_module_substitution : Ast_410.Parsetree.module_substitution -> Ast_409.Parsetree.module_substitution = fun { Ast_410.Parsetree.pms_name = pms_name; Ast_410.Parsetree.pms_manifest = pms_manifest; Ast_410.Parsetree.pms_attributes = pms_attributes; Ast_410.Parsetree.pms_loc = pms_loc } -> { Ast_409.Parsetree.pms_name = (copy_loc (fun x -> x) pms_name); Ast_409.Parsetree.pms_manifest = (copy_loc copy_Longident_t pms_manifest); Ast_409.Parsetree.pms_attributes = (copy_attributes pms_attributes); Ast_409.Parsetree.pms_loc = (copy_location pms_loc) } and copy_module_declaration : Ast_410.Parsetree.module_declaration -> Ast_409.Parsetree.module_declaration = fun { Ast_410.Parsetree.pmd_name = pmd_name; Ast_410.Parsetree.pmd_type = pmd_type; Ast_410.Parsetree.pmd_attributes = pmd_attributes; Ast_410.Parsetree.pmd_loc = pmd_loc } -> { Ast_409.Parsetree.pmd_name = (copy_loc (function | None -> migration_error pmd_name.loc Anonymous_module_declaration | Some x -> x) pmd_name); Ast_409.Parsetree.pmd_type = (copy_module_type pmd_type); Ast_409.Parsetree.pmd_attributes = (copy_attributes pmd_attributes); Ast_409.Parsetree.pmd_loc = (copy_location pmd_loc) } and copy_type_exception : Ast_410.Parsetree.type_exception -> Ast_409.Parsetree.type_exception = fun { Ast_410.Parsetree.ptyexn_constructor = ptyexn_constructor; Ast_410.Parsetree.ptyexn_loc = ptyexn_loc; Ast_410.Parsetree.ptyexn_attributes = ptyexn_attributes } -> { Ast_409.Parsetree.ptyexn_constructor = (copy_extension_constructor ptyexn_constructor); Ast_409.Parsetree.ptyexn_loc = (copy_location ptyexn_loc); Ast_409.Parsetree.ptyexn_attributes = (copy_attributes ptyexn_attributes) } and copy_type_extension : Ast_410.Parsetree.type_extension -> Ast_409.Parsetree.type_extension = fun { Ast_410.Parsetree.ptyext_path = ptyext_path; Ast_410.Parsetree.ptyext_params = ptyext_params; Ast_410.Parsetree.ptyext_constructors = ptyext_constructors; Ast_410.Parsetree.ptyext_private = ptyext_private; Ast_410.Parsetree.ptyext_loc = ptyext_loc; Ast_410.Parsetree.ptyext_attributes = ptyext_attributes } -> { Ast_409.Parsetree.ptyext_path = (copy_loc copy_Longident_t ptyext_path); Ast_409.Parsetree.ptyext_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptyext_params); Ast_409.Parsetree.ptyext_constructors = (List.map copy_extension_constructor ptyext_constructors); Ast_409.Parsetree.ptyext_private = (copy_private_flag ptyext_private); Ast_409.Parsetree.ptyext_loc = (copy_location ptyext_loc); Ast_409.Parsetree.ptyext_attributes = (copy_attributes ptyext_attributes) } and copy_extension_constructor : Ast_410.Parsetree.extension_constructor -> Ast_409.Parsetree.extension_constructor = fun { Ast_410.Parsetree.pext_name = pext_name; Ast_410.Parsetree.pext_kind = pext_kind; Ast_410.Parsetree.pext_loc = pext_loc; Ast_410.Parsetree.pext_attributes = pext_attributes } -> { Ast_409.Parsetree.pext_name = (copy_loc (fun x -> x) pext_name); Ast_409.Parsetree.pext_kind = (copy_extension_constructor_kind pext_kind); Ast_409.Parsetree.pext_loc = (copy_location pext_loc); Ast_409.Parsetree.pext_attributes = (copy_attributes pext_attributes) } and copy_extension_constructor_kind : Ast_410.Parsetree.extension_constructor_kind -> Ast_409.Parsetree.extension_constructor_kind = function | Ast_410.Parsetree.Pext_decl (x0, x1) -> Ast_409.Parsetree.Pext_decl ((copy_constructor_arguments x0), (map_option copy_core_type x1)) | Ast_410.Parsetree.Pext_rebind x0 -> Ast_409.Parsetree.Pext_rebind (copy_loc copy_Longident_t x0) and copy_type_declaration : Ast_410.Parsetree.type_declaration -> Ast_409.Parsetree.type_declaration = fun { Ast_410.Parsetree.ptype_name = ptype_name; Ast_410.Parsetree.ptype_params = ptype_params; Ast_410.Parsetree.ptype_cstrs = ptype_cstrs; Ast_410.Parsetree.ptype_kind = ptype_kind; Ast_410.Parsetree.ptype_private = ptype_private; Ast_410.Parsetree.ptype_manifest = ptype_manifest; Ast_410.Parsetree.ptype_attributes = ptype_attributes; Ast_410.Parsetree.ptype_loc = ptype_loc } -> { Ast_409.Parsetree.ptype_name = (copy_loc (fun x -> x) ptype_name); Ast_409.Parsetree.ptype_params = (List.map (fun x -> let (x0, x1) = x in ((copy_core_type x0), (copy_variance x1))) ptype_params); Ast_409.Parsetree.ptype_cstrs = (List.map (fun x -> let (x0, x1, x2) = x in ((copy_core_type x0), (copy_core_type x1), (copy_location x2))) ptype_cstrs); Ast_409.Parsetree.ptype_kind = (copy_type_kind ptype_kind); Ast_409.Parsetree.ptype_private = (copy_private_flag ptype_private); Ast_409.Parsetree.ptype_manifest = (map_option copy_core_type ptype_manifest); Ast_409.Parsetree.ptype_attributes = (copy_attributes ptype_attributes); Ast_409.Parsetree.ptype_loc = (copy_location ptype_loc) } and copy_private_flag : Ast_410.Asttypes.private_flag -> Ast_409.Asttypes.private_flag = function | Ast_410.Asttypes.Private -> Ast_409.Asttypes.Private | Ast_410.Asttypes.Public -> Ast_409.Asttypes.Public and copy_type_kind : Ast_410.Parsetree.type_kind -> Ast_409.Parsetree.type_kind = function | Ast_410.Parsetree.Ptype_abstract -> Ast_409.Parsetree.Ptype_abstract | Ast_410.Parsetree.Ptype_variant x0 -> Ast_409.Parsetree.Ptype_variant (List.map copy_constructor_declaration x0) | Ast_410.Parsetree.Ptype_record x0 -> Ast_409.Parsetree.Ptype_record (List.map copy_label_declaration x0) | Ast_410.Parsetree.Ptype_open -> Ast_409.Parsetree.Ptype_open and copy_constructor_declaration : Ast_410.Parsetree.constructor_declaration -> Ast_409.Parsetree.constructor_declaration = fun { Ast_410.Parsetree.pcd_name = pcd_name; Ast_410.Parsetree.pcd_args = pcd_args; Ast_410.Parsetree.pcd_res = pcd_res; Ast_410.Parsetree.pcd_loc = pcd_loc; Ast_410.Parsetree.pcd_attributes = pcd_attributes } -> { Ast_409.Parsetree.pcd_name = (copy_loc (fun x -> x) pcd_name); Ast_409.Parsetree.pcd_args = (copy_constructor_arguments pcd_args); Ast_409.Parsetree.pcd_res = (map_option copy_core_type pcd_res); Ast_409.Parsetree.pcd_loc = (copy_location pcd_loc); Ast_409.Parsetree.pcd_attributes = (copy_attributes pcd_attributes) } and copy_constructor_arguments : Ast_410.Parsetree.constructor_arguments -> Ast_409.Parsetree.constructor_arguments = function | Ast_410.Parsetree.Pcstr_tuple x0 -> Ast_409.Parsetree.Pcstr_tuple (List.map copy_core_type x0) | Ast_410.Parsetree.Pcstr_record x0 -> Ast_409.Parsetree.Pcstr_record (List.map copy_label_declaration x0) and copy_label_declaration : Ast_410.Parsetree.label_declaration -> Ast_409.Parsetree.label_declaration = fun { Ast_410.Parsetree.pld_name = pld_name; Ast_410.Parsetree.pld_mutable = pld_mutable; Ast_410.Parsetree.pld_type = pld_type; Ast_410.Parsetree.pld_loc = pld_loc; Ast_410.Parsetree.pld_attributes = pld_attributes } -> { Ast_409.Parsetree.pld_name = (copy_loc (fun x -> x) pld_name); Ast_409.Parsetree.pld_mutable = (copy_mutable_flag pld_mutable); Ast_409.Parsetree.pld_type = (copy_core_type pld_type); Ast_409.Parsetree.pld_loc = (copy_location pld_loc); Ast_409.Parsetree.pld_attributes = (copy_attributes pld_attributes) } and copy_mutable_flag : Ast_410.Asttypes.mutable_flag -> Ast_409.Asttypes.mutable_flag = function | Ast_410.Asttypes.Immutable -> Ast_409.Asttypes.Immutable | Ast_410.Asttypes.Mutable -> Ast_409.Asttypes.Mutable and copy_variance : Ast_410.Asttypes.variance -> Ast_409.Asttypes.variance = function | Ast_410.Asttypes.Covariant -> Ast_409.Asttypes.Covariant | Ast_410.Asttypes.Contravariant -> Ast_409.Asttypes.Contravariant | Ast_410.Asttypes.Invariant -> Ast_409.Asttypes.Invariant and copy_value_description : Ast_410.Parsetree.value_description -> Ast_409.Parsetree.value_description = fun { Ast_410.Parsetree.pval_name = pval_name; Ast_410.Parsetree.pval_type = pval_type; Ast_410.Parsetree.pval_prim = pval_prim; Ast_410.Parsetree.pval_attributes = pval_attributes; Ast_410.Parsetree.pval_loc = pval_loc } -> { Ast_409.Parsetree.pval_name = (copy_loc (fun x -> x) pval_name); Ast_409.Parsetree.pval_type = (copy_core_type pval_type); Ast_409.Parsetree.pval_prim = (List.map (fun x -> x) pval_prim); Ast_409.Parsetree.pval_attributes = (copy_attributes pval_attributes); Ast_409.Parsetree.pval_loc = (copy_location pval_loc) } and copy_object_field_desc : Ast_410.Parsetree.object_field_desc -> Ast_409.Parsetree.object_field_desc = function | Ast_410.Parsetree.Otag (x0, x1) -> Ast_409.Parsetree.Otag ((copy_loc copy_label x0), (copy_core_type x1)) | Ast_410.Parsetree.Oinherit x0 -> Ast_409.Parsetree.Oinherit (copy_core_type x0) and copy_arg_label : Ast_410.Asttypes.arg_label -> Ast_409.Asttypes.arg_label = function | Ast_410.Asttypes.Nolabel -> Ast_409.Asttypes.Nolabel | Ast_410.Asttypes.Labelled x0 -> Ast_409.Asttypes.Labelled x0 | Ast_410.Asttypes.Optional x0 -> Ast_409.Asttypes.Optional x0 and copy_closed_flag : Ast_410.Asttypes.closed_flag -> Ast_409.Asttypes.closed_flag = function | Ast_410.Asttypes.Closed -> Ast_409.Asttypes.Closed | Ast_410.Asttypes.Open -> Ast_409.Asttypes.Open and copy_label : Ast_410.Asttypes.label -> Ast_409.Asttypes.label = fun x -> x and copy_rec_flag : Ast_410.Asttypes.rec_flag -> Ast_409.Asttypes.rec_flag = function | Ast_410.Asttypes.Nonrecursive -> Ast_409.Asttypes.Nonrecursive | Ast_410.Asttypes.Recursive -> Ast_409.Asttypes.Recursive and copy_constant : Ast_410.Parsetree.constant -> Ast_409.Parsetree.constant = function | Ast_410.Parsetree.Pconst_integer (x0, x1) -> Ast_409.Parsetree.Pconst_integer (x0, (map_option (fun x -> x) x1)) | Ast_410.Parsetree.Pconst_char x0 -> Ast_409.Parsetree.Pconst_char x0 | Ast_410.Parsetree.Pconst_string (x0, x1) -> Ast_409.Parsetree.Pconst_string (x0, (map_option (fun x -> x) x1)) | Ast_410.Parsetree.Pconst_float (x0, x1) -> Ast_409.Parsetree.Pconst_float (x0, (map_option (fun x -> x) x1)) and copy_Longident_t : Ast_410.Longident.t -> Ast_409.Longident.t = function | Ast_410.Longident.Lident x0 -> Ast_409.Longident.Lident x0 | Ast_410.Longident.Ldot (x0, x1) -> Ast_409.Longident.Ldot ((copy_Longident_t x0), x1) | Ast_410.Longident.Lapply (x0, x1) -> Ast_409.Longident.Lapply ((copy_Longident_t x0), (copy_Longident_t x1)) and copy_loc : 'f0 'g0 . ('f0 -> 'g0) -> 'f0 Ast_410.Asttypes.loc -> 'g0 Ast_409.Asttypes.loc = fun f0 -> fun { Ast_410.Asttypes.txt = txt; Ast_410.Asttypes.loc = loc } -> { Ast_409.Asttypes.txt = (f0 txt); Ast_409.Asttypes.loc = (copy_location loc) } and copy_location : Ast_410.Location.t -> Ast_409.Location.t = fun { Ast_410.Location.loc_start = loc_start; Ast_410.Location.loc_end = loc_end; Ast_410.Location.loc_ghost = loc_ghost } -> { Ast_409.Location.loc_start = (copy_position loc_start); Ast_409.Location.loc_end = (copy_position loc_end); Ast_409.Location.loc_ghost = loc_ghost } and copy_position : Lexing.position -> Lexing.position = fun { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } -> { Lexing.pos_fname = pos_fname; Lexing.pos_lnum = pos_lnum; Lexing.pos_bol = pos_bol; Lexing.pos_cnum = pos_cnum } let copy_expr = copy_expression let copy_pat = copy_pattern let copy_typ = copy_core_type ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_ast_io.ml000066400000000000000000000076701356450464700244370ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Result type ast = | Impl : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.structure = 'concrete) * 'concrete -> ast | Intf : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.signature = 'concrete) * 'concrete -> ast type filename = string let magic_length = String.length Ast_402.Config.ast_impl_magic_number let read_magic ic = let buf = Bytes.create magic_length in let len = input ic buf 0 magic_length in let s = Bytes.sub_string buf 0 len in if len = magic_length then Ok s else Error s type read_error = | Not_a_binary_ast of string | Unknown_version of string let find_magic magic = let rec loop = function | [] -> let prefix = String.sub magic 0 9 in if prefix = String.sub Ast_402.Config.ast_impl_magic_number 0 9 || prefix = String.sub Ast_402.Config.ast_intf_magic_number 0 9 then Error (Unknown_version magic) else Error (Not_a_binary_ast magic) | (module Frontend : Migrate_parsetree_versions.OCaml_version) :: tail -> if Frontend.Ast.Config.ast_impl_magic_number = magic then Ok (fun x -> Impl ((module Frontend), Obj.obj x)) else if Frontend.Ast.Config.ast_intf_magic_number = magic then Ok (fun x -> Intf ((module Frontend), Obj.obj x)) else loop tail in loop Migrate_parsetree_versions.all_versions let from_channel ic = match read_magic ic with | Error s -> Error (Not_a_binary_ast s) | Ok s -> match find_magic s with | Ok inj -> let filename : filename = input_value ic in let payload = inj (input_value ic) in Ok (filename, payload) | Error _ as e -> e let from_bytes bytes pos = if Bytes.length bytes - pos < magic_length then Error (Not_a_binary_ast "") else let magic = Bytes.to_string (Bytes.sub bytes pos magic_length) in match find_magic magic with | Ok inj -> let filename_pos = pos + magic_length in let filename : filename = Marshal.from_bytes bytes filename_pos in let payload_pos = filename_pos + Marshal.total_size bytes filename_pos in let payload = inj (Marshal.from_bytes bytes payload_pos) in Ok (filename, payload) | Error _ as e -> e let decompose_ast = function | Impl ((module Frontend), tree) -> (Frontend.Ast.Config.ast_impl_magic_number, Obj.repr tree) | Intf ((module Frontend), tree) -> (Frontend.Ast.Config.ast_intf_magic_number, Obj.repr tree) let to_channel oc (filename : filename) x = let magic_number, payload = decompose_ast x in output_string oc magic_number; output_value oc filename; output_value oc payload let to_bytes (filename : filename) x = let magic_number, payload = decompose_ast x in Bytes.cat ( Bytes.cat (Bytes.of_string magic_number) (Marshal.to_bytes filename []) ) (Marshal.to_bytes payload []) ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_ast_io.mli000066400000000000000000000046561356450464700246110ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) open Result[@@ocaml.warning "-33"] (** A marshalled ast packs the ast with the corresponding version of the frontend *) type ast = | Impl : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.structure = 'concrete) * 'concrete -> ast | Intf : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.signature = 'concrete) * 'concrete -> ast (** A simple alias used for the filename of the source that produced an AST *) type filename = string type read_error = | Not_a_binary_ast of string (** The input doesn't contain a binary AST. The argument corresponds to the bytes from the input that were consumed. *) | Unknown_version of string (** The input contains a binary AST for an unknown version of OCaml. The argument is the unknown magic number. *) (** Load a marshalled AST from a channel Any exception raised during unmarshalling (see [Marshal]) can escape. *) val from_channel : in_channel -> (filename * ast, read_error) result (** Load a marshalled AST from a byte string. See [from_channel] description for exception that can be raised. *) val from_bytes : bytes -> int -> (filename * ast, read_error) result (** Marshal an AST to a channel *) val to_channel : out_channel -> filename -> ast -> unit (** Marshal an AST to a byte string *) val to_bytes : filename -> ast -> bytes ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_def.ml000066400000000000000000000132711356450464700237110ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Errors that can happen when converting constructions that doesn't exist in older version of the AST. *) type missing_feature = | Pexp_letexception (** 4.04 -> 4.03: local exception, let exception _ in ... *) | Ppat_open (** 4.04 -> 4.03: module open in pattern match x with M.(_) -> ... *) | Pexp_unreachable (** 4.04 -> 4.03: unreachable pattern -> . *) | PSig (** 4.03 -> 4.02: signature in attribute, [@: val x : int] *) | Pcstr_record (** 4.03 -> 4.02: inline record *) | Pconst_integer (** 4.03 -> 4.02: integer literal with invalid suffix, 1234d *) | Pconst_float (** 4.03 -> 4.02: float literal with invalid suffix, 1234.0g *) | Pcl_open (** 4.06 -> 4.05: let open M in *) | Pcty_open (** 4.06 -> 4.05: let open M in *) | Oinherit (** 4.06 -> 4.05: type t = < m : int; u > *) | Pwith_typesubst_longident (** 4.06 -> 4.05: T with type X.t := ... *) | Pwith_modsubst_longident (** 4.06 -> 4.05: T with module X.Y := ... *) | Pexp_open (** 4.08 -> 4.07: open M(N).O *) | Pexp_letop (** 4.08 -> 4.07: let* x = ... *) | Psig_typesubst (** 4.08 -> 4.07: type t := ... *) | Psig_modsubst (** 4.08 -> 4.07: module M := ... *) | Otyp_module (** 4.08 -> 4.07: M(N) *) | Immediate64 (** 4.10 -> 4.09: [@@immediate64] *) | Anonymous_let_module (** 4.10 -> 4.09: let module _ = ... in ... *) | Anonymous_unpack (** 4.10 -> 4.09: (module _) *) | Anonymous_module_binding (** 4.10 -> 4.09: module _ = ... *) | Anonymous_module_declaration (** 4.10 -> 4.09: module _ = struct ... end *) exception Migration_error of missing_feature * Location.t (** [missing_feature_description x] is a text describing the feature [x]. *) let missing_feature_description = function | Pexp_letexception -> "local exceptions" | Ppat_open -> "module open in patterns" | Pexp_unreachable -> "unreachable patterns" | PSig -> "signatures in attribute" | Pcstr_record -> "inline records" | Pconst_integer -> "custom integer literals" | Pconst_float -> "custom float literals" | Pcl_open -> "module open in class expression" | Pcty_open -> "module open in class type" | Oinherit -> "inheritance in object type" | Pwith_typesubst_longident -> "type substitution inside a submodule" | Pwith_modsubst_longident -> "module substitution inside a submodule" | Pexp_open -> "complex open" | Pexp_letop -> "let operators" | Psig_typesubst -> "type substitution in signatures" | Psig_modsubst -> "module substitution in signatures" | Otyp_module -> "complex outcome module" | Immediate64 -> "[@@immediate64] attribute" | Anonymous_let_module -> "anonymous let module" | Anonymous_unpack -> "anynymous unpack" | Anonymous_module_binding -> "anonymous module binding" | Anonymous_module_declaration -> "anonymous module declaration" (** [missing_feature_minimal_version x] is the OCaml version where x was introduced. *) let missing_feature_minimal_version = function | Pexp_letexception -> "OCaml 4.04" | Ppat_open -> "OCaml 4.04" | Pexp_unreachable -> "OCaml 4.03" | PSig -> "OCaml 4.03" | Pcstr_record -> "OCaml 4.03" | Pconst_integer -> "OCaml 4.03" | Pconst_float -> "OCaml 4.03" | Pcl_open -> "OCaml 4.06" | Pcty_open -> "OCaml 4.06" | Oinherit -> "OCaml 4.06" | Pwith_typesubst_longident -> "OCaml 4.06" | Pwith_modsubst_longident -> "OCaml 4.06" | Pexp_open -> "OCaml 4.08" | Pexp_letop -> "OCaml 4.08" | Psig_typesubst -> "OCaml 4.08" | Psig_modsubst -> "OCaml 4.08" | Otyp_module -> "OCaml 4.08" | Immediate64 -> "OCaml 4.10" | Anonymous_let_module -> "OCaml 4.10" | Anonymous_unpack -> "OCaml 4.10" | Anonymous_module_binding -> "OCaml 4.10" | Anonymous_module_declaration -> "OCaml 4.10" (** Turn a missing feature into a reasonable error message. *) let migration_error_message x = let feature = missing_feature_description x in let version = missing_feature_minimal_version x in feature ^ " are not supported before " ^ version let () = let location_prefix l = if l = Location.none then "" else let {Location.loc_start; loc_end; _} = l in let bol = loc_start.Lexing.pos_bol in Printf.sprintf "File %S, line %d, characters %d-%d: " loc_start.Lexing.pos_fname loc_start.Lexing.pos_lnum (loc_start.Lexing.pos_cnum - bol) (loc_end.Lexing.pos_cnum - bol) in Printexc.register_printer (function | Migration_error (err, loc) -> Some (location_prefix loc ^ migration_error_message err) | _ -> None ) ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_def.mli000066400000000000000000000041521356450464700240600ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Features which are not available in all versions of the frontend *) type missing_feature = Pexp_letexception | Ppat_open | Pexp_unreachable | PSig | Pcstr_record | Pconst_integer | Pconst_float | Pcl_open | Pcty_open | Oinherit | Pwith_typesubst_longident | Pwith_modsubst_longident | Pexp_open | Pexp_letop | Psig_typesubst | Psig_modsubst | Otyp_module | Immediate64 | Anonymous_let_module | Anonymous_unpack | Anonymous_module_binding | Anonymous_module_declaration (** Exception thrown by migration functions when a feature is not supported. *) exception Migration_error of missing_feature * Location.t (** [missing_feature_description x] is a text describing the feature [x]. *) val missing_feature_description : missing_feature -> string (** [missing_feature_minimal_version x] is the OCaml version where x was introduced. *) val missing_feature_minimal_version : missing_feature -> string (** Turn a missing feature into a reasonable error message. *) val migration_error_message : missing_feature -> string ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_driver.ml000066400000000000000000000456441356450464700244570ustar00rootroot00000000000000open Migrate_parsetree_versions module Ast_io = Migrate_parsetree_ast_io (** {1 State a rewriter can access} *) type extra = .. type config = { tool_name: string; include_dirs : string list; load_path : string list; debug : bool; for_package : string option; extras : extra list; } let make_config ~tool_name ?(include_dirs=[]) ?(load_path=[]) ?(debug=false) ?for_package ?(extras=[]) () = { tool_name ; include_dirs ; load_path ; debug ; for_package ; extras } type cookie = Cookie : 'types ocaml_version * 'types get_expression -> cookie type cookies = (string, cookie) Hashtbl.t let create_cookies () = Hashtbl.create 3 let global_cookie_table = create_cookies () let get_cookie table name version = match match Hashtbl.find table name with | result -> Some result | exception Not_found -> match Ast_mapper.get_cookie name with | Some expr -> Some (Cookie ((module OCaml_current), expr)) | None -> match Hashtbl.find global_cookie_table name with | result -> Some result | exception Not_found -> None with | None -> None | Some (Cookie (version', expr)) -> Some ((migrate version' version).copy_expression expr) let set_cookie table name version expr = Hashtbl.replace table name (Cookie (version, expr)) let set_global_cookie name version expr = set_cookie global_cookie_table name version expr let apply_cookies table = Hashtbl.iter (fun name (Cookie (version, expr)) -> Ast_mapper.set_cookie name ((migrate version (module OCaml_current)).copy_expression expr) ) table let initial_state () = { tool_name = Ast_mapper.tool_name (); include_dirs = !Clflags.include_dirs; load_path = Migrate_parsetree_compiler_functions.get_load_paths (); debug = !Clflags.debug; for_package = !Clflags.for_package; extras = []; } (** {1 Registering rewriters} *) type 'types rewriter = config -> cookies -> 'types get_mapper type rewriter_group = Rewriters : 'types ocaml_version * (string * 'types rewriter) list -> rewriter_group let rewriter_group_names (Rewriters (_, l)) = List.map fst l let uniq_rewriter = Hashtbl.create 7 module Pos_map = Map.Make(struct type t = int let compare : int -> int -> t = compare end) let registered_rewriters = ref Pos_map.empty let all_rewriters () = Pos_map.bindings !registered_rewriters |> List.map (fun (_, r) -> !r) |> List.concat let uniq_arg = Hashtbl.create 7 let registered_args_reset = ref [] let registered_args = ref [] let () = let set_cookie s = match String.index s '=' with | exception _ -> raise (Arg.Bad "invalid cookie, must be of the form \"=\"") | i -> let name = String.sub s 0 i in let value = String.sub s (i + 1) (String.length s - i - 1) in let input_name = "" in Location.input_name := input_name; let lexbuf = Lexing.from_string value in lexbuf.Lexing.lex_curr_p <- { Lexing. pos_fname = input_name ; pos_lnum = 1 ; pos_bol = 0 ; pos_cnum = 0 }; let expr = Parse.expression lexbuf in set_global_cookie name (module OCaml_current) expr in registered_args := ("--cookie", Arg.String set_cookie, "NAME=EXPR Set the cookie NAME to EXPR") :: !registered_args type ('types, 'version, 'rewriter) is_rewriter = | Is_rewriter : ('types, 'types ocaml_version, 'types rewriter) is_rewriter let add_rewriter (type types) (type version) (type rewriter) (Is_rewriter : (types, version, rewriter) is_rewriter) (version : version) name (rewriter : rewriter) = let rec add_rewriter = function | [] -> [Rewriters (version, [name, rewriter])] | (Rewriters (version', rewriters) as x) :: xs -> match compare_ocaml_version version version' with | Eq -> Rewriters (version', (name, rewriter) :: rewriters) :: xs | Lt -> Rewriters (version, [name, rewriter]) :: x :: xs | Gt -> x :: add_rewriter xs in add_rewriter let register ~name ?reset_args ?(args=[]) ?(position=0) version rewriter = (* Validate name *) if name = "" then invalid_arg "Migrate_parsetree_driver.register: name is empty"; if Hashtbl.mem uniq_rewriter name then invalid_arg ("Migrate_parsetree_driver.register: rewriter " ^ name ^ " has already been registered") else Hashtbl.add uniq_rewriter name (); (* Validate arguments *) List.iter (fun (arg_name, _, _) -> match Hashtbl.find uniq_arg arg_name with | other_rewriter -> invalid_arg (Printf.sprintf "Migrate_parsetree_driver.register: argument %s is used by %s and %s" arg_name name other_rewriter) | exception Not_found -> Hashtbl.add uniq_arg arg_name name ) args; (* Register *) begin match reset_args with | None -> () | Some f -> registered_args_reset := f :: !registered_args_reset end; registered_args := List.rev_append args !registered_args; let r = try Pos_map.find position !registered_rewriters with Not_found -> let r = ref [] in registered_rewriters := Pos_map.add position r !registered_rewriters; r in r := add_rewriter Is_rewriter version name rewriter !r let registered_args () = List.rev !registered_args let reset_args () = List.iter (fun f -> f ()) !registered_args_reset (** {1 Accessing or running registered rewriters} *) type ('types, 'version, 'tree) is_signature = Signature : ('types, 'types ocaml_version, 'types get_signature) is_signature type ('types, 'version, 'tree) is_structure = Structure : ('types, 'types ocaml_version, 'types get_structure) is_structure type some_structure = | Str : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.structure = 'concrete) * 'concrete -> some_structure type some_signature = | Sig : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.signature = 'concrete) * 'concrete -> some_signature let migrate_some_structure dst (Str ((module Version), st)) = (migrate (module Version) dst).copy_structure st let migrate_some_signature dst (Sig ((module Version), sg)) = (migrate (module Version) dst).copy_signature sg let rec rewrite_signature : type types version tree. config -> cookies -> (types, version, tree) is_signature -> version -> tree -> rewriter_group list -> some_signature = fun (type types) (type version) (type tree) config cookies (Signature : (types, version, tree) is_signature) (version : version) (tree : tree) -> function | [] -> let (module Version) = version in Sig ((module Version), tree) | Rewriters (version', rewriters) :: rest -> let rewrite (_name, rewriter) tree = let (module Version) = version' in Version.Ast.map_signature (rewriter config cookies) tree in let tree = (migrate version version').copy_signature tree in let tree = List.fold_right rewrite rewriters tree in rewrite_signature config cookies Signature version' tree rest let rewrite_signature config version sg = let cookies = create_cookies () in let sg = rewrite_signature config cookies Signature version sg (all_rewriters ()) in apply_cookies cookies; sg let rec rewrite_structure : type types version tree. config -> cookies -> (types, version, tree) is_structure -> version -> tree -> rewriter_group list -> some_structure = fun (type types) (type version) (type tree) config cookies (Structure : (types, version, tree) is_structure) (version : version) (tree : tree) -> function | [] -> let (module Version) = version in Str ((module Version), tree) | Rewriters (version', rewriters) :: rest -> let rewriter (_name, rewriter) tree = let (module Version) = version' in Version.Ast.map_structure (rewriter config cookies) tree in let tree = (migrate version version').copy_structure tree in let tree = List.fold_right rewriter rewriters tree in rewrite_structure config cookies Structure version' tree rest let rewrite_structure config version st = let cookies = create_cookies () in let st = rewrite_structure config cookies Structure version st (all_rewriters ()) in apply_cookies cookies; st let run_as_ast_mapper args = let spec = registered_args () in let args, usage = let me = Filename.basename Sys.executable_name in let args = match args with "--as-ppx" :: args -> args | args -> args in (Array.of_list (me :: args), Printf.sprintf "%s [options] " me) in reset_args (); match Arg.parse_argv args spec (fun arg -> raise (Arg.Bad (Printf.sprintf "invalid argument %S" arg))) usage with | exception (Arg.Help msg) -> prerr_endline msg; exit 1 | () -> OCaml_current.Ast.make_top_mapper ~signature:(fun sg -> let config = initial_state () in rewrite_signature config (module OCaml_current) sg |> migrate_some_signature (module OCaml_current) ) ~structure:(fun str -> let config = initial_state () in rewrite_structure config (module OCaml_current) str |> migrate_some_structure (module OCaml_current) ) let protectx x ~finally ~f = match f x with | y -> finally x; y | exception e -> finally x; raise e let with_file_in fn ~f = protectx (open_in_bin fn) ~finally:close_in ~f let with_file_out fn ~f = protectx (open_out_bin fn) ~finally:close_out ~f type ('a, 'b) intf_or_impl = | Intf of 'a | Impl of 'b type file_kind = | Kind_intf | Kind_impl | Kind_unknown let guess_file_kind fn = if Filename.check_suffix fn ".ml" then Kind_impl else if Filename.check_suffix fn ".mli" then Kind_intf else Kind_unknown let check_kind fn ~expected ~got = let describe = function | Kind_intf -> "interface" | Kind_impl -> "implementation" | Kind_unknown -> "unknown file" in match expected, got with | Kind_impl, Kind_impl | Kind_intf, Kind_intf | Kind_unknown, _ -> () | _ -> Location.raise_errorf ~loc:(Location.in_file fn) "Expected an %s got an %s instead" (describe expected) (describe got) let load_file (kind, fn) = with_file_in fn ~f:(fun ic -> match Ast_io.from_channel ic with | Ok (fn, Ast_io.Intf ((module V), sg)) -> check_kind fn ~expected:kind ~got:Kind_intf; Location.input_name := fn; (* We need to convert to the current version in order to interpret the cookies using [Ast_mapper.drop_ppx_context_*] from the compiler *) (fn, Intf ((migrate (module V) (module OCaml_current)).copy_signature sg)) | Ok (fn, Ast_io.Impl ((module V), st)) -> check_kind fn ~expected:kind ~got:Kind_impl; Location.input_name := fn; (fn, Impl ((migrate (module V) (module OCaml_current)).copy_structure st)) | Error (Ast_io.Unknown_version _) -> Location.raise_errorf ~loc:(Location.in_file fn) "File is a binary ast for an unknown version of OCaml" | Error (Ast_io.Not_a_binary_ast prefix_read_from_file) -> (* To test if a file is a binary AST file, we have to read the first few bytes of the file. If it is not a binary AST, we have to parse these bytes and the rest of the file as source code. To do that, we prefill the lexbuf buffer with what we read from the file to do the test. *) let lexbuf = Lexing.from_channel ic in let len = String.length prefix_read_from_file in String.blit prefix_read_from_file 0 lexbuf.Lexing.lex_buffer 0 len; lexbuf.Lexing.lex_buffer_len <- len; lexbuf.Lexing.lex_curr_p <- { Lexing. pos_fname = fn ; pos_lnum = 1 ; pos_bol = 0 ; pos_cnum = 0 }; Location.input_name := fn; let kind = match kind with | Kind_impl -> Kind_impl | Kind_intf -> Kind_intf | Kind_unknown -> guess_file_kind fn in match kind with | Kind_impl -> (fn, Impl (Parse.implementation lexbuf)) | Kind_intf -> (fn, Intf (Parse.interface lexbuf)) | Kind_unknown -> Location.raise_errorf ~loc:(Location.in_file fn) "I can't decide whether %s is an implementation or interface file" fn) let with_output ?bin output ~f = match output with | None -> begin match bin with | Some bin -> set_binary_mode_out stdout bin | None -> () end; f stdout | Some fn -> with_file_out fn ~f type output_mode = | Pretty_print | Dump_ast | Null let process_file ~config ~output ~output_mode ~embed_errors file = let fn, ast = load_file file in let ast = match ast with | Intf sg -> let sg = Ast_mapper.drop_ppx_context_sig ~restore:true sg in let sg = try rewrite_signature config (module OCaml_current) sg |> migrate_some_signature (module OCaml_current) with exn when embed_errors -> match Migrate_parsetree_compiler_functions.error_of_exn exn with | None -> raise exn | Some error -> [ Ast_helper.Sig.extension ~loc:Location.none (Ast_mapper.extension_of_error error) ] in Intf (sg, Ast_mapper.add_ppx_context_sig ~tool_name:config.tool_name sg) | Impl st -> let st = Ast_mapper.drop_ppx_context_str ~restore:true st in let st = try rewrite_structure config (module OCaml_current) st |> migrate_some_structure (module OCaml_current) with exn when embed_errors -> match Migrate_parsetree_compiler_functions.error_of_exn exn with | None -> raise exn | Some error -> [ Ast_helper.Str.extension ~loc:Location.none (Ast_mapper.extension_of_error error) ] in Impl (st, Ast_mapper.add_ppx_context_str ~tool_name:config.tool_name st) in match output_mode with | Dump_ast -> with_output ~bin:true output ~f:(fun oc -> let ast = match ast with | Intf (_, sg) -> Ast_io.Intf ((module OCaml_current), sg) | Impl (_, st) -> Ast_io.Impl ((module OCaml_current), st) in Ast_io.to_channel oc fn ast) | Pretty_print -> with_output output ~f:(fun oc -> let ppf = Format.formatter_of_out_channel oc in (match ast with | Intf (sg, _) -> Pprintast.signature ppf sg | Impl (st, _) -> Pprintast.structure ppf st); Format.pp_print_newline ppf ()) | Null -> () let print_transformations () = let print_group name = function | [] -> () | names -> Printf.printf "%s:\n" name; List.iter (Printf.printf "%s\n") names in all_rewriters () |> List.map rewriter_group_names |> List.concat |> print_group "Registered Transformations"; Ppx_derivers.derivers () |> List.map (fun (x, _) -> x) |> print_group "Registered Derivers" let run_as_standalone_driver argv = let request_print_transformations = ref false in let output = ref None in let output_mode = ref Pretty_print in let output_mode_arg = ref "" in let files = ref [] in let embed_errors = ref false in let embed_errors_arg = ref "" in let spec = let fail fmt = Printf.ksprintf (fun s -> raise (Arg.Bad s)) fmt in let incompatible a b = fail "%s and %s are incompatible" a b in let as_ppx () = fail "--as-ppx must be passed as first argument" in let set_embed_errors arg = if !output_mode = Null then incompatible !output_mode_arg arg; embed_errors := true; embed_errors_arg := arg in let set_output_mode arg mode = match !output_mode, mode with | Pretty_print, _ -> if mode = Null && !embed_errors then incompatible !embed_errors_arg arg; if mode = Null && !output <> None then incompatible "-o" arg; output_mode := mode; output_mode_arg := arg | _, Pretty_print -> assert false | Dump_ast, Dump_ast | Null, Null -> () | _ -> incompatible !output_mode_arg arg in let set_output fn = if !output_mode = Null then incompatible !output_mode_arg "-o"; output := Some fn in let as_pp () = let arg = "--as-pp" in set_output_mode arg Dump_ast; set_embed_errors arg in [ "--as-ppx", Arg.Unit as_ppx, " Act as a -ppx rewriter" ; "--as-pp", Arg.Unit as_pp, " Shorthand for: --dump-ast --embed-errors" ; "--dump-ast", Arg.Unit (fun () -> set_output_mode "--dump-ast" Dump_ast), " Output a binary AST instead of source code" ; "--null", Arg.Unit (fun () -> set_output_mode "--null" Null), " Output nothing, just report errors" ; "-o", Arg.String set_output, "FILE Output to this file instead of the standard output" ; "--intf", Arg.String (fun fn -> files := (Kind_intf, fn) :: !files), "FILE Treat FILE as a .mli file" ; "--impl", Arg.String (fun fn -> files := (Kind_impl, fn) :: !files), "FILE Treat FILE as a .ml file" ; "--embed-errors", Arg.Unit (fun () -> set_embed_errors "--embed-errors"), " Embed error reported by rewriters into the AST" ; "--print-transformations", Arg.Set request_print_transformations, " Print registered transformations in their order of executions" ] in let spec = Arg.align (spec @ registered_args ()) in let me = Filename.basename Sys.executable_name in let usage = Printf.sprintf "%s [options] []" me in try reset_args (); Arg.parse_argv argv spec (fun anon -> files := (Kind_unknown, anon) :: !files) usage; if !request_print_transformations then begin print_transformations (); exit 0 end; let output = !output in let output_mode = !output_mode in let embed_errors = !embed_errors in let config = (* TODO: we could add -I, -L and -g options to populate these fields. *) { tool_name = "migrate_driver" ; include_dirs = [] ; load_path = [] ; debug = false ; for_package = None ; extras = [] } in List.iter (process_file ~config ~output ~output_mode ~embed_errors) (List.rev !files) with exn -> Location.report_exception Format.err_formatter exn; exit 1 let run_as_ppx_rewriter ?(argv = Sys.argv) () = let a = argv in let n = Array.length a in if n <= 2 then begin let me = Filename.basename Sys.executable_name in Arg.usage (registered_args ()) (Printf.sprintf "%s [options] " me); exit 2 end; match Ast_mapper.apply ~source:a.(n - 2) ~target:a.(n - 1) (run_as_ast_mapper (Array.to_list (Array.sub a 1 (n - 3)))) with | () -> exit 0 | exception (Arg.Bad help) -> prerr_endline help; exit 1 | exception exn -> Location.report_exception Format.err_formatter exn; exit 1 let run_main ?(argv = Sys.argv) () = if Array.length argv >= 2 && argv.(1) = "--as-ppx" then run_as_ppx_rewriter ~argv () else run_as_standalone_driver argv; exit 0 ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_driver.mli000066400000000000000000000056651356450464700246270ustar00rootroot00000000000000open Migrate_parsetree_versions (** {1 State a rewriter can access} *) type extra = .. type config = { tool_name : string; include_dirs : string list; load_path : string list; debug : bool; for_package : string option; (** Additional parameters that can be passed by a caller of [rewrite_{signature,structure}] to a specific register rewriter. *) extras : extra list; } val make_config : tool_name:string -> ?include_dirs:string list -> ?load_path:string list -> ?debug:bool -> ?for_package:string -> ?extras:extra list -> unit -> config type cookies val get_cookie : cookies -> string -> 'types ocaml_version -> 'types get_expression option val set_cookie : cookies -> string -> 'types ocaml_version -> 'types get_expression -> unit val set_global_cookie : string -> 'types ocaml_version -> 'types get_expression -> unit (** {1 Registering rewriters} *) type 'types rewriter = config -> cookies -> 'types get_mapper (** Register a ppx rewriter. [position] is a integer that indicates when the ppx rewriter should be applied. It is guaranteed that if two ppx rewriters [a] and [b] have different position numbers, then the one with the lowest number will be applied first. The rewriting order of ppx rewriters with the same position number is not specified. The default position is [0]. Note that more different position numbers means more AST conversions and slower rewriting, so think twice before setting [position] to a non-zero number. *) val register : name:string -> ?reset_args:(unit -> unit) -> ?args:(Arg.key * Arg.spec * Arg.doc) list -> ?position:int -> 'types ocaml_version -> 'types rewriter -> unit (** Return the list of command line arguments registered by rewriters *) val registered_args : unit -> (Arg.key * Arg.spec * Arg.doc) list (** Call all the registered [reset_args] callbacks *) val reset_args : unit -> unit (** {1 Running registered rewriters} *) val run_as_ast_mapper : string list -> Ast_mapper.mapper val run_as_ppx_rewriter : ?argv:string array -> unit -> 'a val run_main : ?argv:string array -> unit -> 'a (** {1 Manual mapping} *) type some_signature = | Sig : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.signature = 'concrete) * 'concrete -> some_signature type some_structure = | Str : (module Migrate_parsetree_versions.OCaml_version with type Ast.Parsetree.structure = 'concrete) * 'concrete -> some_structure val migrate_some_signature : 'version ocaml_version -> some_signature -> 'version get_signature val migrate_some_structure : 'version ocaml_version -> some_structure -> 'version get_structure val rewrite_signature : config -> 'version ocaml_version -> 'version get_signature -> some_signature val rewrite_structure : config -> 'version ocaml_version -> 'version get_structure -> some_structure ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_driver_main.ml000066400000000000000000000000561356450464700254470ustar00rootroot00000000000000let () = Migrate_parsetree.Driver.run_main () ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_parse.ml000066400000000000000000000045671356450464700242750ustar00rootroot00000000000000 (**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Parser entry points that migrate to a specified version of OCaml. The parser used is the one from current compiler-libs. The resulting AST is then converted to the desired version. These parsing functions can raise Migration_errors. *) open Migrate_parsetree_versions let implementation version = let { copy_structure; _ } = migrate ocaml_current version in fun lexbuf -> copy_structure (Parse.implementation lexbuf) let interface version = let { copy_signature; _ } = migrate ocaml_current version in fun lexbuf -> copy_signature (Parse.interface lexbuf) let toplevel_phrase version = let { copy_toplevel_phrase; _ } = migrate ocaml_current version in fun lexbuf -> copy_toplevel_phrase (Parse.toplevel_phrase lexbuf) let use_file version = let { copy_toplevel_phrase; _ } = migrate ocaml_current version in fun lexbuf -> List.map copy_toplevel_phrase (Parse.use_file lexbuf) let core_type version = let { copy_core_type; _ } = migrate ocaml_current version in fun lexbuf -> copy_core_type (Parse.core_type lexbuf) let expression version = let { copy_expression; _ } = migrate ocaml_current version in fun lexbuf -> copy_expression (Parse.expression lexbuf) let pattern version = let { copy_pattern; _ } = migrate ocaml_current version in fun lexbuf -> copy_pattern (Parse.pattern lexbuf) ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_parse.mli000066400000000000000000000036621356450464700244410ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* Parser entry points that migrate to a specified version of OCaml. The parser used is the one from current compiler-libs. The resulting AST is then converted to the desired version. These parsing functions can raise Migration_errors. *) open Migrate_parsetree_versions val implementation : 'types ocaml_version -> Lexing.lexbuf -> 'types get_structure val interface : 'types ocaml_version -> Lexing.lexbuf -> 'types get_signature val toplevel_phrase : 'types ocaml_version -> Lexing.lexbuf -> 'types get_toplevel_phrase val use_file : 'types ocaml_version -> Lexing.lexbuf -> 'types get_toplevel_phrase list val core_type : 'types ocaml_version -> Lexing.lexbuf -> 'types get_core_type val expression : 'types ocaml_version -> Lexing.lexbuf -> 'types get_expression val pattern : 'types ocaml_version -> Lexing.lexbuf -> 'types get_pattern ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_versions.ml000066400000000000000000000716241356450464700250310ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino, Jane Street Europe *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* BEGIN of BLACK MAGIC *) (*$ #use "src/cinaps_helpers" $*) type _ witnesses = .. type _ migration = .. type _ migration += Undefined : _ migration type 'a migration_info = { mutable next_version : 'a migration; mutable previous_version : 'a migration; } (** Abstract view of a version of an OCaml Ast *) module type Ast = sig (*$ foreach_module (fun m types -> printf "module %s : sig\n" m; List.iter types ~f:(printf "type %s\n"); printf "end\n" ) *) module Parsetree : sig type structure type signature type toplevel_phrase type core_type type expression type pattern type case type type_declaration type type_extension type extension_constructor end module Outcometree : sig type out_value type out_type type out_class_type type out_module_type type out_sig_item type out_type_extension type out_phrase end module Ast_mapper : sig type mapper end (*$*) module Config : sig val ast_impl_magic_number : string val ast_intf_magic_number : string end val shallow_identity : Ast_mapper.mapper val map_signature : Ast_mapper.mapper -> Parsetree.signature -> Parsetree.signature val map_structure : Ast_mapper.mapper -> Parsetree.structure -> Parsetree.structure val make_top_mapper : signature:(Parsetree.signature -> Parsetree.signature) -> structure:(Parsetree.structure -> Parsetree.structure) -> Ast_mapper.mapper end (* Shortcuts for talking about ast types outside of the module language *) type 'a _types = 'a constraint 'a = < (*$ foreach_type (fun _ s -> printf "%-21s : _;\n" s) *) structure : _; signature : _; toplevel_phrase : _; core_type : _; expression : _; pattern : _; case : _; type_declaration : _; type_extension : _; extension_constructor : _; out_value : _; out_type : _; out_class_type : _; out_module_type : _; out_sig_item : _; out_type_extension : _; out_phrase : _; mapper : _; (*$*) > ;; (*$ foreach_type (fun _ s -> printf "type 'a get_%s =\n" s; printf " 'x constraint 'a _types = < %s : 'x; .. >\n" s ) *) type 'a get_structure = 'x constraint 'a _types = < structure : 'x; .. > type 'a get_signature = 'x constraint 'a _types = < signature : 'x; .. > type 'a get_toplevel_phrase = 'x constraint 'a _types = < toplevel_phrase : 'x; .. > type 'a get_core_type = 'x constraint 'a _types = < core_type : 'x; .. > type 'a get_expression = 'x constraint 'a _types = < expression : 'x; .. > type 'a get_pattern = 'x constraint 'a _types = < pattern : 'x; .. > type 'a get_case = 'x constraint 'a _types = < case : 'x; .. > type 'a get_type_declaration = 'x constraint 'a _types = < type_declaration : 'x; .. > type 'a get_type_extension = 'x constraint 'a _types = < type_extension : 'x; .. > type 'a get_extension_constructor = 'x constraint 'a _types = < extension_constructor : 'x; .. > type 'a get_out_value = 'x constraint 'a _types = < out_value : 'x; .. > type 'a get_out_type = 'x constraint 'a _types = < out_type : 'x; .. > type 'a get_out_class_type = 'x constraint 'a _types = < out_class_type : 'x; .. > type 'a get_out_module_type = 'x constraint 'a _types = < out_module_type : 'x; .. > type 'a get_out_sig_item = 'x constraint 'a _types = < out_sig_item : 'x; .. > type 'a get_out_type_extension = 'x constraint 'a _types = < out_type_extension : 'x; .. > type 'a get_out_phrase = 'x constraint 'a _types = < out_phrase : 'x; .. > type 'a get_mapper = 'x constraint 'a _types = < mapper : 'x; .. > (*$*) module type OCaml_version = sig module Ast : Ast val version : int val string_version : string type types = < (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s)*) structure : Ast.Parsetree.structure; signature : Ast.Parsetree.signature; toplevel_phrase : Ast.Parsetree.toplevel_phrase; core_type : Ast.Parsetree.core_type; expression : Ast.Parsetree.expression; pattern : Ast.Parsetree.pattern; case : Ast.Parsetree.case; type_declaration : Ast.Parsetree.type_declaration; type_extension : Ast.Parsetree.type_extension; extension_constructor : Ast.Parsetree.extension_constructor; out_value : Ast.Outcometree.out_value; out_type : Ast.Outcometree.out_type; out_class_type : Ast.Outcometree.out_class_type; out_module_type : Ast.Outcometree.out_module_type; out_sig_item : Ast.Outcometree.out_sig_item; out_type_extension : Ast.Outcometree.out_type_extension; out_phrase : Ast.Outcometree.out_phrase; mapper : Ast.Ast_mapper.mapper; (*$*) > _types type _ witnesses += Version : types witnesses val migration_info : types migration_info end module Make_witness(Ast : Ast) = struct type types = < (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s)*) structure : Ast.Parsetree.structure; signature : Ast.Parsetree.signature; toplevel_phrase : Ast.Parsetree.toplevel_phrase; core_type : Ast.Parsetree.core_type; expression : Ast.Parsetree.expression; pattern : Ast.Parsetree.pattern; case : Ast.Parsetree.case; type_declaration : Ast.Parsetree.type_declaration; type_extension : Ast.Parsetree.type_extension; extension_constructor : Ast.Parsetree.extension_constructor; out_value : Ast.Outcometree.out_value; out_type : Ast.Outcometree.out_type; out_class_type : Ast.Outcometree.out_class_type; out_module_type : Ast.Outcometree.out_module_type; out_sig_item : Ast.Outcometree.out_sig_item; out_type_extension : Ast.Outcometree.out_type_extension; out_phrase : Ast.Outcometree.out_phrase; mapper : Ast.Ast_mapper.mapper; (*$*) > _types type _ witnesses += Version : types witnesses let migration_info : types migration_info = { next_version = Undefined; previous_version = Undefined } end type 'types ocaml_version = (module OCaml_version (*$ let sep = with_then_and () in foreach_type (fun m s -> printf "%t type Ast.%s.%s = 'types get_%s\n" sep m s s) *) with type Ast.Parsetree.structure = 'types get_structure and type Ast.Parsetree.signature = 'types get_signature and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase and type Ast.Parsetree.core_type = 'types get_core_type and type Ast.Parsetree.expression = 'types get_expression and type Ast.Parsetree.pattern = 'types get_pattern and type Ast.Parsetree.case = 'types get_case and type Ast.Parsetree.type_declaration = 'types get_type_declaration and type Ast.Parsetree.type_extension = 'types get_type_extension and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor and type Ast.Outcometree.out_value = 'types get_out_value and type Ast.Outcometree.out_type = 'types get_out_type and type Ast.Outcometree.out_class_type = 'types get_out_class_type and type Ast.Outcometree.out_module_type = 'types get_out_module_type and type Ast.Outcometree.out_sig_item = 'types get_out_sig_item and type Ast.Outcometree.out_type_extension = 'types get_out_type_extension and type Ast.Outcometree.out_phrase = 'types get_out_phrase and type Ast.Ast_mapper.mapper = 'types get_mapper (*$*) ) type ('a, 'b) type_comparison = | Lt : ('a, 'b) type_comparison | Eq : ('a, 'a) type_comparison | Gt : ('a, 'b) type_comparison let compare_ocaml_version (*$ foreach_type (fun _ s -> printf "(type %s1) (type %s2)\n" s s) *) (type structure1) (type structure2) (type signature1) (type signature2) (type toplevel_phrase1) (type toplevel_phrase2) (type core_type1) (type core_type2) (type expression1) (type expression2) (type pattern1) (type pattern2) (type case1) (type case2) (type type_declaration1) (type type_declaration2) (type type_extension1) (type type_extension2) (type extension_constructor1) (type extension_constructor2) (type out_value1) (type out_value2) (type out_type1) (type out_type2) (type out_class_type1) (type out_class_type2) (type out_module_type1) (type out_module_type2) (type out_sig_item1) (type out_sig_item2) (type out_type_extension1) (type out_type_extension2) (type out_phrase1) (type out_phrase2) (type mapper1) (type mapper2) (*$*) ((module A) : < (*$ foreach_type (fun _ s -> printf "%-21s : %s1;\n" s s) *) structure : structure1; signature : signature1; toplevel_phrase : toplevel_phrase1; core_type : core_type1; expression : expression1; pattern : pattern1; case : case1; type_declaration : type_declaration1; type_extension : type_extension1; extension_constructor : extension_constructor1; out_value : out_value1; out_type : out_type1; out_class_type : out_class_type1; out_module_type : out_module_type1; out_sig_item : out_sig_item1; out_type_extension : out_type_extension1; out_phrase : out_phrase1; mapper : mapper1; (*$*) > ocaml_version) ((module B) : < (*$ foreach_type (fun _ s -> printf "%-21s : %s2;\n" s s) *) structure : structure2; signature : signature2; toplevel_phrase : toplevel_phrase2; core_type : core_type2; expression : expression2; pattern : pattern2; case : case2; type_declaration : type_declaration2; type_extension : type_extension2; extension_constructor : extension_constructor2; out_value : out_value2; out_type : out_type2; out_class_type : out_class_type2; out_module_type : out_module_type2; out_sig_item : out_sig_item2; out_type_extension : out_type_extension2; out_phrase : out_phrase2; mapper : mapper2; (*$*) > ocaml_version) : (A.types, B.types) type_comparison = match A.Version with | B.Version -> Eq | _ when A.version < B.version -> Lt | _ when A.version > B.version -> Gt | _ -> assert false type ('from, 'to_) migration_functions = { (*$ foreach_type (fun _ s -> printf "copy_%s: 'from get_%s -> 'to_ get_%s;\n" s s s) *) copy_structure: 'from get_structure -> 'to_ get_structure; copy_signature: 'from get_signature -> 'to_ get_signature; copy_toplevel_phrase: 'from get_toplevel_phrase -> 'to_ get_toplevel_phrase; copy_core_type: 'from get_core_type -> 'to_ get_core_type; copy_expression: 'from get_expression -> 'to_ get_expression; copy_pattern: 'from get_pattern -> 'to_ get_pattern; copy_case: 'from get_case -> 'to_ get_case; copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration; copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension; copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor; copy_out_value: 'from get_out_value -> 'to_ get_out_value; copy_out_type: 'from get_out_type -> 'to_ get_out_type; copy_out_class_type: 'from get_out_class_type -> 'to_ get_out_class_type; copy_out_module_type: 'from get_out_module_type -> 'to_ get_out_module_type; copy_out_sig_item: 'from get_out_sig_item -> 'to_ get_out_sig_item; copy_out_type_extension: 'from get_out_type_extension -> 'to_ get_out_type_extension; copy_out_phrase: 'from get_out_phrase -> 'to_ get_out_phrase; copy_mapper: 'from get_mapper -> 'to_ get_mapper; (*$*) } let id x = x let migration_identity : ('a, 'a) migration_functions = { (*$ foreach_type (fun _ s -> printf "copy_%s = id;\n" s) *) copy_structure = id; copy_signature = id; copy_toplevel_phrase = id; copy_core_type = id; copy_expression = id; copy_pattern = id; copy_case = id; copy_type_declaration = id; copy_type_extension = id; copy_extension_constructor = id; copy_out_value = id; copy_out_type = id; copy_out_class_type = id; copy_out_module_type = id; copy_out_sig_item = id; copy_out_type_extension = id; copy_out_phrase = id; copy_mapper = id; (*$*) } let compose f g x = f (g x) let migration_compose (ab : ('a, 'b) migration_functions) (bc : ('b, 'c) migration_functions) : ('a, 'c) migration_functions = { (*$ foreach_type (fun _ s -> printf "copy_%-21s = compose bc.copy_%-21s ab.copy_%s;\n" s s s) *) copy_structure = compose bc.copy_structure ab.copy_structure; copy_signature = compose bc.copy_signature ab.copy_signature; copy_toplevel_phrase = compose bc.copy_toplevel_phrase ab.copy_toplevel_phrase; copy_core_type = compose bc.copy_core_type ab.copy_core_type; copy_expression = compose bc.copy_expression ab.copy_expression; copy_pattern = compose bc.copy_pattern ab.copy_pattern; copy_case = compose bc.copy_case ab.copy_case; copy_type_declaration = compose bc.copy_type_declaration ab.copy_type_declaration; copy_type_extension = compose bc.copy_type_extension ab.copy_type_extension; copy_extension_constructor = compose bc.copy_extension_constructor ab.copy_extension_constructor; copy_out_value = compose bc.copy_out_value ab.copy_out_value; copy_out_type = compose bc.copy_out_type ab.copy_out_type; copy_out_class_type = compose bc.copy_out_class_type ab.copy_out_class_type; copy_out_module_type = compose bc.copy_out_module_type ab.copy_out_module_type; copy_out_sig_item = compose bc.copy_out_sig_item ab.copy_out_sig_item; copy_out_type_extension = compose bc.copy_out_type_extension ab.copy_out_type_extension; copy_out_phrase = compose bc.copy_out_phrase ab.copy_out_phrase; copy_mapper = compose bc.copy_mapper ab.copy_mapper; (*$*) } type _ migration += Migration : 'from ocaml_version * ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from migration module type Migrate_module = sig module From : Ast module To : Ast (*$ foreach_type (fun m s -> printf "val copy_%-21s: From.%s.%s -> To.%s.%s\n" s m s m s) *) val copy_structure : From.Parsetree.structure -> To.Parsetree.structure val copy_signature : From.Parsetree.signature -> To.Parsetree.signature val copy_toplevel_phrase : From.Parsetree.toplevel_phrase -> To.Parsetree.toplevel_phrase val copy_core_type : From.Parsetree.core_type -> To.Parsetree.core_type val copy_expression : From.Parsetree.expression -> To.Parsetree.expression val copy_pattern : From.Parsetree.pattern -> To.Parsetree.pattern val copy_case : From.Parsetree.case -> To.Parsetree.case val copy_type_declaration : From.Parsetree.type_declaration -> To.Parsetree.type_declaration val copy_type_extension : From.Parsetree.type_extension -> To.Parsetree.type_extension val copy_extension_constructor: From.Parsetree.extension_constructor -> To.Parsetree.extension_constructor val copy_out_value : From.Outcometree.out_value -> To.Outcometree.out_value val copy_out_type : From.Outcometree.out_type -> To.Outcometree.out_type val copy_out_class_type : From.Outcometree.out_class_type -> To.Outcometree.out_class_type val copy_out_module_type : From.Outcometree.out_module_type -> To.Outcometree.out_module_type val copy_out_sig_item : From.Outcometree.out_sig_item -> To.Outcometree.out_sig_item val copy_out_type_extension : From.Outcometree.out_type_extension -> To.Outcometree.out_type_extension val copy_out_phrase : From.Outcometree.out_phrase -> To.Outcometree.out_phrase val copy_mapper : From.Ast_mapper.mapper -> To.Ast_mapper.mapper (*$*) end module Migration_functions (A : OCaml_version) (B : OCaml_version) (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast) = struct let migration_functions : (A.types, B.types) migration_functions = let open A_to_B in { (*$ foreach_type (fun _ s -> printf "copy_%s;\n" s) *) copy_structure; copy_signature; copy_toplevel_phrase; copy_core_type; copy_expression; copy_pattern; copy_case; copy_type_declaration; copy_type_extension; copy_extension_constructor; copy_out_value; copy_out_type; copy_out_class_type; copy_out_module_type; copy_out_sig_item; copy_out_type_extension; copy_out_phrase; copy_mapper; (*$*) } end module Register_migration (A : OCaml_version) (B : OCaml_version) (A_to_B : Migrate_module with module From = A.Ast and module To = B.Ast) (B_to_A : Migrate_module with module From = B.Ast and module To = A.Ast) = struct let () = ( let is_undefined : type a. a migration -> bool = function | Undefined -> true | _ -> false in assert (A.version < B.version); assert (is_undefined A.migration_info.next_version); assert (is_undefined B.migration_info.previous_version); let module A_to_B_fun = Migration_functions(A)(B)(A_to_B) in let module B_to_A_fun = Migration_functions(B)(A)(B_to_A) in A.migration_info.next_version <- Migration ((module A), A_to_B_fun.migration_functions, (module B)); B.migration_info.previous_version <- Migration ((module B), B_to_A_fun.migration_functions, (module A)); ) end type 'from immediate_migration = | No_migration : 'from immediate_migration | Immediate_migration : ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from immediate_migration let immediate_migration (*$ foreach_type (fun _ s -> printf "(type %s)\n" s) *) (type structure) (type signature) (type toplevel_phrase) (type core_type) (type expression) (type pattern) (type case) (type type_declaration) (type type_extension) (type extension_constructor) (type out_value) (type out_type) (type out_class_type) (type out_module_type) (type out_sig_item) (type out_type_extension) (type out_phrase) (type mapper) (*$*) ((module A) : < (*$ foreach_type (fun _ s -> printf "%-21s : %s;\n" s s) *) structure : structure; signature : signature; toplevel_phrase : toplevel_phrase; core_type : core_type; expression : expression; pattern : pattern; case : case; type_declaration : type_declaration; type_extension : type_extension; extension_constructor : extension_constructor; out_value : out_value; out_type : out_type; out_class_type : out_class_type; out_module_type : out_module_type; out_sig_item : out_sig_item; out_type_extension : out_type_extension; out_phrase : out_phrase; mapper : mapper; (*$*) > ocaml_version) direction = let version = match direction with | `Next -> A.migration_info.next_version | `Previous -> A.migration_info.previous_version in match version with | Undefined -> No_migration | Migration (_, funs, to_) -> Immediate_migration (funs, to_) | _ -> assert false let migrate (*$ foreach_type (fun _ s -> printf "(type %s1) (type %s2)\n" s s) *) (type structure1) (type structure2) (type signature1) (type signature2) (type toplevel_phrase1) (type toplevel_phrase2) (type core_type1) (type core_type2) (type expression1) (type expression2) (type pattern1) (type pattern2) (type case1) (type case2) (type type_declaration1) (type type_declaration2) (type type_extension1) (type type_extension2) (type extension_constructor1) (type extension_constructor2) (type out_value1) (type out_value2) (type out_type1) (type out_type2) (type out_class_type1) (type out_class_type2) (type out_module_type1) (type out_module_type2) (type out_sig_item1) (type out_sig_item2) (type out_type_extension1) (type out_type_extension2) (type out_phrase1) (type out_phrase2) (type mapper1) (type mapper2) (*$*) ((module A) : < (*$ foreach_type (fun _ s -> printf "%-21s : %s1;\n" s s) *) structure : structure1; signature : signature1; toplevel_phrase : toplevel_phrase1; core_type : core_type1; expression : expression1; pattern : pattern1; case : case1; type_declaration : type_declaration1; type_extension : type_extension1; extension_constructor : extension_constructor1; out_value : out_value1; out_type : out_type1; out_class_type : out_class_type1; out_module_type : out_module_type1; out_sig_item : out_sig_item1; out_type_extension : out_type_extension1; out_phrase : out_phrase1; mapper : mapper1; (*$*) > ocaml_version) ((module B) : < (*$ foreach_type (fun _ s -> printf "%-21s : %s2;\n" s s) *) structure : structure2; signature : signature2; toplevel_phrase : toplevel_phrase2; core_type : core_type2; expression : expression2; pattern : pattern2; case : case2; type_declaration : type_declaration2; type_extension : type_extension2; extension_constructor : extension_constructor2; out_value : out_value2; out_type : out_type2; out_class_type : out_class_type2; out_module_type : out_module_type2; out_sig_item : out_sig_item2; out_type_extension : out_type_extension2; out_phrase : out_phrase2; mapper : mapper2; (*$*) > ocaml_version) : (A.types, B.types) migration_functions = match A.Version with | B.Version -> migration_identity | _ -> let direction = if A.version < B.version then `Next else `Previous in let rec migrate (m : A.types immediate_migration) : (A.types, B.types) migration_functions = match m with | No_migration -> assert false | Immediate_migration (f, (module To)) -> match To.Version with | B.Version -> f | _ -> match immediate_migration (module To) direction with | No_migration -> assert false | Immediate_migration (g, to2) -> migrate (Immediate_migration (migration_compose f g, to2)) in migrate (immediate_migration (module A) direction) module Convert (A : OCaml_version) (B : OCaml_version) = struct let { (*$ foreach_type (fun _ s -> printf "copy_%s;\n" s) *) copy_structure; copy_signature; copy_toplevel_phrase; copy_core_type; copy_expression; copy_pattern; copy_case; copy_type_declaration; copy_type_extension; copy_extension_constructor; copy_out_value; copy_out_type; copy_out_class_type; copy_out_module_type; copy_out_sig_item; copy_out_type_extension; copy_out_phrase; copy_mapper; (*$*) } : (A.types, B.types) migration_functions = migrate (module A) (module B) end (*$ foreach_version (fun suffix version -> printf "module OCaml_%s = struct\n" suffix; printf " module Ast = Ast_%s\n" suffix; printf " include Make_witness(Ast_%s)\n" suffix; printf " let version = %s\n" suffix; printf " let string_version = %S\n" version; printf "end\n"; printf "let ocaml_%s : OCaml_%s.types ocaml_version = (module OCaml_%s)\n" suffix suffix suffix; ) *) module OCaml_402 = struct module Ast = Ast_402 include Make_witness(Ast_402) let version = 402 let string_version = "4.02" end let ocaml_402 : OCaml_402.types ocaml_version = (module OCaml_402) module OCaml_403 = struct module Ast = Ast_403 include Make_witness(Ast_403) let version = 403 let string_version = "4.03" end let ocaml_403 : OCaml_403.types ocaml_version = (module OCaml_403) module OCaml_404 = struct module Ast = Ast_404 include Make_witness(Ast_404) let version = 404 let string_version = "4.04" end let ocaml_404 : OCaml_404.types ocaml_version = (module OCaml_404) module OCaml_405 = struct module Ast = Ast_405 include Make_witness(Ast_405) let version = 405 let string_version = "4.05" end let ocaml_405 : OCaml_405.types ocaml_version = (module OCaml_405) module OCaml_406 = struct module Ast = Ast_406 include Make_witness(Ast_406) let version = 406 let string_version = "4.06" end let ocaml_406 : OCaml_406.types ocaml_version = (module OCaml_406) module OCaml_407 = struct module Ast = Ast_407 include Make_witness(Ast_407) let version = 407 let string_version = "4.07" end let ocaml_407 : OCaml_407.types ocaml_version = (module OCaml_407) module OCaml_408 = struct module Ast = Ast_408 include Make_witness(Ast_408) let version = 408 let string_version = "4.08" end let ocaml_408 : OCaml_408.types ocaml_version = (module OCaml_408) module OCaml_409 = struct module Ast = Ast_409 include Make_witness(Ast_409) let version = 409 let string_version = "4.09" end let ocaml_409 : OCaml_409.types ocaml_version = (module OCaml_409) module OCaml_410 = struct module Ast = Ast_410 include Make_witness(Ast_410) let version = 410 let string_version = "4.10" end let ocaml_410 : OCaml_410.types ocaml_version = (module OCaml_410) (*$*) let all_versions : (module OCaml_version) list = [ (*$foreach_version (fun suffix _ -> printf "(module OCaml_%s : OCaml_version);\n" suffix)*) (module OCaml_402 : OCaml_version); (module OCaml_403 : OCaml_version); (module OCaml_404 : OCaml_version); (module OCaml_405 : OCaml_version); (module OCaml_406 : OCaml_version); (module OCaml_407 : OCaml_version); (module OCaml_408 : OCaml_version); (module OCaml_409 : OCaml_version); (module OCaml_410 : OCaml_version); (*$*) ] (*$foreach_version_pair (fun a b -> printf "include Register_migration(OCaml_%s)(OCaml_%s)\n" a b; printf " (Migrate_parsetree_%s_%s)(Migrate_parsetree_%s_%s)\n" a b b a ) *) include Register_migration(OCaml_402)(OCaml_403) (Migrate_parsetree_402_403)(Migrate_parsetree_403_402) include Register_migration(OCaml_403)(OCaml_404) (Migrate_parsetree_403_404)(Migrate_parsetree_404_403) include Register_migration(OCaml_404)(OCaml_405) (Migrate_parsetree_404_405)(Migrate_parsetree_405_404) include Register_migration(OCaml_405)(OCaml_406) (Migrate_parsetree_405_406)(Migrate_parsetree_406_405) include Register_migration(OCaml_406)(OCaml_407) (Migrate_parsetree_406_407)(Migrate_parsetree_407_406) include Register_migration(OCaml_407)(OCaml_408) (Migrate_parsetree_407_408)(Migrate_parsetree_408_407) include Register_migration(OCaml_408)(OCaml_409) (Migrate_parsetree_408_409)(Migrate_parsetree_409_408) include Register_migration(OCaml_409)(OCaml_410) (Migrate_parsetree_409_410)(Migrate_parsetree_410_409) (*$*) module OCaml_current = OCaml_OCAML_VERSION let ocaml_current : OCaml_current.types ocaml_version = (module OCaml_current) (* Make sure the preprocessing worked as expected *) let _f (x : Parsetree.expression) : OCaml_current.Ast.Parsetree.expression = x ocaml-migrate-parsetree-1.5.0/src/migrate_parsetree_versions.mli000066400000000000000000000341351356450464700251760ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml Migrate Parsetree *) (* *) (* Frédéric Bour *) (* Jérémie Dimino, Jane Street Europe *) (* *) (* Copyright 2017 Institut National de Recherche en Informatique et *) (* en Automatique (INRIA). *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (*$ #use "src/cinaps_helpers" $*) (** {1 Abstracting an OCaml frontend} *) (** Abstract view of a version of an OCaml Ast *) module type Ast = sig (*$ foreach_module (fun m types -> printf "module %s : sig\n" m; List.iter types ~f:(printf "type %s\n"); printf "end\n" ) *) module Parsetree : sig type structure type signature type toplevel_phrase type core_type type expression type pattern type case type type_declaration type type_extension type extension_constructor end module Outcometree : sig type out_value type out_type type out_class_type type out_module_type type out_sig_item type out_type_extension type out_phrase end module Ast_mapper : sig type mapper end (*$*) module Config : sig val ast_impl_magic_number : string val ast_intf_magic_number : string end val shallow_identity : Ast_mapper.mapper val map_signature : Ast_mapper.mapper -> Parsetree.signature -> Parsetree.signature val map_structure : Ast_mapper.mapper -> Parsetree.structure -> Parsetree.structure val make_top_mapper : signature:(Parsetree.signature -> Parsetree.signature) -> structure:(Parsetree.structure -> Parsetree.structure) -> Ast_mapper.mapper end (* Shortcuts for talking about ast types outside of the module language *) type 'a _types = 'a constraint 'a = < (*$ foreach_type (fun _ s -> printf "%-21s : _;\n" s) *) structure : _; signature : _; toplevel_phrase : _; core_type : _; expression : _; pattern : _; case : _; type_declaration : _; type_extension : _; extension_constructor : _; out_value : _; out_type : _; out_class_type : _; out_module_type : _; out_sig_item : _; out_type_extension : _; out_phrase : _; mapper : _; (*$*) > ;; (*$ foreach_type (fun _ s -> printf "type 'a get_%s = 'x constraint 'a _types = < %s : 'x; .. >\n" s s ); printf ";;\n" *) type 'a get_structure = 'x constraint 'a _types = < structure : 'x; .. > type 'a get_signature = 'x constraint 'a _types = < signature : 'x; .. > type 'a get_toplevel_phrase = 'x constraint 'a _types = < toplevel_phrase : 'x; .. > type 'a get_core_type = 'x constraint 'a _types = < core_type : 'x; .. > type 'a get_expression = 'x constraint 'a _types = < expression : 'x; .. > type 'a get_pattern = 'x constraint 'a _types = < pattern : 'x; .. > type 'a get_case = 'x constraint 'a _types = < case : 'x; .. > type 'a get_type_declaration = 'x constraint 'a _types = < type_declaration : 'x; .. > type 'a get_type_extension = 'x constraint 'a _types = < type_extension : 'x; .. > type 'a get_extension_constructor = 'x constraint 'a _types = < extension_constructor : 'x; .. > type 'a get_out_value = 'x constraint 'a _types = < out_value : 'x; .. > type 'a get_out_type = 'x constraint 'a _types = < out_type : 'x; .. > type 'a get_out_class_type = 'x constraint 'a _types = < out_class_type : 'x; .. > type 'a get_out_module_type = 'x constraint 'a _types = < out_module_type : 'x; .. > type 'a get_out_sig_item = 'x constraint 'a _types = < out_sig_item : 'x; .. > type 'a get_out_type_extension = 'x constraint 'a _types = < out_type_extension : 'x; .. > type 'a get_out_phrase = 'x constraint 'a _types = < out_phrase : 'x; .. > type 'a get_mapper = 'x constraint 'a _types = < mapper : 'x; .. > ;; (*$*) (** A version of the OCaml frontend packs the ast with type witnesses so that equalities can be recovered dynamically. *) type _ witnesses (*IF_AT_LEAST 406 = private ..*) (** [migration_info] is an opaque type that is used to generate migration functions. *) type _ migration_info (** An OCaml frontend versions an Ast, version number and some witnesses for conversion. *) module type OCaml_version = sig (** Ast definition for this version *) module Ast : Ast (* Version number as an integer, 402, 403, 404, ... *) val version : int (* Version number as a user-friendly string *) val string_version : string (* 4.02, 4.03, 4.04, ... *) (** Shortcut for talking about Ast types *) type types = < (*$ foreach_type (fun m s -> printf "%-21s : Ast.%s.%s;\n" s m s) *) structure : Ast.Parsetree.structure; signature : Ast.Parsetree.signature; toplevel_phrase : Ast.Parsetree.toplevel_phrase; core_type : Ast.Parsetree.core_type; expression : Ast.Parsetree.expression; pattern : Ast.Parsetree.pattern; case : Ast.Parsetree.case; type_declaration : Ast.Parsetree.type_declaration; type_extension : Ast.Parsetree.type_extension; extension_constructor : Ast.Parsetree.extension_constructor; out_value : Ast.Outcometree.out_value; out_type : Ast.Outcometree.out_type; out_class_type : Ast.Outcometree.out_class_type; out_module_type : Ast.Outcometree.out_module_type; out_sig_item : Ast.Outcometree.out_sig_item; out_type_extension : Ast.Outcometree.out_type_extension; out_phrase : Ast.Outcometree.out_phrase; mapper : Ast.Ast_mapper.mapper; (*$*) > _types (** A construtor for recovering type equalities between two arbitrary versions. *) type _ witnesses += Version : types witnesses (** Information used to derive migration functions, see below *) val migration_info : types migration_info end (** Representing an ocaml version in type language *) type 'types ocaml_version = (module OCaml_version (*$ let sep = with_then_and () in foreach_type (fun m s -> printf "%t type Ast.%s.%s = 'types get_%s\n" sep m s s) *) with type Ast.Parsetree.structure = 'types get_structure and type Ast.Parsetree.signature = 'types get_signature and type Ast.Parsetree.toplevel_phrase = 'types get_toplevel_phrase and type Ast.Parsetree.core_type = 'types get_core_type and type Ast.Parsetree.expression = 'types get_expression and type Ast.Parsetree.pattern = 'types get_pattern and type Ast.Parsetree.case = 'types get_case and type Ast.Parsetree.type_declaration = 'types get_type_declaration and type Ast.Parsetree.type_extension = 'types get_type_extension and type Ast.Parsetree.extension_constructor = 'types get_extension_constructor and type Ast.Outcometree.out_value = 'types get_out_value and type Ast.Outcometree.out_type = 'types get_out_type and type Ast.Outcometree.out_class_type = 'types get_out_class_type and type Ast.Outcometree.out_module_type = 'types get_out_module_type and type Ast.Outcometree.out_sig_item = 'types get_out_sig_item and type Ast.Outcometree.out_type_extension = 'types get_out_type_extension and type Ast.Outcometree.out_phrase = 'types get_out_phrase and type Ast.Ast_mapper.mapper = 'types get_mapper (*$*) ) (** {1 Concrete frontend instances} *) (*$foreach_version (fun suffix _ -> printf "module OCaml_%s : OCaml_version with module Ast = Ast_%s\n" suffix suffix; printf "val ocaml_%s : OCaml_%s.types ocaml_version\n" suffix suffix; )*) module OCaml_402 : OCaml_version with module Ast = Ast_402 val ocaml_402 : OCaml_402.types ocaml_version module OCaml_403 : OCaml_version with module Ast = Ast_403 val ocaml_403 : OCaml_403.types ocaml_version module OCaml_404 : OCaml_version with module Ast = Ast_404 val ocaml_404 : OCaml_404.types ocaml_version module OCaml_405 : OCaml_version with module Ast = Ast_405 val ocaml_405 : OCaml_405.types ocaml_version module OCaml_406 : OCaml_version with module Ast = Ast_406 val ocaml_406 : OCaml_406.types ocaml_version module OCaml_407 : OCaml_version with module Ast = Ast_407 val ocaml_407 : OCaml_407.types ocaml_version module OCaml_408 : OCaml_version with module Ast = Ast_408 val ocaml_408 : OCaml_408.types ocaml_version module OCaml_409 : OCaml_version with module Ast = Ast_409 val ocaml_409 : OCaml_409.types ocaml_version module OCaml_410 : OCaml_version with module Ast = Ast_410 val ocaml_410 : OCaml_410.types ocaml_version (*$*) (* An alias to the current compiler version *) module OCaml_current = OCaml_OCAML_VERSION val ocaml_current : OCaml_current.types ocaml_version val all_versions : (module OCaml_version) list (** {1 Migrating between different versions} *) type ('a, 'b) type_comparison = | Lt : ('a, 'b) type_comparison | Eq : ('a, 'a) type_comparison | Gt : ('a, 'b) type_comparison val compare_ocaml_version : 'a ocaml_version -> 'b ocaml_version -> ('a, 'b) type_comparison (** A record for migrating each AST construct between two known versions *) type ('from, 'to_) migration_functions = { (*$ foreach_type (fun _ s -> printf "copy_%s: 'from get_%s -> 'to_ get_%s;\n" s s s) *) copy_structure: 'from get_structure -> 'to_ get_structure; copy_signature: 'from get_signature -> 'to_ get_signature; copy_toplevel_phrase: 'from get_toplevel_phrase -> 'to_ get_toplevel_phrase; copy_core_type: 'from get_core_type -> 'to_ get_core_type; copy_expression: 'from get_expression -> 'to_ get_expression; copy_pattern: 'from get_pattern -> 'to_ get_pattern; copy_case: 'from get_case -> 'to_ get_case; copy_type_declaration: 'from get_type_declaration -> 'to_ get_type_declaration; copy_type_extension: 'from get_type_extension -> 'to_ get_type_extension; copy_extension_constructor: 'from get_extension_constructor -> 'to_ get_extension_constructor; copy_out_value: 'from get_out_value -> 'to_ get_out_value; copy_out_type: 'from get_out_type -> 'to_ get_out_type; copy_out_class_type: 'from get_out_class_type -> 'to_ get_out_class_type; copy_out_module_type: 'from get_out_module_type -> 'to_ get_out_module_type; copy_out_sig_item: 'from get_out_sig_item -> 'to_ get_out_sig_item; copy_out_type_extension: 'from get_out_type_extension -> 'to_ get_out_type_extension; copy_out_phrase: 'from get_out_phrase -> 'to_ get_out_phrase; copy_mapper: 'from get_mapper -> 'to_ get_mapper; (*$*) } (** Migrating to the same version is no-op *) val migration_identity : ('a, 'a) migration_functions (** Migrations can be composed *) val migration_compose : ('a, 'b) migration_functions -> ('b, 'c) migration_functions -> ('a, 'c) migration_functions (** Represent the next or previous version of an Ast *) type 'from immediate_migration = | No_migration : 'from immediate_migration (** Cannot migrate earliest or latest supported version *) | Immediate_migration : ('from, 'to_) migration_functions * 'to_ ocaml_version -> 'from immediate_migration (** Pack the migration functions and the new version *) val immediate_migration : 'types ocaml_version -> [< `Next | `Previous ] -> 'types immediate_migration val migrate : 'from ocaml_version -> 'to_ ocaml_version -> ('from, 'to_) migration_functions (** {1 Convenience definitions} *) (** Module level migration *) module Convert (A : OCaml_version) (B : OCaml_version) : sig (*$ foreach_type (fun m s -> let fq = sprintf "%s.%s" m s in printf " val copy_%-21s : A.Ast.%-31s -> B.Ast.%s\n" s fq fq) *) val copy_structure : A.Ast.Parsetree.structure -> B.Ast.Parsetree.structure val copy_signature : A.Ast.Parsetree.signature -> B.Ast.Parsetree.signature val copy_toplevel_phrase : A.Ast.Parsetree.toplevel_phrase -> B.Ast.Parsetree.toplevel_phrase val copy_core_type : A.Ast.Parsetree.core_type -> B.Ast.Parsetree.core_type val copy_expression : A.Ast.Parsetree.expression -> B.Ast.Parsetree.expression val copy_pattern : A.Ast.Parsetree.pattern -> B.Ast.Parsetree.pattern val copy_case : A.Ast.Parsetree.case -> B.Ast.Parsetree.case val copy_type_declaration : A.Ast.Parsetree.type_declaration -> B.Ast.Parsetree.type_declaration val copy_type_extension : A.Ast.Parsetree.type_extension -> B.Ast.Parsetree.type_extension val copy_extension_constructor : A.Ast.Parsetree.extension_constructor -> B.Ast.Parsetree.extension_constructor val copy_out_value : A.Ast.Outcometree.out_value -> B.Ast.Outcometree.out_value val copy_out_type : A.Ast.Outcometree.out_type -> B.Ast.Outcometree.out_type val copy_out_class_type : A.Ast.Outcometree.out_class_type -> B.Ast.Outcometree.out_class_type val copy_out_module_type : A.Ast.Outcometree.out_module_type -> B.Ast.Outcometree.out_module_type val copy_out_sig_item : A.Ast.Outcometree.out_sig_item -> B.Ast.Outcometree.out_sig_item val copy_out_type_extension : A.Ast.Outcometree.out_type_extension -> B.Ast.Outcometree.out_type_extension val copy_out_phrase : A.Ast.Outcometree.out_phrase -> B.Ast.Outcometree.out_phrase val copy_mapper : A.Ast.Ast_mapper.mapper -> B.Ast.Ast_mapper.mapper (*$*) end ocaml-migrate-parsetree-1.5.0/src/stdlib0.ml000066400000000000000000000002431356450464700207250ustar00rootroot00000000000000module Int = struct let to_string = string_of_int end module Option = struct let map f o = match o with | None -> None | Some v -> Some (f v) end ocaml-migrate-parsetree-1.5.0/test/000077500000000000000000000000001356450464700172235ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/000077500000000000000000000000001356450464700205165ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/manual/000077500000000000000000000000001356450464700217735ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/manual/dune000066400000000000000000000005161356450464700226530ustar00rootroot00000000000000(executable (name driver) (libraries ocaml-migrate-parsetree) (link_flags -linkall)) (rule (with-stdout-to driver.ml (echo "Migrate_parsetree.Driver.run_main ()"))) (rule (with-stdout-to file.blah (echo "let x = 42"))) (alias (name runtest) (action (ignore-stdout (run ./driver.exe --impl %{dep:file.blah})))) ocaml-migrate-parsetree-1.5.0/test/driver/null/000077500000000000000000000000001356450464700214705ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/null/dune000066400000000000000000000004551356450464700223520ustar00rootroot00000000000000(executable (name ppx) (flags :standard -linkall) (libraries ppx1 ppx2)) (rule (with-stdout-to null.output (run ./ppx.exe --null))) (rule (with-stdout-to null.expected (echo ""))) (alias (name runtest) (deps null.expected null.output) (action (run diff -u null.expected null.output))) ocaml-migrate-parsetree-1.5.0/test/driver/null/ppx.ml000066400000000000000000000000561356450464700226320ustar00rootroot00000000000000let () = Migrate_parsetree.Driver.run_main () ocaml-migrate-parsetree-1.5.0/test/driver/ppx-user/000077500000000000000000000000001356450464700223015ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/ppx-user/dune000066400000000000000000000004671356450464700231660ustar00rootroot00000000000000(executable (name foo) (preprocess (pps ppx1 ppx2 -- -message "Hello, world!" --cookie "plop=\"Chocolate\""))) (rule (with-stdout-to foo.output (run ./foo.exe))) (alias (name runtest) (deps foo.expected foo.output) (action (run diff -u foo.expected foo.output))) ocaml-migrate-parsetree-1.5.0/test/driver/ppx-user/foo.expected000066400000000000000000000000331356450464700246030ustar00rootroot0000000000000042 Hello, world! Chocolate ocaml-migrate-parsetree-1.5.0/test/driver/ppx-user/foo.ml000066400000000000000000000001211356450464700234100ustar00rootroot00000000000000let () = Printf.printf "%d\n%s\n%s\n" [%forty_two] [%cmd_line_arg] [%plop] ocaml-migrate-parsetree-1.5.0/test/driver/ppx1/000077500000000000000000000000001356450464700214065ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/ppx1/dune000066400000000000000000000001211356450464700222560ustar00rootroot00000000000000(library (name ppx1) (kind ppx_rewriter) (libraries ocaml-migrate-parsetree)) ocaml-migrate-parsetree-1.5.0/test/driver/ppx1/ppx1.ml000066400000000000000000000007411356450464700226320ustar00rootroot00000000000000(* Rewrite [%fourty_two] as 42 *) open Migrate_parsetree open OCaml_403.Ast open Parsetree let rewriter _config _cookies = let super = Ast_mapper.default_mapper in let expr self e = match e.pexp_desc with | Pexp_extension ({ txt = "forty_two"; _ }, PStr []) -> { e with pexp_desc = Pexp_constant (Pconst_integer ("42", None)) } | _ -> super.expr self e in { super with expr } let () = Driver.register ~name:"ppx1" (module OCaml_403) rewriter ocaml-migrate-parsetree-1.5.0/test/driver/ppx2/000077500000000000000000000000001356450464700214075ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/test/driver/ppx2/dune000066400000000000000000000001211356450464700222570ustar00rootroot00000000000000(library (name ppx2) (kind ppx_rewriter) (libraries ocaml-migrate-parsetree)) ocaml-migrate-parsetree-1.5.0/test/driver/ppx2/ppx2.ml000066400000000000000000000016031356450464700226320ustar00rootroot00000000000000(* Rewrite [%fourty_two] as 42 *) open Migrate_parsetree open OCaml_403.Ast open Parsetree let cmd_line_arg = ref "unset" let get_plop cookies ~loc = match Driver.get_cookie cookies "plop" (module OCaml_403) with | Some e -> e | None -> let open Ast_helper in Exp.constant ~loc (Const.string "unset") let rewriter _config cookies = let super = Ast_mapper.default_mapper in let expr self e = match e.pexp_desc with | Pexp_extension ({ txt = "cmd_line_arg"; _ }, PStr []) -> { e with pexp_desc = Pexp_constant (Pconst_string (!cmd_line_arg, None)) } | Pexp_extension ({ txt = "plop"; _ }, PStr []) -> get_plop cookies ~loc:e.pexp_loc | _ -> super.expr self e in { super with expr } let () = Driver.register ~name:"ppx2" ~args:[("-message", Arg.Set_string cmd_line_arg, "MSG Set [%cmd_line_arg] to MSG")] (module OCaml_403) rewriter ocaml-migrate-parsetree-1.5.0/tools/000077500000000000000000000000001356450464700174045ustar00rootroot00000000000000ocaml-migrate-parsetree-1.5.0/tools/add_special_comments.ml000066400000000000000000000041711356450464700240760ustar00rootroot00000000000000(* Add (*IF_CURRENT:= Parsetree.expression *) comments to type definitions. *) open StdLabels open Parsetree [@@@warning "-40"] let read_file fn = let ic = open_in_bin fn in let len = in_channel_length ic in let s = really_input_string ic len in close_in ic; s let collect_insertions structure = let insertions = ref [] in let add_after ~(loc:Location.t) txt = insertions := (loc.loc_end.pos_cnum, txt) :: !insertions in List.iter structure ~f:(fun item -> match item.pstr_desc with | Pstr_module { pmb_name = module_name ; pmb_expr = { pmod_desc = Pmod_structure items; _ } ; _ } -> List.iter items ~f:(fun item -> match item.pstr_desc with | Pstr_type (_, tds) -> List.iter tds ~f:(fun td -> match td.ptype_manifest with | Some _ -> () | None -> let name = td.ptype_name in let params = let to_string (ty, _) = Format.asprintf "%a" Pprintast.core_type ty in match td.ptype_params with | [] -> "" | [param] -> to_string param ^ " " | l -> Printf.sprintf "(%s) " (String.concat ~sep:", " (List.map l ~f:to_string)) in Printf.ksprintf (add_after ~loc:name.loc) " (*IF_CURRENT = %s%s.%s *)" params (Option.value module_name.txt ~default:"X") name.txt) | _ -> ()) | _ -> ()); List.sort !insertions ~cmp:(fun (a, _) (b, _) -> compare a b) let () = let fn = Sys.argv.(1) in let file_contents = read_file fn in let lb = Lexing.from_string file_contents in Location.init lb fn; let ast = Parse.implementation lb in let insertions = collect_insertions ast in let oc = open_out_bin fn in let pos = List.fold_left insertions ~init:0 ~f:(fun cur_pos (pos, txt) -> output_substring oc file_contents cur_pos (pos - cur_pos); output_string oc txt; pos) in output_substring oc file_contents pos (String.length file_contents - pos); close_out oc ocaml-migrate-parsetree-1.5.0/tools/add_special_comments.mli000066400000000000000000000000141356450464700242370ustar00rootroot00000000000000(* empty *) ocaml-migrate-parsetree-1.5.0/tools/dune000066400000000000000000000002071356450464700202610ustar00rootroot00000000000000(executables (names add_special_comments pp gencopy) (libraries compiler-libs.common compiler-libs.bytecomp)) (ocamllex pp_rewrite) ocaml-migrate-parsetree-1.5.0/tools/gencopy.ml000077500000000000000000000254371356450464700214200ustar00rootroot00000000000000(* This file is part of the ppx_tools package. It is released *) (* under the terms of the MIT license (see LICENSE file). *) (* Copyright 2013 Alain Frisch and LexiFi *) (* This file has been modified/specialized for ocaml-migrate-parsetree *) (* Generate code to perform a deep copy of a type into another identical type (in another module). Used to generate a first version of migration code between two versions of the same type, to be then patched manually to perform actual migration. *) let drop_prefix ~prefix s = let plen = String.length prefix in if plen > String.length s then None else try for i = 0 to String.length prefix - 1 do if not (Char.equal s.[i] prefix.[i]) then raise Exit done; Some (String.sub s plen (String.length s - plen)) with Exit -> None let rec find_map f = function | [] -> None | x :: xs -> ( match f x with None -> find_map f xs | Some x -> Some x ) module Main : sig end = struct open Types open Asttypes open Location open Ast_helper module Label = struct type t = Asttypes.arg_label type desc = Asttypes.arg_label = | Nolabel | Labelled of string | Optional of string let nolabel : t = Nolabel end let may_tuple ?loc tup = function | [] -> None | [ x ] -> Some x | l -> Some (tup ?loc ?attrs:None l) let lid ?(loc = !default_loc) s = mkloc (Longident.parse s) loc let constr ?loc ?attrs s args = Exp.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Exp.tuple args) let unit ?loc ?attrs () = constr ?loc ?attrs "()" [] let tuple ?loc ?attrs = function | [] -> unit ?loc ?attrs () | [ x ] -> x | xs -> Exp.tuple ?loc ?attrs xs let app ?loc ?attrs f l = if l = [] then f else Exp.apply ?loc ?attrs f (List.map (fun a -> (Label.nolabel, a)) l) let evar ?loc ?attrs s = Exp.ident ?loc ?attrs (lid ?loc s) let let_in ?loc ?attrs ?(recursive = false) b body = Exp.let_ ?loc ?attrs (if recursive then Recursive else Nonrecursive) b body let func ?loc ?attrs l = Exp.function_ ?loc ?attrs (List.map (fun (p, e) -> Exp.case p e) l) let lam ?loc ?attrs ?(label = Label.nolabel) ?default pat exp = Exp.fun_ ?loc ?attrs label default pat exp let pvar ?(loc = !default_loc) ?attrs s = Pat.var ~loc ?attrs (mkloc s loc) let pconstr ?loc ?attrs s args = Pat.construct ?loc ?attrs (lid ?loc s) (may_tuple ?loc Pat.tuple args) let selfcall m args = app (evar m) args (*************************************************************************) let env = Env.initial_safe_string let module_mapping = ref [] let rec clean = function | [ "Location"; "t" ] -> [ "location" ] | [] -> [] | [ x ] -> [ x ] | [ _; "t" ] as x -> x | _ :: xs -> clean xs let print_fun s = let lid = Longident.parse s in let s = Longident.flatten lid |> clean in String.concat "_" ("copy" :: s) let printed = Hashtbl.create 16 let meths = ref [] let rec gen ty = if Hashtbl.mem printed ty then () else let tylid = Longident.parse ty in let td = try snd (Env.lookup_type tylid env ~loc:Location.none) with Not_found -> Format.eprintf "** Cannot resolve type %s@." ty; exit 2 in let prefix, local = let open Longident in match tylid with | Ldot (m, s) -> (String.concat "." (Longident.flatten m) ^ ".", s) | Lident s -> ("", s) | Lapply _ -> assert false in let target_prefix = match find_map (fun (v1, v2) -> match drop_prefix ~prefix:v1 prefix with | None -> None | Some suffix -> Some (v2 ^ suffix) ) !module_mapping with | Some x -> x | None -> prefix in let funname = print_fun ty in Hashtbl.add printed ty (); let params_in = List.mapi (fun i _ -> mkloc (Printf.sprintf "f%i" i) !default_loc) td.type_params in let params_out = List.mapi (fun i _ -> mkloc (Printf.sprintf "g%i" i) !default_loc) td.type_params in let env = List.map2 (fun s t -> (t.id, evar s.txt)) params_in td.type_params in let make_result_t tyargs_in tyargs_out = Typ.( arrow Asttypes.Nolabel (constr (lid (prefix ^ local)) tyargs_in) (constr (lid (target_prefix ^ local)) tyargs_out)) in let make_t tyargs_in tyargs_out = List.fold_right2 (fun arg_in arg_out t -> Typ.( arrow Asttypes.Nolabel (arrow Asttypes.Nolabel arg_in arg_out) t) ) tyargs_in tyargs_out (make_result_t tyargs_in tyargs_out) in let tyargs_in = List.map (fun t -> Typ.var t.txt) params_in in let tyargs_out = List.map (fun t -> Typ.var t.txt) params_out in let t = Typ.poly (params_in @ params_out) (make_t tyargs_in tyargs_out) in let concrete e = let e = List.fold_right (fun x e -> lam x e) (List.map (fun x -> pvar x.txt) params_in) e in meths := Vb.mk (Pat.constraint_ (pvar funname) t) e :: !meths in let field ld = let s = Ident.name ld.ld_id in ( (lid (prefix ^ s), pvar s), (lid (target_prefix ^ s), tyexpr env ld.ld_type (evar s)) ) in match (td.type_kind, td.type_manifest) with | Type_record (l, _), _ -> let l = List.map field l in concrete (lam (Pat.record (List.map fst l) Closed) (Exp.record (List.map snd l) None)) | Type_variant l, _ -> let case cd = let c = Ident.name cd.cd_id in match cd.cd_args with | Cstr_tuple tys -> let p, args = gentuple env tys in (pconstr (prefix ^ c) p, constr (target_prefix ^ c) args) | Cstr_record _l -> failwith "Inline records are not yet supported." in concrete (func (List.map case l)) | Type_abstract, Some t -> concrete (tyexpr_fun env t) | Type_abstract, None -> failwith ("Abstract type " ^ ty) | Type_open, _ -> Format.eprintf "** Open types are not yet supported %s@." ty; () and gentuple env tl = let arg i t = let x = Printf.sprintf "x%i" i in (pvar x, tyexpr env t (evar x)) in List.split (List.mapi arg tl) and tyexpr env ty x = match ty.desc with | Tvar _ -> ( match List.assoc ty.id env with | f -> app f [ x ] | exception Not_found -> failwith "Existentials not supported" ) | Ttuple tl -> let p, e = gentuple env tl in let_in [ Vb.mk (Pat.tuple p) x ] (tuple e) | Tconstr (path, [ t ], _) when Path.same path Predef.path_list -> app (evar "List.map") [ tyexpr_fun env t; x ] | Tconstr (path, [ t ], _) when Path.same path Predef.path_array -> app (evar "Array.map") [ tyexpr_fun env t; x ] | Tconstr (path, [ t ], _) when Path.same path Predef.path_option -> app (evar "Option.map") [ tyexpr_fun env t; x ] | Tconstr (path, [], _) when Path.same path Predef.path_string || Path.same path Predef.path_bytes || Path.same path Predef.path_bool || Path.same path Predef.path_unit || Path.same path Predef.path_exn || Path.same path Predef.path_int || Path.same path Predef.path_char || Path.same path Predef.path_int32 || Path.same path Predef.path_int64 || Path.same path Predef.path_nativeint || Path.same path Predef.path_float || Path.same path Predef.path_extension_constructor -> x | Tconstr (path, tl, _) -> let ty = Path.name path in gen ty; selfcall (print_fun ty) (List.map (tyexpr_fun env) tl @ [ x ]) | _ -> Format.eprintf "** Cannot deal with type %a@." Printtyp.type_expr ty; x and tyexpr_fun env ty = lam (pvar "x") (tyexpr env ty (evar "x")) let simplify = (* (fun x -> x) ====> *) let open Ast_mapper in let super = default_mapper in let expr this e = let e = super.expr this e in let open Longident in let open Parsetree in match e.pexp_desc with | Pexp_fun ( Asttypes.Nolabel, None, { ppat_desc = Ppat_var { txt = id; _ }; _ }, { pexp_desc = Pexp_apply ( f, [ ( Asttypes.Nolabel, { pexp_desc = Pexp_ident { txt = Lident id2; _ }; _ } ) ] ) ; _ } ) when id = id2 -> f | _ -> e in let value_binding this (vb : Parsetree.value_binding) = let pvb_pat = this.pat this vb.pvb_pat in let pvb_expr = super.expr this vb.pvb_expr in let pvb_attributes = this.attributes this vb.pvb_attributes in let pvb_loc = this.location this vb.pvb_loc in { Parsetree.pvb_loc; pvb_attributes; pvb_expr; pvb_pat } in { super with expr; value_binding } let add_mapping s = let i = try String.index s ':' with Not_found -> failwith (Printf.sprintf "Cannot parse mapping %S" s) in module_mapping := ( String.sub s 0 i ^ ".", String.sub s (i + 1) (String.length s - i - 1) ^ "." ) :: !module_mapping let args = let open Arg in [ ( "-I", String (fun s -> Load_path.add_dir (Misc.expand_directory Config.standard_library s) ), " Add to the list of include directories" ); ( "-map", String add_mapping, "Old_module:New_module Map types from Old_module to types in \ New_module" ) ] let usage = Printf.sprintf "%s [options] \n" Sys.argv.(0) let main () = Load_path.init [ Config.standard_library ]; Arg.parse (Arg.align args) gen usage; let from_, to_ = match !module_mapping with | [ (from_, to_) ] -> ( String.sub from_ 0 (String.length from_ - 1), String.sub to_ 0 (String.length to_ - 1) ) | _ -> failwith "expect one and only one '-map' argument" in let s = [ Str.module_ (Mb.mk (mkloc (Some "From") Location.none) (Mod.ident (mkloc (Longident.parse from_) Location.none))); Str.module_ (Mb.mk (mkloc (Some "To") Location.none) (Mod.ident (mkloc (Longident.parse to_) Location.none))); Str.value Recursive !meths ] in Format.printf "%a@." Pprintast.structure (simplify.Ast_mapper.structure simplify s) let () = try main () with exn -> Format.eprintf "%a@?" Errors.report_error exn; exit 1 end ocaml-migrate-parsetree-1.5.0/tools/pp.ml000066400000000000000000000006361356450464700203620ustar00rootroot00000000000000let () = match Sys.argv with | [|_; ocaml_version; fname|] -> let is_current = (Filename.basename fname = Printf.sprintf "ast_%s.ml" ocaml_version) in let ic = open_in_bin fname in Printf.printf "# 1 %S\n" fname; Pp_rewrite.rewrite is_current ocaml_version (Lexing.from_channel ic) | _ -> Printf.eprintf "%s: \n" Sys.executable_name; exit 2 ocaml-migrate-parsetree-1.5.0/tools/pp.mli000066400000000000000000000000141356450464700205210ustar00rootroot00000000000000(* empty *) ocaml-migrate-parsetree-1.5.0/tools/pp_rewrite.mli000066400000000000000000000000661356450464700222710ustar00rootroot00000000000000val rewrite : bool -> string -> Lexing.lexbuf -> unit ocaml-migrate-parsetree-1.5.0/tools/pp_rewrite.mll000066400000000000000000000025441356450464700222770ustar00rootroot00000000000000{ open Printf let print_ocaml_version version = let patt_len = String.length "OCAML_VERSION" in (* Note: the spaces in the replacements are to preserve locations *) printf "%-*s" patt_len version } rule rewrite is_current ocaml_version = parse | "OCAML_VERSION" { print_ocaml_version ocaml_version; rewrite is_current ocaml_version lexbuf } | "(*IF_CURRENT " ([^'*']* as s) "*)" { let chunk = if is_current then " " ^ s ^ " " else Lexing.lexeme lexbuf in print_string chunk; rewrite is_current ocaml_version lexbuf } | "(*IF_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)" { let chunk = if (v <= ocaml_version) then " " ^ String.make (String.length v + 1) ' ' ^ s ^ " " else Lexing.lexeme lexbuf in print_string chunk; rewrite is_current ocaml_version lexbuf } | "(*IF_NOT_AT_LEAST " ([^'*' ' ']* as v) " " ([^'*']* as s) "*)" { let chunk = if not (v <= ocaml_version) then " " ^ String.make (String.length v + 1) ' ' ^ s ^ " " else Lexing.lexeme lexbuf in print_string chunk; rewrite is_current ocaml_version lexbuf } | _ as c { print_char c; rewrite is_current ocaml_version lexbuf } | eof { () }