diff options
Diffstat (limited to 'lib/syntax_tools')
47 files changed, 5761 insertions, 1315 deletions
diff --git a/lib/syntax_tools/AUTHORS b/lib/syntax_tools/AUTHORS deleted file mode 100644 index 0212787b30..0000000000 --- a/lib/syntax_tools/AUTHORS +++ /dev/null @@ -1,2 +0,0 @@ -Original Authors and Contributors: - diff --git a/lib/syntax_tools/COPYING b/lib/syntax_tools/COPYING deleted file mode 100644 index 223ede7de3..0000000000 --- a/lib/syntax_tools/COPYING +++ /dev/null @@ -1,504 +0,0 @@ - GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 - - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 59 Temple Place, Suite 330, Boston, MA 02111-1307 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. - - GNU LESSER GENERAL PUBLIC LICENSE - 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 a brief 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random Hacker. - - <signature of Ty Coon>, 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! - - diff --git a/lib/syntax_tools/Makefile b/lib/syntax_tools/Makefile index 37e84a80a5..14ae6d4f97 100644 --- a/lib/syntax_tools/Makefile +++ b/lib/syntax_tools/Makefile @@ -1,13 +1,14 @@ -# ``The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved via the world wide web at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# ``Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/lib/syntax_tools/doc/Makefile b/lib/syntax_tools/doc/Makefile index d9981de880..87604c4e7f 100644 --- a/lib/syntax_tools/doc/Makefile +++ b/lib/syntax_tools/doc/Makefile @@ -1,13 +1,14 @@ -# ``The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved via the world wide web at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# ``Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/lib/syntax_tools/doc/overview.edoc b/lib/syntax_tools/doc/overview.edoc index df02ad0b3a..3111633a99 100644 --- a/lib/syntax_tools/doc/overview.edoc +++ b/lib/syntax_tools/doc/overview.edoc @@ -2,79 +2,34 @@ Syntax Tools overview page - @author Richard Carlsson <[email protected]> -@copyright 1997-2004 Richard Carlsson +@copyright 1997-2014 Richard Carlsson @version {@version} -@title Erlang Syntax Tools +@title Erlang Syntax and Metaprogramming tools -@doc This package contains modules for handling abstract Erlang syntax -trees, in a way that is compatible with the "parse trees" of the -standard library module `erl_parse', together with utilities for reading -source files in unusual ways and pretty-printing syntax trees. Also -included is an amazing module merger and renamer called Igor, as well as -an automatic code-cleaner. +@doc This package contains modules for handling abstract syntax trees (ASTs) +in Erlang, in a way that is compatible with the "abstract format" parse +trees of the stdlib module `erl_parse', together with utilities for reading +source files, {@link erl_prettypr. pretty-printing syntax trees}, {@link +igor. merging and renaming modules}, {@link erl_tidy. cleaning up obsolete +constructs}, and doing {@link merl. metaprogramming} in Erlang. -<p>The abstract layer (defined in {@link erl_syntax}) is nicely +The abstract layer (defined in {@link erl_syntax}) is nicely structured and the node types are context-independent. The layer makes it possible to transparently attach source-code comments and user annotations to nodes of the tree. Using the abstract layer makes applications less sensitive to changes in the {@link //stdlib/erl_parse} -data structures, only requiring the {@link erl_syntax} module to be -up-to-date.</p> +data structures, only requiring the `erl_syntax' module to be up-to-date. -<p>The pretty printer {@link erl_prettypr} is implemented on top of the +The pretty printer {@link erl_prettypr} is implemented on top of the library module {@link prettypr}: this is a powerful and flexible generic -pretty printing library, which is also distributed separately.</p> - -<p>For a short demonstration of parsing and pretty-printing, simply -compile the included module <a -href="../examples/demo.erl"><code>demo.erl</code></a>, and execute -<code>demo:run()</code> from the Erlang shell. It will compile the -remaining modules and give you further instructions.</p> - -<p>Also try the {@link erl_tidy} module, as follows: -<pre> - erl_tidy:dir("any-erlang-source-dir", [test, old_guard_tests]).</pre> -("<code>test</code>" assures that no files are modified).</p> - -<p>News in 1.4: -<ul> - <li>Added support for {@link erl_syntax:cond_expr/1. cond-expressions}, - {@link erl_syntax:try_expr/4. try-expressions} and - {@link erl_syntax:class_qualifier/2. class-qualifier patterns}.</li> - <li>Added support for parameterized modules.</li> - <li>{@link igor. Igor} is officially included.</li> - <li>Quick-parse functionality added to {@link epp_dodger}.</li> -</ul> -</p> - -<p>News in 1.3: -<ul> - <li>Added support for qualified names (as used by "packages").</li> - <li>Various internal changes.</li> -</ul> -</p> +pretty printing library, which is also distributed separately. -<p>News in 1.2: -<ul> - <li>HTML Documentation (generated with EDoc).</li> - <li>A few bug fixes and some minor interface changes (sorry for any - inconvenience).</li> -</ul> -</p> +For a short demonstration of parsing and pretty-printing, simply +compile the included module <a href="../examples/demo.erl">`demo.erl'</a>, +and execute `demo:run()' from the Erlang shell. It will compile the +remaining modules and give you further instructions. -<p>News in 1.1: -<ul> - <li>Module {@link erl_tidy}: check or tidy either a single module, or a - whole directory tree recursively. Rewrites and reformats the code - without losing comments or expanding macros. Safe mode allows - generating reports without modifying files.</li> - <li>Module {@link erl_syntax_lib}: contains support functions for easier - analysis of the source code structure.</li> - <li>Module {@link epp_dodger}: Bypasses the Erlang preprocessor - avoids - macro expansion, file inclusion, conditional compilation, etc. - Allows you to find/modify particular definitions/applications of - macros, and other things previously not possible.</li> -</ul> -</p> +Also try the {@link erl_tidy} module, as follows: +```erl_tidy:dir("any-erlang-source-dir", [test, old_guard_tests]).''' +(the `test' option assures that no files are modified). diff --git a/lib/syntax_tools/doc/specs/.gitignore b/lib/syntax_tools/doc/specs/.gitignore new file mode 100644 index 0000000000..322eebcb06 --- /dev/null +++ b/lib/syntax_tools/doc/specs/.gitignore @@ -0,0 +1 @@ +specs_*.xml diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile index 2502bf877a..e55222e59c 100644 --- a/lib/syntax_tools/doc/src/Makefile +++ b/lib/syntax_tools/doc/src/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2012. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -50,6 +51,8 @@ XML_REF3_FILES = \ erl_syntax_lib.xml \ erl_tidy.xml \ igor.xml \ + merl.xml \ + merl_transform.xml \ prettypr.xml XML_PART_FILES = part.xml part_notes.xml @@ -78,10 +81,15 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) + +TOP_SPECS_FILE = specs.xml + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- XML_FLAGS += +SPECS_FLAGS = -I../../include DVIPS_FLAGS += # ---------------------------------------------------- @@ -90,7 +98,7 @@ DVIPS_FLAGS += $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -docs: pdf html man +docs: man pdf html $(TOP_PDF_FILE): $(XML_FILES) @@ -117,6 +125,7 @@ clean clean_docs: rm -f $(MAN3DIR)/* rm -f $(XML_REF3_FILES) $(XML_CHAPTER_FILES) *.html rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(SPECDIR)/* rm -f errs core *~ # ---------------------------------------------------- diff --git a/lib/syntax_tools/doc/src/book.xml b/lib/syntax_tools/doc/src/book.xml index 6a8a3a3ca6..5f9481374f 100644 --- a/lib/syntax_tools/doc/src/book.xml +++ b/lib/syntax_tools/doc/src/book.xml @@ -4,20 +4,21 @@ <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index 408f6d5bac..f85d963919 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -4,20 +4,21 @@ <chapter> <header> <copyright> - <year>2007</year><year>2013</year> + <year>2007</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> @@ -31,6 +32,118 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 2.1.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Miscellaneous updates due to atoms containing + arbitrary Unicode characters. </p> + <p> + Own Id: OTP-14285</p> + </item> + </list> + </section> + +</section> + +<section><title>Syntax_Tools 2.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The address to the FSF in the license header has been + updated.</p> + <p> + Own Id: OTP-14084</p> + </item> + </list> + </section> + +</section> + +<section><title>Syntax_Tools 2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a bug where <c>erl_tidy</c> crashed on the tilde + character when printing to standard output. </p> + <p> + Own Id: OTP-13725 Aux Id: ERL-151, PR-1071 </p> + </item> + <item> + <p><c>merl_transform</c> could get into an infinite loop + when syntactically incorrect text was passed to a + <c>merl:qquote/2,3</c> call.</p> + <p> + Own Id: OTP-13755</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Improve types and specs in OTP documentation generated + from Erlang source files. </p> + <p> + Own Id: OTP-13720 Aux Id: ERL-120 </p> + </item> + </list> + </section> + +</section> + +<section><title>Syntax_Tools 2.0</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>The abstract data type in <c>erl_syntax</c> is + augmented with types and function specifications.</p> + <p>The module <c>erl_prettypr</c> pretty prints types and + function specification, and the output can be parsed.</p> + <p>The types of record fields are no longer ignored. As a + consequence <c>erl_syntax_lib:analyze_record_field/1</c> + returns <c>{Default, Type}</c> instead of <c>Default</c>. + The functions <c>analyze_record_attribute</c>, + <c>analyze_attribute</c>, <c>analyze_form</c>, and + <c>analyze_forms</c> in the <c>erl_syntax_lib</c> module + are also affected by this incompatible change.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12863</p> + </item> + </list> + </section> + +</section> + +<section><title>Syntax_Tools 1.7</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Use the new <c>erl_anno</c> module.</p> + <p> + Own Id: OTP-12732</p> + </item> + <item> + <p>The <c>merl</c> module has been added to the + <c>syntax_tools</c> application. The Merl library is a + simpler way to work with erl_syntax parse trees.</p> + <p> + Own Id: OTP-12769</p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 1.6.18</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -54,11 +167,11 @@ <p> Teach Maps to erl_syntax</p> <p> - Affected functions: <list> + Affected functions:</p> <list> <item>erl_syntax:abstract/1</item> <item>erl_syntax:concrete/1</item> <item>erl_syntax:is_leaf/1</item> - <item>erl_syntax:is_literal/1</item> </list></p> + <item>erl_syntax:is_literal/1</item> </list> <p> Own Id: OTP-12265</p> </item> diff --git a/lib/syntax_tools/doc/src/part.xml b/lib/syntax_tools/doc/src/part.xml index ee8e796561..a20efbc02e 100644 --- a/lib/syntax_tools/doc/src/part.xml +++ b/lib/syntax_tools/doc/src/part.xml @@ -4,20 +4,21 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/syntax_tools/doc/src/part_notes.xml b/lib/syntax_tools/doc/src/part_notes.xml index 6962145618..e02ffddcb2 100644 --- a/lib/syntax_tools/doc/src/part_notes.xml +++ b/lib/syntax_tools/doc/src/part_notes.xml @@ -4,20 +4,21 @@ <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2007</year><year>2013</year> + <year>2007</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/syntax_tools/doc/src/ref_man.xml b/lib/syntax_tools/doc/src/ref_man.xml index 598f656011..774a431db7 100644 --- a/lib/syntax_tools/doc/src/ref_man.xml +++ b/lib/syntax_tools/doc/src/ref_man.xml @@ -4,20 +4,21 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> @@ -29,12 +30,11 @@ </header> <description> <p><em>Syntax_Tools</em> contains modules for handling abstract - Erlang syntax trees, in a way that is compatible with the "parse - trees" of the STDLIB module <c>erl_parse</c>, together with - utilities for reading source files in unusual ways and - pretty-printing syntax trees. Also included is an amazing module - merger and renamer called Igor, as well as an automatic - code-cleaner.</p> + Erlang syntax trees, in a way that is compatible with the "external + format" parse trees of the STDLIB module <c>erl_parse</c>, together + with utilities for reading source files, pretty-printing syntax trees, + merging and renaming modules, cleaning up obsolete constructs, and + doing metaprogramming in Erlang.</p> </description> <xi:include href="epp_dodger.xml"/> <xi:include href="erl_comment_scan.xml"/> @@ -44,6 +44,8 @@ <xi:include href="erl_syntax_lib.xml"/> <xi:include href="erl_tidy.xml"/> <xi:include href="igor.xml"/> + <xi:include href="merl.xml"/> + <xi:include href="merl_transform.xml"/> <xi:include href="prettypr.xml"/> </application> diff --git a/lib/syntax_tools/doc/src/specs.xml b/lib/syntax_tools/doc/src/specs.xml new file mode 100644 index 0000000000..04c3a494e7 --- /dev/null +++ b/lib/syntax_tools/doc/src/specs.xml @@ -0,0 +1,14 @@ +<?xml version="1.0" encoding="utf-8" ?> +<specs xmlns:xi="http://www.w3.org/2001/XInclude"> + <xi:include href="../specs/specs_epp_dodger.xml"/> + <xi:include href="../specs/specs_erl_comment_scan.xml"/> + <xi:include href="../specs/specs_erl_prettypr.xml"/> + <xi:include href="../specs/specs_erl_recomment.xml"/> + <xi:include href="../specs/specs_erl_syntax.xml"/> + <xi:include href="../specs/specs_erl_syntax_lib.xml"/> + <xi:include href="../specs/specs_erl_tidy.xml"/> + <xi:include href="../specs/specs_igor.xml"/> + <xi:include href="../specs/specs_merl.xml"/> + <xi:include href="../specs/specs_merl_transform.xml"/> + <xi:include href="../specs/specs_prettypr.xml"/> +</specs> diff --git a/lib/syntax_tools/examples/Makefile b/lib/syntax_tools/examples/Makefile index 2724b0899b..f5e96a8285 100644 --- a/lib/syntax_tools/examples/Makefile +++ b/lib/syntax_tools/examples/Makefile @@ -1,13 +1,14 @@ -# ``The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved via the world wide web at http://www.erlang.org/. -# -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# ``Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # The Initial Developer of the Original Code is Ericsson Utvecklings AB. # Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings diff --git a/lib/syntax_tools/examples/merl/Makefile b/lib/syntax_tools/examples/merl/Makefile new file mode 100644 index 0000000000..13a9703733 --- /dev/null +++ b/lib/syntax_tools/examples/merl/Makefile @@ -0,0 +1,22 @@ +EBIN=../../ebin +INCLUDES=../../include +SOURCES=merl_build.erl lisp.erl lispc.erl basic.erl basicc.erl +HEADERS=$(INCLUDES)/merl.hrl +OBJECTS=$(SOURCES:%.erl=%.beam) +ERLC_FLAGS=+debug_info -I$(INCLUDES) -pa $(EBIN) + +all: $(OBJECTS) test + +%.beam: %.erl $(HEADERS) Makefile + erlc $(ERLC_FLAGS) -o ./ $< + +# additional dependencies due to the parse transform +lispc.beam basicc.beam: $(EBIN)/merl_transform.beam $(EBIN)/merl.beam + +clean: + -rm -f $(OBJECTS) + +test: + erl -noshell -pa $(EBIN) \ + -eval 'eunit:test([lisp, lispc, basic, basicc],[])' \ + -s init stop diff --git a/lib/syntax_tools/examples/merl/basic.erl b/lib/syntax_tools/examples/merl/basic.erl new file mode 100644 index 0000000000..9030059d11 --- /dev/null +++ b/lib/syntax_tools/examples/merl/basic.erl @@ -0,0 +1,77 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Trivial Basic interpreter in Erlang + +-module(basic). + +-export([run/2]). + +-include_lib("eunit/include/eunit.hrl"). + +-define(INTERPRETED, true). +-include("basic_test.erl"). + +run(N, Prog) -> + ets:new(var, [private, named_table]), + ets:new(line, [private, named_table, ordered_set]), + lists:foreach(fun (T) -> ets:insert(line, T) end, Prog), + goto(N). + +stop(N) -> + ets:delete(var), + ets:delete(line), + N. + +goto('$end_of_table') -> stop(0); +goto(L) -> + L1 = ets:next(line, L), + %% user-supplied line numbers might not exist + case ets:lookup(line, L) of + [{_, X}] -> + stmt(X, L1); + _ -> + goto(L1) + end. + +stmt({print, S, As}, L) -> io:format(S, [expr(A) || A <- As]), goto(L); +stmt({set, V, X}, L) -> ets:insert(var, {V, expr(X)}), goto(L); +stmt({goto, X}, _L) -> goto(expr(X)); +stmt({stop, X}, _L) -> stop(expr(X)); +stmt({iff, X, A, B}, _L) -> + case expr(X) of + 0 -> goto(B); + _ -> goto(A) + end. + +expr(X) when is_number(X) ; is_list(X) -> + X; +expr(X) when is_atom(X) -> + case ets:lookup(var, X) of + [] -> 0; + [{_,V}] -> V + end; +expr({plus, X, Y}) -> + expr(X) + expr(Y); +expr({equal, X, Y}) -> + bool(expr(X) == expr(Y)); +expr({gt, X, Y}) -> + bool(expr(X) > expr(Y)); +expr({knot, X}) -> + case expr(X) of + 0 -> 1; + _ -> 0 + end. + +bool(true) -> 1; +bool(false) -> 0. diff --git a/lib/syntax_tools/examples/merl/basic_test.erl b/lib/syntax_tools/examples/merl/basic_test.erl new file mode 100644 index 0000000000..ff35de6325 --- /dev/null +++ b/lib/syntax_tools/examples/merl/basic_test.erl @@ -0,0 +1,77 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Tests. For including in another module. + +%-module(basic_test). +%-import(basic, run/1) + +-export([basic_fib/1]). + +-include_lib("eunit/include/eunit.hrl"). + +basics_test_() -> + [?_assertEqual(42, run(1,[{1,{stop, 42}}])), + ?_assertEqual("hello", run(1,[{1,{stop,"hello"}}])), + ?_assertEqual(0, run(1,[{1,{print, "hello ~w", [42]}}])), + ?_assertEqual(5, run(1,[{1,{stop, {plus, 2, 3}}}])), + ?_assertEqual(5, run(1,[{1,{stop,{plus, 8, -3}}}])), + ?_assertEqual(0, run(1,[{1,{stop,{equal, 0, 1}}}])), + ?_assertEqual(1, run(1,[{1,{stop,{equal, 1, 1}}}])), + ?_assertEqual(0, run(1,[{1,{stop,{gt, 0, 1}}}])), + ?_assertEqual(0, run(1,[{1,{stop,{gt, 1, 1}}}])), + ?_assertEqual(1, run(1,[{1,{stop,{gt, 2, 1}}}])), + ?_assertEqual(0, run(1,[{1,{stop,{knot, 42}}}])), + ?_assertEqual(1, run(1,[{1,{stop,{knot, 0}}}])), + ?_assertEqual(42, run(1,[{1,{set, x, 42}}, {2,{stop,x}}])), + ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}}, + {2,{stop, 17}}, + {3,{stop, 42}}])), + ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}}, + {2,{stop, 17}}, + {3,{stop, 42}}])), + ?_assertEqual(17, run(1,[{1,{iff, 1, 2, 3}}, + {2,{stop, 17}}, + {3,{stop, -1}}])), + ?_assertEqual(42, run(1,[{1,{iff, 0, 2, 3}}, + {2,{stop, -1}}, + {3,{stop, 42}}])) + + + ]. + + +fib_test_() -> + [?_assertEqual(fib(N), basic_fib(N)) || N <- lists:seq(1,15) + ]. + + +fib(N) when N > 1 -> + fib(N-1) + fib(N-2); +fib(_) -> + 1. + +basic_fib(N) -> + run(1, + [{1,{set,x,0}}, + {2,{set,a,1}}, + {3,{set,b,0}}, + {10,{iff, {equal, x, N}, 20, 30}}, + {20,{stop,a}}, + {30,{print,"~w, ~w, ~w\n",[x,a,b]}}, + {31,{set,t,a}}, + {32,{set,a,{plus,a,b}}}, + {33,{set,b,t}}, + {34,{set,x,{plus,x,1}}}, + {40,{goto,10}} + ]). diff --git a/lib/syntax_tools/examples/merl/basicc.erl b/lib/syntax_tools/examples/merl/basicc.erl new file mode 100644 index 0000000000..531ac51538 --- /dev/null +++ b/lib/syntax_tools/examples/merl/basicc.erl @@ -0,0 +1,149 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Basic compiler in Erlang. + +-module(basicc). + +-export([run/2, make_lines/1, bool/1]). + +-include_lib("eunit/include/eunit.hrl"). + +-define(INTERPRETED, true). +-include("basic_test.erl"). + +-include("merl.hrl"). + +run(N, Prog) -> + compile(Prog, tmp), + tmp:run(N, Prog). + +make_lines(Prog) -> + ets:new(line, [private, named_table, ordered_set]), + lists:foreach(fun ({L,_}) -> ets:insert(line, {L,label(L)}) end, Prog). + +compile(Prog, ModName) -> + make_lines(Prog), + Fs0 = lists:map(fun ({L, X}) -> + {true, label(L), + case stmt(X) of + {Stmt, false} -> + [?Q("() -> _@Stmt")]; + {Stmt, true} -> + Next = case ets:next(line, L) of + '$end_of_table' -> + ?Q("stop(0)"); + L1 -> + Label = label(L1), + ?Q("_@Label@()") + end, + [?Q("() -> _@Stmt, _@Next")] + end} + end, Prog), + ets:delete(line), + Run = ?Q(["(N, Prog) ->", + " ets:new(var, [private, named_table]),", + " basicc:make_lines(Prog),", + " goto(N)" + ]), + Stop = ?Q(["(R) ->", + " ets:delete(var),", + " ets:delete(line),", + " R" + ]), + Goto = ?Q(["(L) ->", + " case ets:lookup(line, L) of", + " [{_, X}] -> apply(tmp, X, []);", + " _ ->", + " case ets:next(line, L) of", + " '$end_of_table' -> stop(0);", + " L1 -> goto(L1)", + " end", + " end"]), + Fs = [{true, run, [Run]}, + {false, stop, [Stop]}, + {true, goto, [Goto]} + | Fs0], + Forms = merl_build:module_forms( + lists:foldl(fun ({X, Name, Cs}, S) -> + merl_build:add_function(X, Name, Cs, S) + end, + merl_build:init_module(ModName), + Fs)), + %% %% Write source to file for debugging + %% file:write_file(lists:concat([ModName, "_gen.erl"]), + %% erl_prettypr:format(erl_syntax:form_list(Forms), + %% [{paper,160},{ribbon,80}])), + merl:compile_and_load(Forms, [verbose]). + +label(L) -> + list_to_atom("label_" ++ integer_to_list(L)). + +stmt({print, S, As}) -> + Exprs = [expr(A) || A <- As], + {[?Q(["io:format(_@S@, [_@Exprs])"])], true}; +stmt({set, V, X}) -> + Expr = expr(X), + {[?Q(["ets:insert(var, {_@V@, _@Expr})"])], true}; +stmt({goto, X}) -> + {[jump(X)], false}; +stmt({stop, X}) -> + Expr = expr(X), + {[?Q(["stop(_@Expr)"])], false}; +stmt({iff, X, A, B}) -> + Cond = expr(X), + True = jump(A), + False = jump(B), + {?Q(["case _@Cond of", + " 0 -> _@False;", + " _ -> _@True", + "end"]), + false}. + +jump(X) -> + case ets:lookup(line, X) of + [{_, F}] -> + ?Q(["_@F@()"]); + true -> + Expr = expr(X), + [?Q(["goto(_@Expr)"])] + end. + +expr(X) when is_number(X) ; is_list(X) -> + ?Q("_@X@"); +expr(X) when is_atom(X) -> + ?Q(["case ets:lookup(var, _@X@) of", + " [] -> 0;", + " [{_,V}] -> V", + "end"]); +expr({plus, X, Y}) -> + ExprX = expr(X), + ExprY = expr(Y), + ?Q("_@ExprX + _@ExprY"); +expr({equal, X, Y}) -> + ExprX = expr(X), + ExprY = expr(Y), + ?Q("basicc:bool(_@ExprX == _@ExprY)"); +expr({gt, X, Y}) -> + ExprX = expr(X), + ExprY = expr(Y), + ?Q("basicc:bool(_@ExprX > _@ExprY)"); +expr({knot, X}) -> + Expr = expr(X), + ?Q(["case _@Expr of", + " 0 -> 1;", + " _ -> 0", + "end"]). + +bool(true) -> 1; +bool(false) -> 0. diff --git a/lib/syntax_tools/examples/merl/lisp.erl b/lib/syntax_tools/examples/merl/lisp.erl new file mode 100644 index 0000000000..371dc6b261 --- /dev/null +++ b/lib/syntax_tools/examples/merl/lisp.erl @@ -0,0 +1,160 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Trivial Lisp interpreter in Erlang. + +-module(lisp). + +-export([eval/1]). + +-export([init/0, equal/2, gt/2, knot/1]). + +-record(st, {env}). + +-define(INTERPRETED, true). +-include("lisp_test.erl"). + +eval(P) -> + {X, _} = eval(P, init()), + X. + +init() -> + Env = [{print, {builtin, fun do_print/2}} + ,{list, {builtin, fun do_list/2}} + ,{apply, {builtin, fun do_apply/2}} + ,{plus, {builtin, fun do_plus/2}} + ,{equal, {builtin, fun do_equal/2}} + ,{gt, {builtin, fun do_gt/2}} + ,{knot, {builtin, fun do_knot/2}} + ,{y, y()} + ], + #st{env=dict:from_list(Env)}. + +eval([lambda, Ps, B], #st{env=E}=St) when is_list(Ps) -> + case lists:all(fun is_atom/1, Ps) andalso + (length(Ps) =:= length(lists:usort(Ps))) of + true -> {{lambda, Ps, B, E}, St}; + false -> throw(bad_lambda) + end; +eval([lambda | _], _) -> + throw(bad_lambda); +eval([def, A, V, B], #st{env=E0}=St) when is_atom(A) -> + {V1, St1} = eval(V, St), + E1 = bind(A, V1, E0), + {X, St2} = eval(B, St1#st{env=E1}), + {X, St2#st{env=E0}}; +eval([def | _], _) -> + throw(bad_def); +eval([quote, A], St) -> + {A, St}; +eval([quote | _], _) -> + throw(bad_quote); +eval([iff, X, A, B], St) -> + case eval(X, St) of + {[], St1} -> eval(B, St1); + {_, St1} -> eval(A, St1) + end; +eval([do], _St0) -> + throw(bad_do); +eval([do | As], St0) -> + lists:foldl(fun (X, {_,St}) -> eval(X, St) end, {[],St0}, As); +eval([_|_]=L, St) -> + {[F | As], St1} = lists:mapfoldl(fun eval/2, St, L), + call(F, As, St1); +eval(A, St) when is_atom(A) -> + {deref(A, St), St}; +eval(C, St) -> + {C, St}. + +%% UTILITY FUNCTIONS + +deref(A, #st{env=E}) -> + case dict:find(A, E) of + {ok, V} -> V; + error -> throw({undefined, A}) + end. + +bind(A, V, E) -> + dict:store(A, V, E). + +bind_args([P | Ps], [A | As], E) -> + bind_args(Ps, As, dict:store(P, A, E)); +bind_args([], [], E) -> + E; +bind_args(_, _, _) -> + throw(bad_arity). + +call({lambda, Ps, B, E}, As, #st{env=E0}=St) -> + {X, St1} = eval(B, St#st{env=bind_args(Ps, As, E)}), + {X, St1#st{env=E0}}; +call({builtin, F}, As, St) -> + F(As, St); +call(X, _, _) -> + throw({bad_fun, X}). + +bool(true) -> 1; +bool(false) -> []. + +%% BUILTINS + +y() -> + {Y, _} = eval([lambda, [f], + [[lambda, [x], [f, [lambda, [y], [[x, x], y]]]], + [lambda, [x], [f, [lambda, [y], [[x, x], y]]]]]], + #st{env=dict:new()}), + Y. + +do_print([S | Xs], St) -> + io:format(S, Xs), + {[], St}; +do_print(_, _) -> + throw(bad_print). + +do_list(As, St) -> + {As, St}. + +do_apply([F, As], St) -> + call(F, As, St); +do_apply(_, _) -> + throw(bad_apply). + +do_plus([X, Y], St) when is_number(X), is_number(Y) -> + {X + Y, St}; +do_plus(As, _) -> + throw({bad_plus, As}). + +do_equal([X, Y], St) -> + {equal(X, Y), St}; +do_equal(As, _) -> + throw({bad_equal, As}). + +equal(X, Y) -> + bool(X =:= Y). + +do_gt([X, Y], St) -> + {gt(X, Y), St}; +do_gt(As, _) -> + throw({bad_gt, As}). + +gt(X, Y) -> + bool(X > Y). + +do_knot([X], St) -> + {knot(X), St}; +do_knot(As, _) -> + throw({bad_gt, As}). + +knot([]) -> + 1; +knot(_) -> + []. diff --git a/lib/syntax_tools/examples/merl/lisp_test.erl b/lib/syntax_tools/examples/merl/lisp_test.erl new file mode 100644 index 0000000000..cab8134b8f --- /dev/null +++ b/lib/syntax_tools/examples/merl/lisp_test.erl @@ -0,0 +1,98 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Tests. For including in another module. + +%-module(lisp_test). +%-import(lisp, eval/1) + +-export([fib/1, lisp_fib/1]). + +-include_lib("eunit/include/eunit.hrl"). + +basics_test_() -> + [?_assertEqual(42, eval(42)), + ?_assertEqual("hello", eval([quote, "hello"])), + ?_assertEqual(print, eval([quote, print])), + ?_assertMatch([17,[1,2],42], eval([list,17,[list,1,2],42])), + ?_assertEqual([], eval([print, [quote, "hello ~w"], [list, 42]])), + ?_assertEqual(5, eval([plus, 2, 3])), + ?_assertEqual(5, eval([plus, 8, -3])), + ?_assertEqual([], eval([equal, 0, 1])), + ?_assertEqual(1, eval([equal, 1, 1])), + ?_assertEqual([], eval([gt, 0, 1])), + ?_assertEqual([], eval([gt, 1, 1])), + ?_assertEqual(1, eval([gt, 2, 1])), + ?_assertEqual([], eval([knot, 42])), + ?_assertEqual(1, eval([knot, []])), + ?_assertEqual(42, eval([do, 17, 42])), + ?_assertEqual([], eval([apply, print, [quote, ["~p", [42]]]])), + ?_assertEqual(42, eval([iff, [], 17, 42])), + ?_assertEqual(17, eval([iff, 1, 17, 42])), + ?_assertEqual(42, eval([iff, [], [apply], 42])), + ?_assertEqual(17, eval([iff, 1, 17, [apply]])), + ?_assertEqual(17, eval([def, foo, 17, foo])), + ?_assertEqual(17, eval([def, bar, 42, [def, foo, 17, foo]])), + ?_assertEqual(42, eval([def, bar, 42, [def, foo, 17, bar]])), + ?_assertEqual(17, eval([def, foo, 42, [def, foo, 17, foo]])) + ]. + +-ifdef(INTERPRETED). +interpreter_basics_test_() -> + [?_assertThrow({undefined, foo}, eval(foo)), + ?_assertMatch({builtin,_}, eval(print)), + ?_assertThrow(bad_do, eval([do])), + ?_assertThrow(bad_apply, eval([apply])), + ?_assertThrow({undefined, foo}, eval([def, bar, 17, foo])) + ]. + +interpreter_lambda_test_() -> + [?_assertMatch({lambda,_,_,_}, eval([lambda, [], 42])), + ?_assertMatch({lambda,_,_,_}, eval([lambda, [x], x])), + ?_assertMatch({lambda,_,_,_}, eval([lambda, [x,y], 42])) + ]. +-endif. + +lambda_test_() -> + [?_assertThrow(bad_lambda, eval([lambda])), + ?_assertThrow(bad_lambda, eval([lambda, []])), + ?_assertThrow(bad_lambda, eval([lambda, [], 17, 42])), + ?_assertThrow(bad_lambda, eval([lambda, 17, 42])), + ?_assertThrow(bad_lambda, eval([lambda, [17], 42])), + ?_assertThrow(bad_lambda, eval([lambda, [foo, foo], 42])), + ?_assertEqual(42, eval([[lambda, [x], x], 42])), + ?_assertEqual([42, 17], eval([[lambda, [x], [list, x, 17]], 42])), + ?_assertEqual([42, 17], eval([def, f, [def, y, 42, + [lambda, [x], [list, y, x]]], + [f, 17]])) + ]. + +fib_test_() -> + [?_assertEqual(fib(N), lisp_fib(N)) || N <- lists:seq(1,15) + ]. + + +fib(N) when N > 1 -> + fib(N-1) + fib(N-2); +fib(_) -> + 1. + +lisp_fib(N) -> + eval([def, fib, + [y, [lambda, [f], [lambda, [x], + [iff, [gt, x, 1], + [plus, [f, [plus,x,-1]], [f, [plus,x,-2]]], + 1] + ]]], + [fib, N] + ]). diff --git a/lib/syntax_tools/examples/merl/lispc.erl b/lib/syntax_tools/examples/merl/lispc.erl new file mode 100644 index 0000000000..97072cdab7 --- /dev/null +++ b/lib/syntax_tools/examples/merl/lispc.erl @@ -0,0 +1,102 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Lisp compiler in Erlang. + +-module(lispc). + +-export([eval/1]). + +-record(st, {}). + +-include("lisp_test.erl"). + +-include("merl.hrl"). + +eval(Lisp) -> + compile(Lisp, tmp), + tmp:eval(). + +compile(Lisp, ModName) -> + {Code, _} = gen(Lisp, #st{}), + Main = ?Q(["() ->", + " __print = fun (S, Xs) -> io:format(S,Xs), [] end,", + " __apply = fun erlang:apply/2,", + " __plus = fun erlang:'+'/2,", + " __equal = fun lisp:equal/2,", + " __gt = fun lisp:gt/2,", + " __knot = fun lisp:knot/1,", + " __y = fun (F) ->", + " (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)", + " (fun (X) -> F(fun (Y) -> (X(X))(Y) end) end)", + " end,", + " _@Code"]), + Forms = merl_build:module_forms( + merl_build:add_function(true, eval, [Main], + merl_build:init_module(ModName))), + %% %% Write source to file for debugging + %% file:write_file(lists:concat([ModName, "_gen.erl"]), + %% erl_prettypr:format(erl_syntax:form_list(Forms), + %% [{paper,160},{ribbon,80}])), + merl:compile_and_load(Forms, [verbose]). + +var(Atom) -> + merl:var(list_to_atom("__" ++ atom_to_list(Atom))). + +gen([lambda, Ps, B], St) when is_list(Ps) -> + case lists:all(fun is_atom/1, Ps) andalso + (length(Ps) =:= length(lists:usort(Ps))) of + true -> + Vars = [var(P) || P <- Ps], + {Body, St1} = gen(B, St), + {?Q("fun (_@Vars) -> _@Body end"), St1}; + false -> + throw(bad_lambda) + end; +gen([lambda | _], _) -> + throw(bad_lambda); +gen([def, A, V, B], St) when is_atom(A) -> + Var = var(A), + {Val, St1} = gen(V, St), + {Body, St2} = gen(B, St1), + {?Q("(fun (_@Var) -> _@Body end)(_@Val)"), St2}; +gen([def | _], _) -> + throw(bad_def); +gen([quote, A], St) -> + {merl:term(A), St}; +gen([quote | _], _) -> + throw(bad_quote); +gen([iff, X, A, B], St) -> + {Cond, St1} = gen(X, St), + {True, St2} = gen(A, St1), + {False, St3} = gen(B, St2), + {?Q(["case _@Cond of", + " [] -> _@False;", + " _ -> _@True", + "end"]), + St3}; +gen([do], _) -> + throw(bad_do); +gen([do | As], St0) -> + {Body, St1} = lists:mapfoldl(fun gen/2, St0, As), + {?Q("begin _@Body end"), St1}; +gen([list | As], St0) -> + {Elem, St1} = lists:mapfoldl(fun gen/2, St0, As), + {?Q("[ _@Elem ]"), St1}; +gen([_|_]=L, St) -> + {[F | As], St1} = lists:mapfoldl(fun gen/2, St, L), + {?Q("((_@F)(_@As))"), St1}; +gen(A, St) when is_atom(A) -> + {var(A), St}; +gen(C, St) -> + {merl:term(C), St}. diff --git a/lib/syntax_tools/examples/merl/merl_build.erl b/lib/syntax_tools/examples/merl/merl_build.erl new file mode 100644 index 0000000000..c539f8e2af --- /dev/null +++ b/lib/syntax_tools/examples/merl/merl_build.erl @@ -0,0 +1,104 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012 Richard Carlsson +%% @doc Making it simple to build a module with merl + +-module(merl_build). + +-export([init_module/1, module_forms/1, add_function/4, add_record/3, + add_import/3, add_attribute/3, set_file/2]). + +-import(merl, [term/1]). + +-include("merl.hrl"). + +-type filename() :: string(). + +-record(module, { name :: atom() + , file :: filename() + , exports=[] :: [{atom(), integer()}] + , imports=[] :: [{atom(), [{atom(), integer()}]}] + , attributes=[] :: [{filename(), atom(), [term()]}] + , records=[] :: [{filename(), atom(), + [{atom(), merl:tree()}]}] + , functions=[] :: [{filename(), atom(), [merl:tree()]}] + }). + +%% TODO: init module from a list of forms (from various sources) + +%% @doc Create a new module representation, using the given module name. +init_module(Name) when is_atom(Name) -> + %% use the module name as the default file name - better than nothing + #module{name=Name, file=atom_to_list(Name)}. + +%% @doc Get the list of syntax tree forms for a module representation. This can +%% be passed to compile/2. +module_forms(#module{name=Name, + exports=Xs, + imports=Is, + records=Rs, + attributes=As, + functions=Fs}) + when is_atom(Name), Name =/= undefined -> + Module = ?Q("-module('@Name@')."), + Exported = [erl_syntax:arity_qualifier(term(N), term(A)) + || {N,A} <- ordsets:from_list(Xs)], + Export = ?Q("-export(['@_Exported'/1])."), + Imports = [?Q("-import('@M@', ['@_NAs'/1]).") + || {M, Ns} <- Is, + NAs <- [[erl_syntax:arity_qualifier(term(N), term(A)) + || {N,A} <- ordsets:from_list(Ns)]] + ], + Attrs = [?Q("-file(\"'@File@\",1). -'@N@'('@T@').") + || {File, N, T} <- lists:reverse(As)], + Records = [?Q("-file(\"'@File@\",1). -record('@N@',{'@_RFs'=[]}).") + || {File, N, Es} <- lists:reverse(Rs), + RFs <- [[erl_syntax:record_field(term(F), V) + || {F,V} <- Es]] + ], + Functions = [?Q("-file(\"'@File@\",1). '@_F'() -> [].") + || {File, N, Cs} <- lists:reverse(Fs), + F <- [erl_syntax:function(term(N), Cs)]], + lists:flatten([Module, Export, Imports, Attrs, Records, Functions]). + +%% @doc Set the source file name for all subsequently added functions, +%% records, and attributes. +set_file(Filename, #module{}=M) -> + M#module{file=filename:flatten(Filename)}. + +%% @doc Add a function to a module representation. +add_function(Exported, Name, Clauses, + #module{file=File, exports=Xs, functions=Fs}=M) + when is_boolean(Exported), is_atom(Name), Clauses =/= [] -> + Arity = length(erl_syntax:clause_patterns(hd(Clauses))), + Xs1 = case Exported of + true -> [{Name,Arity} | Xs]; + false -> Xs + end, + M#module{exports=Xs1, functions=[{File, Name, Clauses} | Fs]}. + +%% @doc Add a record declaration to a module representation. +add_record(Name, Fields, #module{file=File, records=Rs}=M) + when is_atom(Name) -> + M#module{records=[{File, Name, Fields} | Rs]}. + +%% @doc Add a "wild" attribute, such as `-compile(Opts)' to a module +%% representation. Note that such attributes can only have a single argument. +add_attribute(Name, Term, #module{file=File, attributes=As}=M) + when is_atom(Name) -> + M#module{attributes=[{File, Name, Term} | As]}. + +%% @doc Add an import declaration to a module representation. +add_import(From, Names, #module{imports=Is}=M) + when is_atom(From), is_list(Names) -> + M#module{imports=[{From, Names} | Is]}. diff --git a/lib/syntax_tools/include/merl.hrl b/lib/syntax_tools/include/merl.hrl new file mode 100644 index 0000000000..e44a78dece --- /dev/null +++ b/lib/syntax_tools/include/merl.hrl @@ -0,0 +1,29 @@ +%% --------------------------------------------------------------------- +%% Header file for merl +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. + +-ifndef(MERL_HRL). + + +%% Quoting a piece of code +-define(Q(Text), merl:quote(?LINE, Text)). + +%% Quasi-quoting code, substituting metavariables listed in Env +-define(Q(Text, Env), merl:qquote(?LINE, Text, Env)). + + +-ifndef(MERL_NO_TRANSFORM). +-compile({parse_transform, merl_transform}). +-endif. + + +-endif. diff --git a/lib/syntax_tools/src/Makefile b/lib/syntax_tools/src/Makefile index c9fbad8f9a..8325db45a8 100644 --- a/lib/syntax_tools/src/Makefile +++ b/lib/syntax_tools/src/Makefile @@ -22,18 +22,26 @@ RELSYSDIR = $(RELEASE_PATH)/lib/syntax_tools-$(VSN) # EBIN = ../ebin +INCLUDE=../include + +ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ./ -I$(INCLUDE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_unused_import -Werror # +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_unused_import #-Werror # +warn_missing_spec +warn_untyped_record SOURCES=erl_syntax.erl erl_prettypr.erl erl_syntax_lib.erl \ erl_comment_scan.erl erl_recomment.erl erl_tidy.erl \ - epp_dodger.erl prettypr.erl igor.erl + epp_dodger.erl prettypr.erl igor.erl \ + merl.erl merl_transform.erl + +INCLUDE_FILES = merl.hrl OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) +INCLUDE_DELIVERABLES = $(INCLUDE_FILES:%=$(INCLUDE)/%) + APP_FILE= syntax_tools.app APP_SRC= $(APP_FILE).src APP_TARGET= $(EBIN)/$(APP_FILE) @@ -52,6 +60,7 @@ all: $(OBJECTS) clean: + rm -f ./merl_transform.beam rm -f $(OBJECTS) rm -f core *~ @@ -64,6 +73,15 @@ realclean: clean $(EBIN)/%.$(EMULATOR):%.erl $(erlc_verbose)erlc -W $(ERL_COMPILE_FLAGS) -o$(EBIN) $< +# special rules and dependencies to apply the transform to itself +$(EBIN)/merl_transform.beam: $(EBIN)/merl.beam ./merl_transform.beam \ + ../include/merl.hrl \ + $(EBIN)/erl_syntax.beam $(EBIN)/erl_syntax_lib.beam +./merl_transform.beam: ./merl_transform.erl $(EBIN)/merl.beam \ + ../include/merl.hrl + $(V_ERLC) -DMERL_NO_TRANSFORM $(ERL_COMPILE_FLAGS) -o ./ $< + + # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- @@ -84,6 +102,8 @@ release_spec: opt $(INSTALL_DATA) $(OBJECTS) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(SOURCES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(INCLUDE_DELIVERABLES) "$(RELSYSDIR)/include" release_docs_spec: diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 3ca7a8197e..cf1ba0abfa 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 of the -%% License, or (at your option) any later version. +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> %% -%% 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. +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% -%% 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 2001-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -454,7 +459,7 @@ io_error(L, Desc) -> {L, ?MODULE, Desc}. start_pos([T | _Ts], _L) -> - element(2, T); + erl_anno:line(element(2, T)); start_pos([], L) -> L. diff --git a/lib/syntax_tools/src/erl_comment_scan.erl b/lib/syntax_tools/src/erl_comment_scan.erl index 03429d4d42..a7a2c10b79 100644 --- a/lib/syntax_tools/src/erl_comment_scan.erl +++ b/lib/syntax_tools/src/erl_comment_scan.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 of the -%% License, or (at your option) any later version. +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> %% -%% 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. +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% -%% 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% ===================================================================== %% @copyright 1997-2006 Richard Carlsson @@ -30,8 +35,14 @@ %% ===================================================================== --type comment() :: {integer(), integer(), integer(), [string()]}. --type commentLine() :: {integer(), integer(), integer(), string()}. +-type comment() :: {Line:: integer(), + Column:: integer(), + Indentation :: integer(), + Text :: [string()]}. +-type commentLine() :: {Line :: integer(), + Column :: integer(), + Indent :: integer(), + Text :: string()}. %% ===================================================================== %% @spec file(FileName::file:filename()) -> [Comment] diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 877675772f..40ddd2b22a 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 of the -%% License, or (at your option) any later version. +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> %% -%% 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. +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% -%% 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1997-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -38,7 +43,7 @@ follow/3, empty/0]). -import(erl_parse, [preop_prec/1, inop_prec/1, func_prec/0, - max_prec/0]). + max_prec/0, type_inop_prec/1, type_preop_prec/1]). -define(PADDING, 2). -define(PAPER, 80). @@ -51,7 +56,7 @@ -type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr' | 'if_expr' | 'receive_expr' | 'try_expr' | {'function', prettypr:document()} - | {'rule', prettypr:document()}. + | 'spec'. -record(ctxt, {prec = 0 :: integer(), sub_indent = 2 :: non_neg_integer(), @@ -195,10 +200,16 @@ format(Node) -> %% ===================================================================== %% @spec format(Tree::syntaxTree(), Options::[term()]) -> string() -%% syntaxTree() = erl_syntax:syntaxTree() %% -%% @type hook() = (syntaxTree(), context(), Continuation) -> document() -%% Continuation = (syntaxTree(), context()) -> document(). +%% @type syntaxTree() = erl_syntax:syntaxTree(). +%% +%% An abstract syntax tree. See the {@link erl_syntax} module for +%% details. +%% +%% @type hook() = (syntaxTree(), context(), Continuation) -> +%% prettypr:document() +%% Continuation = (syntaxTree(), context()) -> +%% prettypr:document(). %% %% A call-back function for user-controlled formatting. See {@link %% format/2}. @@ -277,7 +288,7 @@ format(Node, Options) -> %% ===================================================================== -%% @spec best(Tree::syntaxTree()) -> empty | document() +%% @spec best(Tree::syntaxTree()) -> empty | prettypr:document() %% @equiv best(Tree, []) -spec best(erl_syntax:syntaxTree()) -> 'empty' | prettypr:document(). @@ -288,7 +299,7 @@ best(Node) -> %% ===================================================================== %% @spec best(Tree::syntaxTree(), Options::[term()]) -> -%% empty | document() +%% empty | prettypr:document() %% %% @doc Creates a fixed "best" abstract layout for a syntax tree. This %% is similar to the `layout/2' function, except that here, the final @@ -310,7 +321,7 @@ best(Node, Options) -> %% ===================================================================== -%% @spec layout(Tree::syntaxTree()) -> document() +%% @spec layout(Tree::syntaxTree()) -> prettypr:document() %% @equiv layout(Tree, []) -spec layout(erl_syntax:syntaxTree()) -> prettypr:document(). @@ -320,8 +331,7 @@ layout(Node) -> %% ===================================================================== -%% @spec layout(Tree::syntaxTree(), Options::[term()]) -> document() -%% document() = prettypr:document() +%% @spec layout(Tree::syntaxTree(), Options::[term()]) -> prettypr:document() %% %% @doc Creates an abstract document layout for a syntax tree. The %% result represents a set of possible layouts (cf. module `prettypr'). @@ -442,7 +452,7 @@ lay_2(Node, Ctxt) -> text(erl_syntax:variable_literal(Node)); atom -> - text(erl_syntax:atom_literal(Node)); + text(erl_syntax:atom_literal(Node, Ctxt#ctxt.encoding)); integer -> text(erl_syntax:integer_literal(Node)); @@ -536,9 +546,6 @@ lay_2(Node, Ctxt) -> As = seq(erl_syntax:application_arguments(Node), floating(text(",")), reset_prec(Ctxt), fun lay/2), -%% D1 = beside(D, beside(text("("), -%% beside(par(As), -%% floating(text(")"))))), D1 = beside(D, beside(text("("), beside(par(As), floating(text(")"))))), @@ -587,8 +594,6 @@ lay_2(Node, Ctxt) -> make_case_clause(D1, D2, D3, Ctxt); try_expr -> make_case_clause(D1, D2, D3, Ctxt); - {rule, N} -> - make_rule_clause(N, D1, D2, D3, Ctxt); undefined -> %% If a clause is formatted out of context, we %% use a "fun-expression" clause style. @@ -654,7 +659,7 @@ lay_2(Node, Ctxt) -> beside(D1, beside(text(":"), D2)); %% - %% The rest is in alphabetical order + %% The rest is in alphabetical order (except map and types) %% arity_qualifier -> @@ -669,18 +674,67 @@ lay_2(Node, Ctxt) -> %% a period. If the arguments is `none', we only output the %% attribute name, without following parentheses. Ctxt1 = reset_prec(Ctxt), - N = erl_syntax:attribute_name(Node), - D = case erl_syntax:attribute_arguments(Node) of - none -> + Args = erl_syntax:attribute_arguments(Node), + N = erl_syntax:attribute_name(Node), + D = case attribute_type(Node) of + spec -> + [SpecTuple] = Args, + [FuncName, FuncTypes] = + erl_syntax:tuple_elements(SpecTuple), + Name = + case erl_syntax:type(FuncName) of + tuple -> + case erl_syntax:tuple_elements(FuncName) of + [F0, _] -> + F0; + [M0, F0, _] -> + erl_syntax:module_qualifier(M0, + F0); + _ -> + FuncName + end; + _ -> + FuncName + end, + Types = dodge_macros(FuncTypes), + D1 = lay_clauses(erl_syntax:concrete(Types), + spec, Ctxt1), + beside(follow(lay(N, Ctxt1), + lay(Name, Ctxt1), + Ctxt1#ctxt.break_indent), + D1); + type -> + [TypeTuple] = Args, + [Name, Type0, Elements] = + erl_syntax:tuple_elements(TypeTuple), + TypeName = dodge_macros(Name), + Type = dodge_macros(Type0), + As0 = dodge_macros(Elements), + As = erl_syntax:concrete(As0), + D1 = lay_type_application(TypeName, As, Ctxt1), + D2 = lay(erl_syntax:concrete(Type), Ctxt1), + beside(follow(lay(N, Ctxt1), + beside(D1, floating(text(" :: "))), + Ctxt1#ctxt.break_indent), + D2); + Tag when Tag =:= export_type; + Tag =:= optional_callbacks -> + [FuncNs] = Args, + FuncNames = erl_syntax:concrete(dodge_macros(FuncNs)), + As = unfold_function_names(FuncNames), + beside(lay(N, Ctxt1), + beside(text("("), + beside(lay(As, Ctxt1), + floating(text(")"))))); + _ when Args =:= none -> lay(N, Ctxt1); - Args -> - As = seq(Args, floating(text(",")), Ctxt1, - fun lay/2), + _ -> + D1 = par(seq(Args, floating(text(",")), Ctxt1, + fun lay/2)), beside(lay(N, Ctxt1), beside(text("("), - beside(par(As), - floating(text(")"))))) - end, + beside(D1, floating(text(")"))))) + end, beside(floating(text("-")), beside(D, floating(text(".")))); binary -> @@ -851,14 +905,10 @@ lay_2(Node, Ctxt) -> floating(text(".")), lay(erl_syntax:record_access_field(Node), set_prec(Ctxt, PrecR))), - D3 = case erl_syntax:record_access_type(Node) of - none -> - D2; - T -> - beside(beside(floating(text("#")), - lay(T, reset_prec(Ctxt))), - D2) - end, + T = erl_syntax:record_access_type(Node), + D3 = beside(beside(floating(text("#")), + lay(T, reset_prec(Ctxt))), + D2), maybe_parentheses(beside(D1, D3), Prec, Ctxt); record_expr -> @@ -926,15 +976,6 @@ lay_2(Node, Ctxt) -> D2 = lay(erl_syntax:map_field_exact_value(Node), Ctxt1), par([D1, floating(text(":=")), D2], Ctxt1#ctxt.break_indent); - rule -> - %% Comments on the name will be repeated; cf. - %% `function'. - Ctxt1 = reset_prec(Ctxt), - D1 = lay(erl_syntax:rule_name(Node), Ctxt1), - D2 = lay_clauses(erl_syntax:rule_clauses(Node), - {rule, D1}, Ctxt1), - beside(D2, floating(text("."))); - size_qualifier -> Ctxt1 = set_prec(Ctxt, max_prec()), D1 = lay(erl_syntax:size_qualifier_body(Node), Ctxt1), @@ -944,6 +985,16 @@ lay_2(Node, Ctxt) -> text -> text(erl_syntax:text_string(Node)); + typed_record_field -> + {_, Prec, _} = type_inop_prec('::'), + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:typed_record_field_body(Node), Ctxt1), + D2 = lay(erl_syntax:typed_record_field_type(Node), + set_prec(Ctxt, Prec)), + D3 = par([D1, floating(text(" ::")), D2], + Ctxt1#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + try_expr -> Ctxt1 = reset_prec(Ctxt), D1 = sep(seq(erl_syntax:try_expr_body(Node), @@ -981,9 +1032,237 @@ lay_2(Node, Ctxt) -> warning_marker -> E = erl_syntax:warning_marker_info(Node), beside(text("%% WARNING: "), - lay_error_info(E, reset_prec(Ctxt))) + lay_error_info(E, reset_prec(Ctxt))); + + %% + %% Types + %% + + annotated_type -> + {_, Prec, _} = type_inop_prec('::'), + D1 = lay(erl_syntax:annotated_type_name(Node), + reset_prec(Ctxt)), + D2 = lay(erl_syntax:annotated_type_body(Node), + set_prec(Ctxt, Prec)), + D3 = follow(beside(D1, floating(text(" ::"))), D2, + Ctxt#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + + type_application -> + Name = erl_syntax:type_application_name(Node), + Arguments = erl_syntax:type_application_arguments(Node), + %% Prefer shorthand notation. + case erl_syntax_lib:analyze_type_application(Node) of + {nil, 0} -> + text("[]"); + {list, 1} -> + [A] = Arguments, + D1 = lay(A, reset_prec(Ctxt)), + beside(text("["), beside(D1, text("]"))); + {nonempty_list, 1} -> + [A] = Arguments, + D1 = lay(A, reset_prec(Ctxt)), + beside(text("["), beside(D1, text(", ...]"))); + _ -> + lay_type_application(Name, Arguments, Ctxt) + end; + + bitstring_type -> + Ctxt1 = set_prec(Ctxt, max_prec()), + M = erl_syntax:bitstring_type_m(Node), + N = erl_syntax:bitstring_type_n(Node), + D1 = [beside(text("_:"), lay(M, Ctxt1)) || + (erl_syntax:type(M) =/= integer orelse + erl_syntax:integer_value(M) =/= 0)], + D2 = [beside(text("_:_*"), lay(N, Ctxt1)) || + (erl_syntax:type(N) =/= integer orelse + erl_syntax:integer_value(N) =/= 0)], + F = fun(D, _) -> D end, + D = seq(D1 ++ D2, floating(text(",")), Ctxt1, F), + beside(floating(text("<<")), + beside(par(D), floating(text(">>")))); + + fun_type -> + text("fun()"); + + constrained_function_type -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:constrained_function_type_body(Node), + Ctxt1), + D2 = lay(erl_syntax:constrained_function_type_argument(Node), + Ctxt1), + beside(D1, + beside(floating(text(" when ")), D2)); + + function_type -> + {Before, After} = case Ctxt#ctxt.clause of + spec -> + {"", ""}; + _ -> + {"fun(", ")"} + end, + Ctxt1 = reset_prec(Ctxt), + D1 = case erl_syntax:function_type_arguments(Node) of + any_arity -> + text("(...)"); + Arguments -> + As = seq(Arguments, + floating(text(",")), Ctxt1, + fun lay/2), + beside(text("("), + beside(par(As), + floating(text(")")))) + end, + D2 = lay(erl_syntax:function_type_return(Node), Ctxt1), + beside(floating(text(Before)), + beside(D1, + beside(floating(text(" -> ")), + beside(D2, floating(text(After)))))); + + constraint -> + Name = erl_syntax:constraint_argument(Node), + Args = erl_syntax:constraint_body(Node), + case is_subtype(Name, Args) of + true -> + [Var, Type] = Args, + {PrecL, Prec, PrecR} = type_inop_prec('::'), + D1 = lay(Var, set_prec(Ctxt, PrecL)), + D2 = lay(Type, set_prec(Ctxt, PrecR)), + D3 = follow(beside(D1, floating(text(" ::"))), D2, + Ctxt#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + false -> + lay_type_application(Name, Args, Ctxt) + end; + + map_type -> + case erl_syntax:map_type_fields(Node) of + any_size -> + text("map()"); + Fs -> + Ctxt1 = reset_prec(Ctxt), + Es = seq(Fs, + floating(text(",")), Ctxt1, + fun lay/2), + D = beside(floating(text("#{")), + beside(par(Es), + floating(text("}")))), + {Prec, _PrecR} = type_preop_prec('#'), + maybe_parentheses(D, Prec, Ctxt) + end; + + map_type_assoc -> + Name = erl_syntax:map_type_assoc_name(Node), + Value = erl_syntax:map_type_assoc_value(Node), + lay_type_assoc(Name, Value, Ctxt); + + map_type_exact -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:map_type_exact_name(Node), Ctxt1), + D2 = lay(erl_syntax:map_type_exact_value(Node), Ctxt1), + par([D1, floating(text(":=")), D2], Ctxt1#ctxt.break_indent); + + integer_range_type -> + {PrecL, Prec, PrecR} = type_inop_prec('..'), + D1 = lay(erl_syntax:integer_range_type_low(Node), + set_prec(Ctxt, PrecL)), + D2 = lay(erl_syntax:integer_range_type_high(Node), + set_prec(Ctxt, PrecR)), + D3 = beside(D1, beside(text(".."), D2)), + maybe_parentheses(D3, Prec, Ctxt); + + record_type -> + {Prec, _PrecR} = type_preop_prec('#'), + D1 = beside(text("#"), + lay(erl_syntax:record_type_name(Node), + reset_prec(Ctxt))), + Es = seq(erl_syntax:record_type_fields(Node), + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + D2 = beside(D1, + beside(text("{"), + beside(par(Es), + floating(text("}"))))), + maybe_parentheses(D2, Prec, Ctxt); + + record_type_field -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:record_type_field_name(Node), Ctxt1), + D2 = lay(erl_syntax:record_type_field_type(Node), Ctxt1), + par([D1, floating(text("::")), D2], Ctxt1#ctxt.break_indent); + + tuple_type -> + case erl_syntax:tuple_type_elements(Node) of + any_size -> + text("tuple()"); + Elements -> + Es = seq(Elements, + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + beside(floating(text("{")), + beside(par(Es), floating(text("}")))) + end; + + type_union -> + {_, Prec, PrecR} = type_inop_prec('|'), + Es = par(seq(erl_syntax:type_union_types(Node), + floating(text(" |")), set_prec(Ctxt, PrecR), + fun lay/2)), + maybe_parentheses(Es, Prec, Ctxt); + + user_type_application -> + lay_type_application(erl_syntax:user_type_application_name(Node), + erl_syntax:user_type_application_arguments(Node), + Ctxt) + + end. + +attribute_type(Node) -> + N = erl_syntax:attribute_name(Node), + case catch erl_syntax:concrete(N) of + opaque -> + type; + spec -> + spec; + callback -> + spec; + type -> + type; + export_type -> + export_type; + optional_callbacks -> + optional_callbacks; + _ -> + N end. +is_subtype(Name, [Var, _]) -> + (erl_syntax:is_atom(Name, is_subtype) andalso + erl_syntax:type(Var) =:= variable); +is_subtype(_, _) -> false. + +unfold_function_names(Ns) -> + F = fun ({Atom, Arity}) -> + erl_syntax:arity_qualifier(erl_syntax:atom(Atom), + erl_syntax:integer(Arity)) + end, + erl_syntax:list([F(N) || N <- Ns]). + +%% Macros are not handled well. +dodge_macros(Type) -> + F = fun (T) -> + case erl_syntax:type(T) of + macro -> + Var = erl_syntax:macro_name(T), + VarName0 = erl_syntax:variable_name(Var), + VarName = list_to_atom("?"++atom_to_list(VarName0)), + Atom = erl_syntax:atom(VarName), + Atom; + _ -> T + end + end, + erl_syntax_lib:map(F, Type). + lay_parentheses(D, _Ctxt) -> beside(floating(text("(")), beside(D, floating(text(")")))). @@ -1036,6 +1315,8 @@ split_string_1([], _N, _L, As) -> split_string_2([$^, X | Xs], N, L, As) -> split_string_1(Xs, N - 2, L - 2, [X, $^ | As]); +split_string_2([$x, ${ | Xs], N, L, As) -> + split_string_3(Xs, N - 2, L - 2, [${, $x | As]); split_string_2([X1, X2, X3 | Xs], N, L, As) when X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7, X3 >= $0, X3 =< $7 -> split_string_1(Xs, N - 3, L - 3, [X3, X2, X1 | As]); @@ -1045,6 +1326,15 @@ split_string_2([X1, X2 | Xs], N, L, As) when split_string_2([X | Xs], N, L, As) -> split_string_1(Xs, N - 1, L - 1, [X | As]). +split_string_3([$} | Xs], N, L, As) -> + split_string_1(Xs, N - 1, L - 1, [$} | As]); +split_string_3([X | Xs], N, L, As) when + X >= $0, X =< $9; X >= $a, X =< $z; X >= $A, X =< $Z -> + split_string_3(Xs, N - 1, L -1, [X | As]); +split_string_3([X | Xs], N, L, As) when + X >= $0, X =< $9 -> + split_string_1(Xs, N - 1, L -1, [X | As]). + %% Note that there is nothing in `lay_clauses' that actually requires %% that the elements have type `clause'; it just sets up the proper %% context and arranges the elements suitably for clauses. @@ -1073,10 +1363,6 @@ make_fun_clause_head(N, P, Ctxt) -> beside(N, D) end. -make_rule_clause(N, P, G, B, Ctxt) -> - D = make_fun_clause_head(N, P, Ctxt), - append_rule_body(B, append_guard(G, D, Ctxt), Ctxt). - make_case_clause(P, G, B, Ctxt) -> append_clause_body(B, append_guard(G, P, Ctxt), Ctxt). @@ -1092,9 +1378,6 @@ make_if_clause(_P, G, B, Ctxt) -> append_clause_body(B, D, Ctxt) -> append_clause_body(B, D, floating(text(" ->")), Ctxt). -append_rule_body(B, D, Ctxt) -> - append_clause_body(B, D, floating(text(" :-")), Ctxt). - append_clause_body(B, D, S, Ctxt) -> sep([beside(D, S), nest(Ctxt#ctxt.break_indent, B)]). @@ -1128,6 +1411,23 @@ lay_error_info(T, Ctxt) -> lay_concrete(T, Ctxt) -> lay(erl_syntax:abstract(T), Ctxt). +lay_type_assoc(Name, Value, Ctxt) -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(Name, Ctxt1), + D2 = lay(Value, Ctxt1), + par([D1, floating(text("=>")), D2], Ctxt1#ctxt.break_indent). + +lay_type_application(Name, Arguments, Ctxt) -> + {PrecL, Prec} = func_prec(), % + D1 = lay(Name, set_prec(Ctxt, PrecL)), + As = seq(Arguments, + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + D = beside(D1, beside(text("("), + beside(par(As), + floating(text(")"))))), + maybe_parentheses(D, Prec, Ctxt). + seq([H | T], Separator, Ctxt, Fun) -> case T of [] -> diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 7b2f9f7adb..4d9aaf4eed 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 of the -%% License, or (at your option) any later version. +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> %% -%% 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. +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% -%% 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1997-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -30,6 +35,9 @@ -export([recomment_forms/2, quick_recomment_forms/2, recomment_tree/2]). +%% @type syntaxTree() = erl_syntax:syntaxTree(). An abstract syntax +%% tree. See the {@link erl_syntax} module for details. + %% ===================================================================== %% @spec quick_recomment_forms(Forms, Comments::[Comment]) -> %% syntaxTree() @@ -55,7 +63,6 @@ quick_recomment_forms(Tree, Cs) -> %% ===================================================================== %% @spec recomment_forms(Forms, Comments::[Comment]) -> syntaxTree() %% -%% syntaxTree() = erl_syntax:syntaxTree() %% Forms = syntaxTree() | [syntaxTree()] %% Comment = {Line, Column, Indentation, Text} %% Line = integer() @@ -123,7 +130,6 @@ recomment_forms(Tree, Cs, Insert) -> form_list -> Tree1 = erl_syntax:flatten_form_list(Tree), Node = build_tree(Tree1), - %% Here we make a small assumption about the substructure of %% a `form_list' tree: it has exactly one group of subtrees. [Node1] = node_subtrees(Node), @@ -602,22 +608,25 @@ expand_comment(C) -> -record(leaf, {min = 0 :: integer(), max = 0 :: integer(), - precomments = [] :: [erl_syntax:syntaxTree()], - postcomments = [] :: [erl_syntax:syntaxTree()], + precomments = [] :: [erl_comment_scan:comment()], + postcomments = [] :: [erl_comment_scan:comment()], value :: erl_syntax:syntaxTree()}). -record(tree, {min = 0 :: integer(), max = 0 :: integer(), type :: atom(), attrs :: erl_syntax:syntaxTreeAttributes(), - precomments = [] :: [erl_syntax:syntaxTree()], - postcomments = [] :: [erl_syntax:syntaxTree()], - subtrees = [] :: [erl_syntax:syntaxTree()]}). + precomments = [] :: [erl_comment_scan:comment()], + postcomments = [] :: [erl_comment_scan:comment()], + subtrees = [] :: [extendedSyntaxTree()]}). + -record(list, {min = 0 :: integer(), max = 0 :: integer(), subtrees = [] :: [erl_syntax:syntaxTree()]}). +-type extendedSyntaxTree() :: #tree{} | #leaf{} | #list{}. + leaf_node(Min, Max, Value) -> #leaf{min = Min, max = Max, @@ -753,7 +762,13 @@ get_line(Node) -> {_, L, _} when is_integer(L) -> L; Pos -> - exit({bad_position, Pos}) + try erl_anno:line(Pos) of + Line -> + Line + catch + _:_ -> + exit({bad_position, Pos}) + end end. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 40372a2106..9b2b503762 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1997-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -120,6 +125,9 @@ normalize_list/1, compact_list/1, + annotated_type/2, + annotated_type_name/1, + annotated_type_body/1, application/2, application/3, application_arguments/1, @@ -131,6 +139,7 @@ is_atom/2, atom_value/1, atom_literal/1, + atom_literal/2, atom_name/1, attribute/1, attribute/2, @@ -150,6 +159,9 @@ binary_generator/2, binary_generator_body/1, binary_generator_pattern/1, + bitstring_type/2, + bitstring_type_m/1, + bitstring_type_n/1, block_expr/1, block_expr_body/1, case_expr/2, @@ -175,6 +187,12 @@ cond_expr_clauses/1, conjunction/1, conjunction_body/1, + constrained_function_type/2, + constrained_function_type_body/1, + constrained_function_type_argument/1, + constraint/2, + constraint_argument/1, + constraint_body/1, disjunction/1, disjunction_body/1, eof_marker/0, @@ -188,10 +206,15 @@ fun_expr/1, fun_expr_arity/1, fun_expr_clauses/1, + fun_type/0, function/2, function_arity/1, function_clauses/1, function_name/1, + function_type/1, + function_type/2, + function_type_arguments/1, + function_type_return/1, generator/2, generator_body/1, generator_pattern/1, @@ -209,6 +232,9 @@ is_integer/2, integer_value/1, integer_literal/1, + integer_range_type/2, + integer_range_type_low/1, + integer_range_type_high/1, list/1, list/2, list_comp/2, @@ -230,6 +256,15 @@ map_field_exact/2, map_field_exact_name/1, map_field_exact_value/1, + map_type/0, + map_type/1, + map_type_fields/1, + map_type_assoc/2, + map_type_assoc_name/1, + map_type_assoc_value/1, + map_type_exact/2, + map_type_exact_name/1, + map_type_exact_value/1, match_expr/2, match_expr_body/1, match_expr_pattern/1, @@ -254,7 +289,6 @@ receive_expr_action/1, receive_expr_clauses/1, receive_expr_timeout/1, - record_access/2, record_access/3, record_access_argument/1, record_access_field/1, @@ -271,10 +305,12 @@ record_index_expr/2, record_index_expr_field/1, record_index_expr_type/1, - rule/2, - rule_arity/1, - rule_clauses/1, - rule_name/1, + record_type/2, + record_type_name/1, + record_type_fields/1, + record_type_field/2, + record_type_field_name/1, + record_type_field_type/1, size_qualifier/2, size_qualifier_argument/1, size_qualifier_body/1, @@ -293,6 +329,18 @@ try_expr_clauses/1, try_expr_handlers/1, try_expr_after/1, + tuple_type/0, + tuple_type/1, + tuple_type_elements/1, + type_application/2, + type_application/3, + type_application_name/1, + type_application_arguments/1, + type_union/1, + type_union_types/1, + typed_record_field/2, + typed_record_field_body/1, + typed_record_field_type/1, class_qualifier/2, class_qualifier_argument/1, class_qualifier_body/1, @@ -300,6 +348,9 @@ tuple_elements/1, tuple_size/1, underscore/0, + user_type_application/2, + user_type_application_name/1, + user_type_application_arguments/1, variable/1, variable_name/1, variable_literal/1, @@ -360,7 +411,7 @@ %% where `Pos' `Ann' and `Comments' are the corresponding values of a %% `tree' or `wrapper' record. --record(attr, {pos = 0 :: term(), +-record(attr, {pos = erl_anno:new(0) :: term(), ann = [] :: [term()], com = none :: 'none' | #com{}}). -type syntaxTreeAttributes() :: #attr{}. @@ -398,7 +449,14 @@ -type syntaxTree() :: #tree{} | #wrapper{} | erl_parse(). --type erl_parse() :: erl_parse:abstract_form() | erl_parse:abstract_expr(). +-type erl_parse() :: erl_parse:abstract_clause() + | erl_parse:abstract_expr() + | erl_parse:abstract_form() + | erl_parse:abstract_type() + | erl_parse:form_info() + %% To shut up Dialyzer: + | {bin_element, _, _, _, _}. + %% The representation built by the Erlang standard library parser %% `erl_parse'. This is a subset of the {@link syntaxTree()} type. @@ -417,23 +475,28 @@ %% <center><table border="1"> %% <tr> %% <td>application</td> +%% <td>annotated_type</td> %% <td>arity_qualifier</td> %% <td>atom</td> -%% <td>attribute</td> %% </tr><tr> +%% <td>attribute</td> %% <td>binary</td> %% <td>binary_field</td> +%% <td>bitstring_type</td> +%% </tr><tr> %% <td>block_expr</td> %% <td>case_expr</td> -%% </tr><tr> %% <td>catch_expr</td> %% <td>char</td> +%% </tr><tr> %% <td>class_qualifier</td> %% <td>clause</td> -%% </tr><tr> %% <td>comment</td> %% <td>cond_expr</td> +%% </tr><tr> %% <td>conjunction</td> +%% <td>constrained_function_type</td> +%% <td>constraint</td> %% <td>disjunction</td> %% </tr><tr> %% <td>eof_marker</td> @@ -442,49 +505,61 @@ %% <td>form_list</td> %% </tr><tr> %% <td>fun_expr</td> +%% <td>fun_type</td> %% <td>function</td> +%% <td>function_type</td> +%% </tr><tr> %% <td>generator</td> %% <td>if_expr</td> -%% </tr><tr> %% <td>implicit_fun</td> %% <td>infix_expr</td> +%% </tr><tr> %% <td>integer</td> +%% <td>integer_range_type</td> %% <td>list</td> -%% </tr><tr> %% <td>list_comp</td> +%% </tr><tr> %% <td>macro</td> %% <td>map_expr</td> %% <td>map_field_assoc</td> -%% </tr><tr> %% <td>map_field_exact</td> +%% </tr><tr> +%% <td>map_type</td> +%% <td>map_type_assoc</td> +%% <td>map_type_exact</td> %% <td>match_expr</td> %% <td>module_qualifier</td> -%% <td>named_fun_expr</td> %% </tr><tr> +%% <td>named_fun_expr</td> %% <td>nil</td> %% <td>operator</td> %% <td>parentheses</td> -%% <td>prefix_expr</td> %% </tr><tr> +%% <td>prefix_expr</td> %% <td>receive_expr</td> %% <td>record_access</td> %% <td>record_expr</td> -%% <td>record_field</td> %% </tr><tr> +%% <td>record_field</td> %% <td>record_index_expr</td> -%% <td>rule</td> +%% <td>record_type</td> +%% <td>record_type_field</td> +%% </tr><tr> %% <td>size_qualifier</td> %% <td>string</td> -%% </tr><tr> %% <td>text</td> %% <td>try_expr</td> +%% </tr><tr> %% <td>tuple</td> +%% <td>tuple_type</td> +%% <td>typed_record_field</td> +%% <td>type_application</td> +%% <td>type_union</td> %% <td>underscore</td> -%% </tr><tr> +%% <td>user_type_application</td> %% <td>variable</td> +%% </tr><tr> %% <td>warning_marker</td> -%% <td></td> -%% <td></td> %% </tr> %% </table></center> %% @@ -495,12 +570,14 @@ %% always have the same name as the node type itself. %% %% @see tree/2 +%% @see annotated_type/2 %% @see application/3 %% @see arity_qualifier/2 %% @see atom/1 %% @see attribute/2 %% @see binary/1 %% @see binary_field/2 +%% @see bitstring_type/2 %% @see block_expr/1 %% @see case_expr/2 %% @see catch_expr/1 @@ -510,24 +587,34 @@ %% @see comment/2 %% @see cond_expr/1 %% @see conjunction/1 +%% @see constrained_function_type/2 +%% @see constraint/2 %% @see disjunction/1 %% @see eof_marker/0 %% @see error_marker/1 %% @see float/1 %% @see form_list/1 %% @see fun_expr/1 +%% @see fun_type/0 %% @see function/2 +%% @see function_type/1 +%% @see function_type/2 %% @see generator/2 %% @see if_expr/1 %% @see implicit_fun/2 %% @see infix_expr/3 %% @see integer/1 +%% @see integer_range_type/2 %% @see list/2 %% @see list_comp/2 %% @see macro/2 %% @see map_expr/2 %% @see map_field_assoc/2 %% @see map_field_exact/2 +%% @see map_type/0 +%% @see map_type/1 +%% @see map_type_assoc/2 +%% @see map_type_exact/2 %% @see match_expr/2 %% @see module_qualifier/2 %% @see named_fun_expr/2 @@ -540,13 +627,20 @@ %% @see record_expr/2 %% @see record_field/2 %% @see record_index_expr/2 -%% @see rule/2 +%% @see record_type/2 +%% @see record_type_field/2 %% @see size_qualifier/2 %% @see string/1 %% @see text/1 %% @see try_expr/3 %% @see tuple/1 +%% @see tuple_type/0 +%% @see tuple_type/1 +%% @see typed_record_field/2 +%% @see type_application/2 +%% @see type_union/1 %% @see underscore/0 +%% @see user_type_application/2 %% @see variable/1 %% @see warning_marker/1 @@ -607,12 +701,29 @@ type(Node) -> {record, _, _, _, _} -> record_expr; {record, _, _, _} -> record_expr; {record_field, _, _, _, _} -> record_access; - {record_field, _, _, _} -> record_access; {record_index, _, _, _} -> record_index_expr; {remote, _, _, _} -> module_qualifier; - {rule, _, _, _, _} -> rule; {'try', _, _, _, _, _} -> try_expr; {tuple, _, _} -> tuple; + + %% Type types + {ann_type, _, _} -> annotated_type; + {remote_type, _, _} -> type_application; + {type, _, binary, [_, _]} -> bitstring_type; + {type, _, bounded_fun, [_, _]} -> constrained_function_type; + {type, _, constraint, [_, _]} -> constraint; + {type, _, 'fun', []} -> fun_type; + {type, _, 'fun', [_, _]} -> function_type; + {type, _, map, _} -> map_type; + {type, _, map_field_assoc, _} -> map_type_assoc; + {type, _, map_field_exact, _} -> map_type_exact; + {type, _, record, _} -> record_type; + {type, _, field_type, _} -> record_type_field; + {type, _, range, _} -> integer_range_type; + {type, _, tuple, _} -> tuple_type; + {type, _, union, _} -> type_union; + {type, _, _, _} -> type_application; + {user_type, _, _, _} -> user_type_application; _ -> erlang:error({badarg, Node}) end. @@ -632,6 +743,7 @@ type(Node) -> %% <td>`error_marker'</td> %% </tr><tr> %% <td>`float'</td> +%% <td>`fun_type'</td> %% <td>`integer'</td> %% <td>`nil'</td> %% <td>`operator'</td> @@ -644,7 +756,13 @@ type(Node) -> %% </tr> %% </table></center> %% +%% A node of type `map_expr' is a leaf node if and only if it has no +%% argument and no fields. +%% A node of type `map_type' is a leaf node if and only if it has no +%% fields (`any_size'). %% A node of type `tuple' is a leaf node if and only if its arity is zero. +%% A node of type `tuple_type' is a leaf node if and only if it has no +%% elements (`any_size'). %% %% Note: not all literals are leaf nodes, and vice versa. E.g., %% tuples with nonzero arity and nonempty lists may be literals, but are @@ -664,6 +782,7 @@ is_leaf(Node) -> eof_marker -> true; error_marker -> true; float -> true; + fun_type -> true; integer -> true; nil -> true; operator -> true; % nonstandard type @@ -672,7 +791,9 @@ is_leaf(Node) -> map_expr -> map_expr_fields(Node) =:= [] andalso map_expr_argument(Node) =:= none; + map_type -> map_type_fields(Node) =:= any_size; tuple -> tuple_elements(Node) =:= []; + tuple_type -> tuple_type_elements(Node) =:= any_size; underscore -> true; variable -> true; warning_marker -> true; @@ -693,10 +814,9 @@ is_leaf(Node) -> %% <td>`comment'</td> %% <td>`error_marker'</td> %% <td>`eof_marker'</td> -%% <td>`form_list'</td> %% </tr><tr> +%% <td>`form_list'</td> %% <td>`function'</td> -%% <td>`rule'</td> %% <td>`warning_marker'</td> %% <td>`text'</td> %% </tr> @@ -709,7 +829,6 @@ is_leaf(Node) -> %% @see error_marker/1 %% @see form_list/1 %% @see function/2 -%% @see rule/2 %% @see warning_marker/1 -spec is_form(syntaxTree()) -> boolean(). @@ -722,7 +841,6 @@ is_form(Node) -> eof_marker -> true; error_marker -> true; form_list -> true; - rule -> true; warning_marker -> true; text -> true; _ -> false @@ -1724,7 +1842,7 @@ char_literal(Node) -> %% @doc Returns the literal string represented by a `char' %% node. This includes the leading "`$'" character. %% Depending on the encoding a character beyond 255 will be escaped -%% ('latin1') or copied as is ('utf8'). +%% (`latin1') or copied as is (`utf8'). %% %% @see char/1 @@ -1827,7 +1945,7 @@ string_literal(Node) -> %% @doc Returns the literal string represented by a `string' %% node. This includes surrounding double-quote characters. %% Depending on the encoding characters beyond 255 will be escaped -%% ('latin1') or copied as is ('utf8'). +%% (`latin1') or copied as is (`utf8'). %% %% @see string/1 @@ -1848,6 +1966,7 @@ string_literal(Node, latin1) -> %% @see atom_value/1 %% @see atom_name/1 %% @see atom_literal/1 +%% @see atom_literal/2 %% @see is_atom/2 %% type(Node) = atom @@ -1920,6 +2039,7 @@ atom_name(Node) -> %% ===================================================================== %% @doc Returns the literal string represented by an `atom' %% node. This includes surrounding single-quote characters if necessary. +%% Characters beyond 255 will be escaped. %% %% Note that e.g. the result of `atom("x\ny")' represents %% any and all of `'x\ny'', `'x\12y'', @@ -1931,8 +2051,24 @@ atom_name(Node) -> -spec atom_literal(syntaxTree()) -> string(). atom_literal(Node) -> - io_lib:write_atom(atom_value(Node)). + atom_literal(Node, latin1). +%% ===================================================================== +%% @doc Returns the literal string represented by an `atom' +%% node. This includes surrounding single-quote characters if necessary. +%% Depending on the encoding a character beyond 255 will be escaped +%% (`latin1') or copied as is (`utf8'). +%% +%% @see atom/1 +%% @see atom_literal/1 +%% @see string/1 + +atom_literal(Node, utf8) -> + io_lib:write_atom(atom_value(Node)); +atom_literal(Node, unicode) -> + io_lib:write_atom(atom_value(Node)); +atom_literal(Node, latin1) -> + io_lib:write_atom_as_latin1(atom_value(Node)). %% ===================================================================== %% @equiv map_expr(none, Fields) @@ -3128,6 +3264,39 @@ attribute(Name) -> %% `Imports' is `{Module, [{A1, N1}, ..., {Ak, Nk}]}', or %% `-import(A1.....An).', if `Imports' is `[A1, ..., An]'. %% +%% {attribute, Pos, export_type, ExportedTypes} +%% +%% ExportedTypes = [{atom(), integer()}] +%% +%% Representing `-export_type([N1/A1, ..., Nk/Ak]).', +%% if `ExportedTypes' is `[{N1, A1}, ..., {Nk, Ak}]'. +%% +%% {attribute, Pos, optional_callbacks, OptionalCallbacks} +%% +%% OptionalCallbacks = [{atom(), integer()}] +%% +%% Representing `-optional_callbacks([A1/N1, ..., Ak/Nk]).', +%% if `OptionalCallbacks' is `[{A1, N1}, ..., {Ak, Nk}]'. +%% +%% {attribute, Pos, SpecTag, {FuncSpec, FuncType}} +%% +%% SpecTag = spec | callback +%% FuncSpec = {module(), atom(), arity()} | {atom(), arity()} +%% FuncType = a (possibly constrained) function type +%% +%% Representing `-SpecTag M:F/A Ft1; ...; Ftk.' or +%% `-SpecTag F/A Ft1; ...; Ftk.', if `FuncTypes' is +%% `[Ft1, ..., Ftk]'. +%% +%% {attribute, Pos, TypeTag, {Name, Type, Parameters}} +%% +%% TypeTag = type | opaque +%% Type = a type +%% Parameters = [Variable] +%% +%% Representing `-TypeTag Name(V1, ..., Vk) :: Type .' +%% if `Parameters' is `[V1, ..., Vk]'. +%% %% {attribute, Pos, file, Position} %% %% Position = {filename(), integer()} @@ -3139,13 +3308,19 @@ attribute(Name) -> %% %% Info = {Name, [Entries]} %% Name = atom() -%% Entries = {record_field, Pos, atom()} -%% | {record_field, Pos, atom(), erl_parse()} %% -%% Representing `-record(Name, {<F1>, ..., <Fn>}).', if `Info' is +%% Entries = UntypedEntries +%% | {typed_record_field, UntypedEntries, Type} +%% UntypedEntries = {record_field, Pos, atom()} +%% | {record_field, Pos, atom(), erl_parse()} +%% +%% Representing `-record(Name, {<F1>, ..., <Fn>}).', if `Info' is %% `{Name, [D1, ..., D1]}', where each `Fi' is either `Ai = <Ei>', %% if the corresponding `Di' is `{record_field, Pos, Ai, Ei}', or -%% otherwise simply `Ai', if `Di' is `{record_field, Pos, Ai}'. +%% otherwise simply `Ai', if `Di' is `{record_field, Pos, Ai}', or +%% `Ai = <Ei> :: <Ti>', if `Di' is `{typed_record_field, +%% {record_field, Pos, Ai, Ei}, Ti}', or `Ai :: <Ti>', if `Di' is +%% `{typed_record_field, {record_field, Pos, Ai}, Ti}'. %% %% {attribute, L, Name, Term} %% @@ -3475,7 +3650,6 @@ module_qualifier_body(Node) -> %% @see function_clauses/1 %% @see function_arity/1 %% @see is_form/1 -%% @see rule/2 %% Don't use the name 'function' for this record, to avoid confusion with %% the tuples on the form {function,Name,Arity} used by erl_parse. @@ -4193,7 +4367,8 @@ record_field(Name) -> %% type(Node) = record_field %% data(Node) = #record_field{name :: Name, value :: Value} %% -%% Name = Value = syntaxTree() +%% Name = syntaxTree() +%% Value = none | syntaxTree() -spec record_field(syntaxTree(), 'none' | syntaxTree()) -> syntaxTree(). @@ -4305,49 +4480,32 @@ record_index_expr_field(Node) -> %% ===================================================================== -%% @equiv record_access(Argument, none, Field) - --spec record_access(syntaxTree(), syntaxTree()) -> syntaxTree(). - -record_access(Argument, Field) -> - record_access(Argument, none, Field). - - -%% ===================================================================== -%% @doc Creates an abstract record field access expression. If -%% `Type' is not `none', the result represents -%% "<code><em>Argument</em>#<em>Type</em>.<em>Field</em></code>". -%% -%% If `Type' is `none', the result represents -%% "<code><em>Argument</em>.<em>Field</em></code>". This is a special -%% form only allowed within Mnemosyne queries. +%% @doc Creates an abstract record field access expression. The result +%% represents "<code><em>Argument</em>#<em>Type</em>.<em>Field</em></code>". %% -%% @see record_access/2 %% @see record_access_argument/1 %% @see record_access_type/1 %% @see record_access_field/1 %% @see record_expr/3 -record(record_access, {argument :: syntaxTree(), - type :: 'none' | syntaxTree(), + type :: syntaxTree(), field :: syntaxTree()}). %% type(Node) = record_access %% data(Node) = #record_access{argument :: Argument, type :: Type, %% field :: Field} %% -%% Argument = Field = syntaxTree() -%% Type = none | syntaxTree() +%% Argument = Type = Field = syntaxTree() %% %% `erl_parse' representation: %% %% {record_field, Pos, Argument, Type, Field} -%% {record_field, Pos, Argument, Field} %% %% Argument = Field = erl_parse() %% Type = atom() --spec record_access(syntaxTree(), 'none' | syntaxTree(), syntaxTree()) -> +-spec record_access(syntaxTree(), syntaxTree(), syntaxTree()) -> syntaxTree(). record_access(Argument, Type, Field) -> @@ -4360,16 +4518,11 @@ revert_record_access(Node) -> Argument = record_access_argument(Node), Type = record_access_type(Node), Field = record_access_field(Node), - if Type =:= none -> - {record_field, Pos, Argument, Field}; - true -> - case type(Type) of - atom -> - {record_field, Pos, - Argument, concrete(Type), Field}; - _ -> - Node - end + case type(Type) of + atom -> + {record_field, Pos, Argument, concrete(Type), Field}; + _ -> + Node end. @@ -4382,8 +4535,6 @@ revert_record_access(Node) -> record_access_argument(Node) -> case unwrap(Node) of - {record_field, _, Argument, _} -> - Argument; {record_field, _, Argument, _, _} -> Argument; Node1 -> @@ -4392,21 +4543,14 @@ record_access_argument(Node) -> %% ===================================================================== -%% @doc Returns the type subtree of a `record_access' node, -%% if any. If `Node' represents -%% "<code><em>Argument</em>.<em>Field</em></code>", `none' -%% is returned, otherwise if `Node' represents -%% "<code><em>Argument</em>#<em>Type</em>.<em>Field</em></code>", -%% `Type' is returned. +%% @doc Returns the type subtree of a `record_access' node. %% %% @see record_access/3 --spec record_access_type(syntaxTree()) -> 'none' | syntaxTree(). +-spec record_access_type(syntaxTree()) -> syntaxTree(). record_access_type(Node) -> case unwrap(Node) of - {record_field, _, _, _} -> - none; {record_field, Pos, _, Type, _} -> set_pos(atom(Type), Pos); Node1 -> @@ -4423,8 +4567,6 @@ record_access_type(Node) -> record_access_field(Node) -> case unwrap(Node) of - {record_field, _, _, Field} -> - Field; {record_field, _, _, _, Field} -> Field; Node1 -> @@ -4611,7 +4753,7 @@ application(Module, Name, Arguments) -> %% %% `erl_parse' representation: %% -%% {call, Pos, Fun, Args} +%% {call, Pos, Operator, Args} %% %% Operator = erl_parse() %% Arguments = [erl_parse()] @@ -4666,6 +4808,1095 @@ application_arguments(Node) -> (data(Node1))#application.arguments end. +%% ===================================================================== +%% @doc Creates an abstract annotated type expression. The result +%% represents "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see annotated_type_name/1 +%% @see annotated_type_body/1 + +-record(annotated_type, {name :: syntaxTree(), body :: syntaxTree()}). + +%% type(Node) = annotated_type +%% data(Node) = #annotated_type{name :: Name, +%% body :: Type} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {ann_type, Pos, [Name, Type]} +%% +%% Name = erl_parse() +%% Type = erl_parse() + +-spec annotated_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +annotated_type(Name, Type) -> + tree(annotated_type, #annotated_type{name = Name, body = Type}). + +revert_annotated_type(Node) -> + Pos = get_pos(Node), + Name = annotated_type_name(Node), + Type = annotated_type_body(Node), + {ann_type, Pos, [Name, Type]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of an `annotated_type' node. +%% +%% @see annotated_type/2 + +-spec annotated_type_name(syntaxTree()) -> syntaxTree(). + +annotated_type_name(Node) -> + case unwrap(Node) of + {ann_type, _, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#annotated_type.name + end. + + +%% ===================================================================== +%% @doc Returns the type subtrees of an `annotated_type' node. +%% +%% @see annotated_type/2 + +-spec annotated_type_body(syntaxTree()) -> syntaxTree(). + +annotated_type_body(Node) -> + case unwrap(Node) of + {ann_type, _, [_, Type]} -> + Type; + Node1 -> + (data(Node1))#annotated_type.body + end. + + +%% ===================================================================== +%% @doc Creates an abstract fun of any type. The result represents +%% "<code>fun()</code>". + +%% type(Node) = fun_type +%% +%% `erl_parse' representation: +%% +%% {type, Pos, 'fun', []} + +-spec fun_type() -> syntaxTree(). + +fun_type() -> + tree(fun_type). + +revert_fun_type(Node) -> + Pos = get_pos(Node), + {type, Pos, 'fun', []}. + + +%% ===================================================================== +%% @doc Creates an abstract type application expression. If +%% `Module' is `none', this is call is equivalent +%% to `type_application(TypeName, Arguments)', otherwise it is +%% equivalent to `type_application(module_qualifier(Module, TypeName), +%% Arguments)'. +%% +%% (This is a utility function.) +%% +%% @see type_application/2 +%% @see module_qualifier/2 + +-spec type_application('none' | syntaxTree(), syntaxTree(), [syntaxTree()]) -> + syntaxTree(). + +type_application(none, TypeName, Arguments) -> + type_application(TypeName, Arguments); +type_application(Module, TypeName, Arguments) -> + type_application(module_qualifier(Module, TypeName), Arguments). + + +%% ===================================================================== +%% @doc Creates an abstract type application expression. If `Arguments' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>TypeName</em>(<em>T1</em>, ...<em>Tn</em>)</code>". +%% +%% @see user_type_application/2 +%% @see type_application/3 +%% @see type_application_name/1 +%% @see type_application_arguments/1 + +-record(type_application, {type_name :: syntaxTree(), + arguments :: [syntaxTree()]}). + +%% type(Node) = type_application +%% data(Node) = #type_application{type_name :: TypeName, +%% arguments :: Arguments} +%% +%% TypeName = syntaxTree() +%% Arguments = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {remote, Pos, [Module, Name, Arguments]} | +%% {type, Pos, Name, Arguments} +%% +%% Module = erl_parse() +%% Name = atom() +%% Arguments = [erl_parse()] + +-spec type_application(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +type_application(TypeName, Arguments) -> + tree(type_application, + #type_application{type_name = TypeName, arguments = Arguments}). + +revert_type_application(Node) -> + Pos = get_pos(Node), + TypeName = type_application_name(Node), + Arguments = type_application_arguments(Node), + case type(TypeName) of + module_qualifier -> + Module = module_qualifier_argument(TypeName), + Name = module_qualifier_body(TypeName), + {remote_type, Pos, [Module, Name, Arguments]}; + atom -> + {type, Pos, atom_value(TypeName), Arguments} + end. + + +%% ===================================================================== +%% @doc Returns the type name subtree of a `type_application' node. +%% +%% @see type_application/2 + +-spec type_application_name(syntaxTree()) -> syntaxTree(). + +type_application_name(Node) -> + case unwrap(Node) of + {remote_type, _, [Module, Name, _]} -> + module_qualifier(Module, Name); + {type, Pos, Name, _} -> + set_pos(atom(Name), Pos); + Node1 -> + (data(Node1))#type_application.type_name + end. + + +%% ===================================================================== +%% @doc Returns the arguments subtrees of a `type_application' node. +%% +%% @see type_application/2 + +-spec type_application_arguments(syntaxTree()) -> [syntaxTree()]. + +type_application_arguments(Node) -> + case unwrap(Node) of + {remote_type, _, [_, _, Arguments]} -> + Arguments; + {type, _, _, Arguments} -> + Arguments; + Node1 -> + (data(Node1))#type_application.arguments + end. + + +%% ===================================================================== +%% @doc Creates an abstract bitstring type. The result represents +%% "<code><em><<_:M, _:_*N>></em></code>". +%% +%% @see bitstring_type_m/1 +%% @see bitstring_type_n/1 + +-record(bitstring_type, {m :: syntaxTree(), n :: syntaxTree()}). + +%% type(Node) = bitstring_type +%% data(Node) = #bitstring_type{m :: M, n :: N} +%% +%% M = syntaxTree() +%% N = syntaxTree() +%% + +-spec bitstring_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +bitstring_type(M, N) -> + tree(bitstring_type, #bitstring_type{m = M, n =N}). + +revert_bitstring_type(Node) -> + Pos = get_pos(Node), + M = bitstring_type_m(Node), + N = bitstring_type_n(Node), + {type, Pos, binary, [M, N]}. + +%% ===================================================================== +%% @doc Returns the number of start bits, `M', of a `bitstring_type' node. +%% +%% @see bitstring_type/2 + +-spec bitstring_type_m(syntaxTree()) -> syntaxTree(). + +bitstring_type_m(Node) -> + case unwrap(Node) of + {type, _, binary, [M, _]} -> + M; + Node1 -> + (data(Node1))#bitstring_type.m + end. + +%% ===================================================================== +%% @doc Returns the segment size, `N', of a `bitstring_type' node. +%% +%% @see bitstring_type/2 + +-spec bitstring_type_n(syntaxTree()) -> syntaxTree(). + +bitstring_type_n(Node) -> + case unwrap(Node) of + {type, _, binary, [_, N]} -> + N; + Node1 -> + (data(Node1))#bitstring_type.n + end. + + +%% ===================================================================== +%% @doc Creates an abstract constrained function type. +%% If `FunctionConstraint' is `[C1, ..., Cn]', the result represents +%% "<code><em>FunctionType</em> when <em>C1</em>, ...<em>Cn</em></code>". +%% +%% @see constrained_function_type_body/1 +%% @see constrained_function_type_argument/1 + +-record(constrained_function_type, {body :: syntaxTree(), + argument :: syntaxTree()}). + +%% type(Node) = constrained_function_type +%% data(Node) = #constrained_function_type{body :: FunctionType, +%% argument :: FunctionConstraint} +%% +%% FunctionType = syntaxTree() +%% FunctionConstraint = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, bounded_fun, [FunctionType, FunctionConstraint]} +%% +%% FunctionType = erl_parse() +%% FunctionConstraint = [erl_parse()] + +-spec constrained_function_type(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +constrained_function_type(FunctionType, FunctionConstraint) -> + Conj = conjunction(FunctionConstraint), + tree(constrained_function_type, + #constrained_function_type{body = FunctionType, + argument = Conj}). + +revert_constrained_function_type(Node) -> + Pos = get_pos(Node), + FunctionType = constrained_function_type_body(Node), + FunctionConstraint = + conjunction_body(constrained_function_type_argument(Node)), + {type, Pos, bounded_fun, [FunctionType, FunctionConstraint]}. + + +%% ===================================================================== +%% @doc Returns the function type subtree of a +%% `constrained_function_type' node. +%% +%% @see constrained_function_type/2 + +-spec constrained_function_type_body(syntaxTree()) -> syntaxTree(). + +constrained_function_type_body(Node) -> + case unwrap(Node) of + {type, _, bounded_fun, [FunctionType, _]} -> + FunctionType; + Node1 -> + (data(Node1))#constrained_function_type.body + end. + +%% ===================================================================== +%% @doc Returns the function constraint subtree of a +%% `constrained_function_type' node. +%% +%% @see constrained_function_type/2 + +-spec constrained_function_type_argument(syntaxTree()) -> syntaxTree(). + +constrained_function_type_argument(Node) -> + case unwrap(Node) of + {type, _, bounded_fun, [_, FunctionConstraint]} -> + conjunction(FunctionConstraint); + Node1 -> + (data(Node1))#constrained_function_type.argument + end. + + +%% ===================================================================== +%% @equiv function_type(any_arity, Type) + +function_type(Type) -> + function_type(any_arity, Type). + +%% ===================================================================== +%% @doc Creates an abstract function type. If `Arguments' is +%% `[T1, ..., Tn]', then if it occurs within a function +%% specification, the result represents +%% "<code>(<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em></code>"; otherwise +%% it represents +%% "<code>fun((<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em>)</code>". +%% If `Arguments' is `any_arity', it represents +%% "<code>fun((...) -> <em>Return</em>)</code>". +%% +%% Note that the `erl_parse' representation is identical for +%% "<code><em>FunctionType</em></code>" and +%% "<code>fun(<em>FunctionType</em>)</code>". +%% +%% @see function_type_arguments/1 +%% @see function_type_return/1 + +-record(function_type, {arguments :: any_arity | [syntaxTree()], + return :: syntaxTree()}). + +%% type(Node) = function_type +%% data(Node) = #function_type{arguments :: any | Arguments, +%% return :: Type} +%% +%% Arguments = [syntaxTree()] +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, 'fun', [{type, Pos, product, Arguments}, Type]} +%% {type, Pos, 'fun', [{type, Pos, any}, Type]} +%% +%% Arguments = [erl_parse()] +%% Type = erl_parse() + +-spec function_type('any_arity' | syntaxTree(), syntaxTree()) -> syntaxTree(). + +function_type(Arguments, Return) -> + tree(function_type, + #function_type{arguments = Arguments, return = Return}). + +revert_function_type(Node) -> + Pos = get_pos(Node), + Type = function_type_return(Node), + case function_type_arguments(Node) of + any_arity -> + {type, Pos, 'fun', [{type, Pos, any}, Type]}; + Arguments -> + {type, Pos, 'fun', [{type, Pos, product, Arguments}, Type]} + end. + + +%% ===================================================================== +%% @doc Returns the argument types subtrees of a `function_type' node. +%% If `Node' represents "<code>fun((...) -> <em>Return</em>)</code>", +%% `any_arity' is returned; otherwise, if `Node' represents +%% "<code>(<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em></code>" or +%% "<code>fun((<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em>)</code>", +%% `[T1, ..., Tn]' is returned. + +%% +%% @see function_type/1 +%% @see function_type/2 + +-spec function_type_arguments(syntaxTree()) -> any_arity | [syntaxTree()]. + +function_type_arguments(Node) -> + case unwrap(Node) of + {type, _, 'fun', [{type, _, any}, _]} -> + any_arity; + {type, _, 'fun', [{type, _, product, Arguments}, _]} -> + Arguments; + Node1 -> + (data(Node1))#function_type.arguments + end. + +%% ===================================================================== +%% @doc Returns the return type subtrees of a `function_type' node. +%% +%% @see function_type/1 +%% @see function_type/2 + +-spec function_type_return(syntaxTree()) -> syntaxTree(). + +function_type_return(Node) -> + case unwrap(Node) of + {type, _, 'fun', [_, Type]} -> + Type; + Node1 -> + (data(Node1))#function_type.return + end. + + +%% ===================================================================== +%% @doc Creates an abstract (subtype) constraint. The result represents +%% "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see constraint_argument/1 +%% @see constraint_body/1 + +-record(constraint, {name :: syntaxTree(), + types :: [syntaxTree()]}). + +%% type(Node) = constraint +%% data(Node) = #constraint{name :: Name, +%% types :: [Type]} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, constraint, [Name, [Var, Type]]} +%% +%% Name = {atom, Pos, is_subtype} +%% Var = erl_parse() +%% Type = erl_parse() + +-spec constraint(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +constraint(Name, Types) -> + tree(constraint, + #constraint{name = Name, types = Types}). + +revert_constraint(Node) -> + Pos = get_pos(Node), + Name = constraint_argument(Node), + Types = constraint_body(Node), + {type, Pos, constraint, [Name, Types]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `constraint' node. +%% +%% @see constraint/2 + +-spec constraint_argument(syntaxTree()) -> syntaxTree(). + +constraint_argument(Node) -> + case unwrap(Node) of + {type, _, constraint, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#constraint.name + end. + +%% ===================================================================== +%% @doc Returns the type subtree of a `constraint' node. +%% +%% @see constraint/2 + +-spec constraint_body(syntaxTree()) -> [syntaxTree()]. + +constraint_body(Node) -> + case unwrap(Node) of + {type, _, constraint, [_, Types]} -> + Types; + Node1 -> + (data(Node1))#constraint.types + end. + + +%% ===================================================================== +%% @doc Creates an abstract map type assoc field. The result represents +%% "<code><em>Name</em> => <em>Value</em></code>". +%% +%% @see map_type_assoc_name/1 +%% @see map_type_assoc_value/1 +%% @see map_type/1 + +-record(map_type_assoc, {name :: syntaxTree(), value :: syntaxTree()}). + +%% `erl_parse' representation: +%% +%% {type, Pos, map_field_assoc, [Name, Value]} + +-spec map_type_assoc(syntaxTree(), syntaxTree()) -> syntaxTree(). + +map_type_assoc(Name, Value) -> + tree(map_type_assoc, #map_type_assoc{name = Name, value = Value}). + +revert_map_type_assoc(Node) -> + Pos = get_pos(Node), + Name = map_type_assoc_name(Node), + Value = map_type_assoc_value(Node), + {type, Pos, map_type_assoc, [Name, Value]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `map_type_assoc' node. +%% +%% @see map_type_assoc/2 + +-spec map_type_assoc_name(syntaxTree()) -> syntaxTree(). + +map_type_assoc_name(Node) -> + case Node of + {type, _, map_field_assoc, [Name, _]} -> + Name; + _ -> + (data(Node))#map_type_assoc.name + end. + + +%% ===================================================================== +%% @doc Returns the value subtree of a `map_type_assoc' node. +%% +%% @see map_type_assoc/2 + +-spec map_type_assoc_value(syntaxTree()) -> syntaxTree(). + +map_type_assoc_value(Node) -> + case Node of + {type, _, map_field_assoc, [_, Value]} -> + Value; + _ -> + (data(Node))#map_type_assoc.value + end. + + +%% ===================================================================== +%% @doc Creates an abstract map type exact field. The result represents +%% "<code><em>Name</em> := <em>Value</em></code>". +%% +%% @see map_type_exact_name/1 +%% @see map_type_exact_value/1 +%% @see map_type/1 + +-record(map_type_exact, {name :: syntaxTree(), value :: syntaxTree()}). + +%% `erl_parse' representation: +%% +%% {type, Pos, map_field_exact, [Name, Value]} + +-spec map_type_exact(syntaxTree(), syntaxTree()) -> syntaxTree(). + +map_type_exact(Name, Value) -> + tree(map_type_exact, #map_type_exact{name = Name, value = Value}). + +revert_map_type_exact(Node) -> + Pos = get_pos(Node), + Name = map_type_exact_name(Node), + Value = map_type_exact_value(Node), + {type, Pos, map_type_exact, [Name, Value]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `map_type_exact' node. +%% +%% @see map_type_exact/2 + +-spec map_type_exact_name(syntaxTree()) -> syntaxTree(). + +map_type_exact_name(Node) -> + case Node of + {type, _, map_field_exact, [Name, _]} -> + Name; + _ -> + (data(Node))#map_type_exact.name + end. + + +%% ===================================================================== +%% @doc Returns the value subtree of a `map_type_exact' node. +%% +%% @see map_type_exact/2 + +-spec map_type_exact_value(syntaxTree()) -> syntaxTree(). + +map_type_exact_value(Node) -> + case Node of + {type, _, map_field_exact, [_, Value]} -> + Value; + _ -> + (data(Node))#map_type_exact.value + end. + + +%% ===================================================================== +%% @equiv map_type(any_size) + +map_type() -> + map_type(any_size). + +%% ===================================================================== +%% @doc Creates an abstract type map. If `Fields' is +%% `[F1, ..., Fn]', the result represents +%% "<code>#{<em>F1</em>, ..., <em>Fn</em>}</code>"; +%% otherwise, if `Fields' is `any_size', it represents +%% "<code>map()</code>". +%% +%% @see map_type_fields/1 + +%% type(Node) = map_type +%% data(Node) = Fields +%% +%% Fields = any_size | [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, map, [Field]} +%% {type, Pos, map, any} +%% +%% Field = erl_parse() + +-spec map_type('any_size' | [syntaxTree()]) -> syntaxTree(). + +map_type(Fields) -> + tree(map_type, Fields). + +revert_map_type(Node) -> + Pos = get_pos(Node), + {type, Pos, map, map_type_fields(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of field subtrees of a `map_type' node. +%% If `Node' represents "<code>map()</code>", `any_size' is returned; +%% otherwise, if `Node' represents +%% "<code>#{<em>F1</em>, ..., <em>Fn</em>}</code>", +%% `[F1, ..., Fn]' is returned. +%% +%% @see map_type/0 +%% @see map_type/1 + +-spec map_type_fields(syntaxTree()) -> 'any_size' | [syntaxTree()]. + +map_type_fields(Node) -> + case unwrap(Node) of + {type, _, map, Fields} when is_list(Fields) -> + Fields; + {type, _, map, any} -> + any_size; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract range type. The result represents +%% "<code><em>Low</em> .. <em>High</em></code>". +%% +%% @see integer_range_type_low/1 +%% @see integer_range_type_high/1 + +-record(integer_range_type, {low :: syntaxTree(), + high :: syntaxTree()}). + +%% type(Node) = integer_range_type +%% data(Node) = #integer_range_type{low :: Low, high :: High} +%% +%% Low = syntaxTree() +%% High = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, range, [Low, High]} +%% +%% Low = erl_parse() +%% High = erl_parse() + +-spec integer_range_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +integer_range_type(Low, High) -> + tree(integer_range_type, #integer_range_type{low = Low, high = High}). + +revert_integer_range_type(Node) -> + Pos = get_pos(Node), + Low = integer_range_type_low(Node), + High = integer_range_type_high(Node), + {type, Pos, range, [Low, High]}. + + +%% ===================================================================== +%% @doc Returns the low limit of an `integer_range_type' node. +%% +%% @see integer_range_type/2 + +-spec integer_range_type_low(syntaxTree()) -> syntaxTree(). + +integer_range_type_low(Node) -> + case unwrap(Node) of + {type, _, range, [Low, _]} -> + Low; + Node1 -> + (data(Node1))#integer_range_type.low + end. + +%% ===================================================================== +%% @doc Returns the high limit of an `integer_range_type' node. +%% +%% @see integer_range_type/2 + +-spec integer_range_type_high(syntaxTree()) -> syntaxTree(). + +integer_range_type_high(Node) -> + case unwrap(Node) of + {type, _, range, [_, High]} -> + High; + Node1 -> + (data(Node1))#integer_range_type.high + end. + + +%% ===================================================================== +%% @doc Creates an abstract record type. If `Fields' is +%% `[F1, ..., Fn]', the result represents +%% "<code>#<em>Name</em>{<em>F1</em>, ..., <em>Fn</em>}</code>". +%% +%% @see record_type_name/1 +%% @see record_type_fields/1 + +-record(record_type, {name :: syntaxTree(), + fields :: [syntaxTree()]}). + +%% type(Node) = record_type +%% data(Node) = #record_type{name = Name, fields = Fields} +%% +%% Name = syntaxTree() +%% Fields = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, record, [Name|Fields]} +%% +%% Name = erl_parse() +%% Fields = [erl_parse()] + +-spec record_type(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +record_type(Name, Fields) -> + tree(record_type, #record_type{name = Name, fields = Fields}). + +revert_record_type(Node) -> + Pos = get_pos(Node), + Name = record_type_name(Node), + Fields = record_type_fields(Node), + {type, Pos, record, [Name | Fields]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `record_type' node. +%% +%% @see record_type/2 + +-spec record_type_name(syntaxTree()) -> syntaxTree(). + +record_type_name(Node) -> + case unwrap(Node) of + {type, _, record, [Name|_]} -> + Name; + Node1 -> + (data(Node1))#record_type.name + end. + +%% ===================================================================== +%% @doc Returns the fields subtree of a `record_type' node. +%% +%% @see record_type/2 + +-spec record_type_fields(syntaxTree()) -> [syntaxTree()]. + +record_type_fields(Node) -> + case unwrap(Node) of + {type, _, record, [_|Fields]} -> + Fields; + Node1 -> + (data(Node1))#record_type.fields + end. + + +%% ===================================================================== +%% @doc Creates an abstract record type field. The result represents +%% "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see record_type_field_name/1 +%% @see record_type_field_type/1 + +-record(record_type_field, {name :: syntaxTree(), + type :: syntaxTree()}). + +%% type(Node) = record_type_field +%% data(Node) = #record_type_field{name = Name, type = Type} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, field_type, [Name, Type]} +%% +%% Name = erl_parse() +%% Type = erl_parse() + +-spec record_type_field(syntaxTree(), syntaxTree()) -> syntaxTree(). + +record_type_field(Name, Type) -> + tree(record_type_field, #record_type_field{name = Name, type = Type}). + +revert_record_type_field(Node) -> + Pos = get_pos(Node), + Name = record_type_field_name(Node), + Type = record_type_field_type(Node), + {type, Pos, field_type, [Name, Type]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `record_type_field' node. +%% +%% @see record_type_field/2 + +-spec record_type_field_name(syntaxTree()) -> syntaxTree(). + +record_type_field_name(Node) -> + case unwrap(Node) of + {type, _, field_type, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#record_type_field.name + end. + +%% ===================================================================== +%% @doc Returns the type subtree of a `record_type_field' node. +%% +%% @see record_type_field/2 + +-spec record_type_field_type(syntaxTree()) -> syntaxTree(). + +record_type_field_type(Node) -> + case unwrap(Node) of + {type, _, field_type, [_, Type]} -> + Type; + Node1 -> + (data(Node1))#record_type_field.type + end. + + +%% ===================================================================== +%% @equiv tuple_type(any_size) + +tuple_type() -> + tuple_type(any_size). + +%% ===================================================================== +%% @doc Creates an abstract type tuple. If `Elements' is +%% `[T1, ..., Tn]', the result represents +%% "<code>{<em>T1</em>, ..., <em>Tn</em>}</code>"; +%% otherwise, if `Elements' is `any_size', it represents +%% "<code>tuple()</code>". +%% +%% @see tuple_type_elements/1 + +%% type(Node) = tuple_type +%% data(Node) = Elements +%% +%% Elements = any_size | [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, tuple, [Element]} +%% {type, Pos, tuple, any} +%% +%% Element = erl_parse() + +-spec tuple_type(any_size | [syntaxTree()]) -> syntaxTree(). + +tuple_type(Elements) -> + tree(tuple_type, Elements). + +revert_tuple_type(Node) -> + Pos = get_pos(Node), + {type, Pos, tuple, tuple_type_elements(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of type element subtrees of a `tuple_type' node. +%% If `Node' represents "<code>tuple()</code>", `any_size' is returned; +%% otherwise, if `Node' represents +%% "<code>{<em>T1</em>, ..., <em>Tn</em>}</code>", +%% `[T1, ..., Tn]' is returned. +%% +%% @see tuple_type/0 +%% @see tuple_type/1 + +-spec tuple_type_elements(syntaxTree()) -> 'any_size' | [syntaxTree()]. + +tuple_type_elements(Node) -> + case unwrap(Node) of + {type, _, tuple, Elements} when is_list(Elements) -> + Elements; + {type, _, tuple, any} -> + any_size; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract type union. If `Types' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>T1</em> | ... | <em>Tn</em></code>". +%% +%% @see type_union_types/1 + +%% type(Node) = type_union +%% data(Node) = Types +%% +%% Types = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, union, Elements} +%% +%% Elements = [erl_parse()] + +-spec type_union([syntaxTree()]) -> syntaxTree(). + +type_union(Types) -> + tree(type_union, Types). + +revert_type_union(Node) -> + Pos = get_pos(Node), + {type, Pos, union, type_union_types(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of type subtrees of a `type_union' node. +%% +%% @see type_union/1 + +-spec type_union_types(syntaxTree()) -> [syntaxTree()]. + +type_union_types(Node) -> + case unwrap(Node) of + {type, _, union, Types} when is_list(Types) -> + Types; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract user type. If `Arguments' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>TypeName</em>(<em>T1</em>, ...<em>Tn</em>)</code>". +%% +%% @see type_application/2 +%% @see user_type_application_name/1 +%% @see user_type_application_arguments/1 + +-record(user_type_application, {type_name :: syntaxTree(), + arguments :: [syntaxTree()]}). + +%% type(Node) = user_type_application +%% data(Node) = #user_type_application{type_name :: TypeName, +%% arguments :: Arguments} +%% +%% TypeName = syntaxTree() +%% Arguments = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {user_type, Pos, Name, Arguments} +%% +%% Name = erl_parse() +%% Arguments = [Type] +%% Type = erl_parse() + +-spec user_type_application(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +user_type_application(TypeName, Arguments) -> + tree(user_type_application, + #user_type_application{type_name = TypeName, arguments = Arguments}). + +revert_user_type_application(Node) -> + Pos = get_pos(Node), + TypeName = user_type_application_name(Node), + Arguments = user_type_application_arguments(Node), + {user_type, Pos, atom_value(TypeName), Arguments}. + + +%% ===================================================================== +%% @doc Returns the type name subtree of a `user_type_application' node. +%% +%% @see user_type_application/2 + +-spec user_type_application_name(syntaxTree()) -> syntaxTree(). + +user_type_application_name(Node) -> + case unwrap(Node) of + {user_type, Pos, Name, _} -> + set_pos(atom(Name), Pos); + Node1 -> + (data(Node1))#user_type_application.type_name + end. + + +%% ===================================================================== +%% @doc Returns the arguments subtrees of a `user_type_application' node. +%% +%% @see user_type_application/2 + +-spec user_type_application_arguments(syntaxTree()) -> [syntaxTree()]. + +user_type_application_arguments(Node) -> + case unwrap(Node) of + {user_type, _, _, Arguments} -> + Arguments; + Node1 -> + (data(Node1))#user_type_application.arguments + end. + + +%% ===================================================================== +%% @doc Creates an abstract typed record field specification. The +%% result represents "<code><em>Field</em> :: <em>Type</em></code>". +%% +%% @see typed_record_field_body/1 +%% @see typed_record_field_type/1 + +-record(typed_record_field, {body :: syntaxTree(), + type :: syntaxTree()}). + +%% type(Node) = typed_record_field +%% data(Node) = #typed_record_field{body :: Field +%% type = Type} +%% +%% Field = syntaxTree() +%% Type = syntaxTree() + +-spec typed_record_field(syntaxTree(), syntaxTree()) -> syntaxTree(). + +typed_record_field(Field, Type) -> + tree(typed_record_field, + #typed_record_field{body = Field, type = Type}). + + +%% ===================================================================== +%% @doc Returns the field subtree of a `typed_record_field' node. +%% +%% @see typed_record_field/2 + +-spec typed_record_field_body(syntaxTree()) -> syntaxTree(). + +typed_record_field_body(Node) -> + (data(Node))#typed_record_field.body. + + +%% ===================================================================== +%% @doc Returns the type subtree of a `typed_record_field' node. +%% +%% @see typed_record_field/2 + +-spec typed_record_field_type(syntaxTree()) -> syntaxTree(). + +typed_record_field_type(Node) -> + (data(Node))#typed_record_field.type. + %% ===================================================================== %% @doc Creates an abstract list comprehension. If `Body' is @@ -4803,117 +6034,6 @@ binary_comp_body(Node) -> %% ===================================================================== -%% @doc Creates an abstract Mnemosyne rule. If `Clauses' is -%% `[C1, ..., Cn]', the results represents -%% "<code><em>Name</em> <em>C1</em>; ...; <em>Name</em> -%% <em>Cn</em>.</code>". More exactly, if each `Ci' -%% represents "<code>(<em>Pi1</em>, ..., <em>Pim</em>) <em>Gi</em> -> -%% <em>Bi</em></code>", then the result represents -%% "<code><em>Name</em>(<em>P11</em>, ..., <em>P1m</em>) <em>G1</em> :- -%% <em>B1</em>; ...; <em>Name</em>(<em>Pn1</em>, ..., <em>Pnm</em>) -%% <em>Gn</em> :- <em>Bn</em>.</code>". Rules are source code forms. -%% -%% @see rule_name/1 -%% @see rule_clauses/1 -%% @see rule_arity/1 -%% @see is_form/1 -%% @see function/2 - --record(rule, {name :: syntaxTree(), clauses :: [syntaxTree()]}). - -%% type(Node) = rule -%% data(Node) = #rule{name :: Name, clauses :: Clauses} -%% -%% Name = syntaxTree() -%% Clauses = [syntaxTree()] -%% -%% (See `function' for notes on why the arity is not stored.) -%% -%% `erl_parse' representation: -%% -%% {rule, Pos, Name, Arity, Clauses} -%% -%% Name = atom() -%% Arity = integer() -%% Clauses = [Clause] \ [] -%% Clause = {clause, ...} -%% -%% where the number of patterns in each clause should be equal to -%% the integer `Arity'; see `clause' for documentation on -%% `erl_parse' clauses. - --spec rule(syntaxTree(), [syntaxTree()]) -> syntaxTree(). - -rule(Name, Clauses) -> - tree(rule, #rule{name = Name, clauses = Clauses}). - -revert_rule(Node) -> - Name = rule_name(Node), - Clauses = [revert_clause(C) || C <- rule_clauses(Node)], - Pos = get_pos(Node), - case type(Name) of - atom -> - A = rule_arity(Node), - {rule, Pos, concrete(Name), A, Clauses}; - _ -> - Node - end. - - -%% ===================================================================== -%% @doc Returns the name subtree of a `rule' node. -%% -%% @see rule/2 - --spec rule_name(syntaxTree()) -> syntaxTree(). - -rule_name(Node) -> - case unwrap(Node) of - {rule, Pos, Name, _, _} -> - set_pos(atom(Name), Pos); - Node1 -> - (data(Node1))#rule.name - end. - -%% ===================================================================== -%% @doc Returns the list of clause subtrees of a `rule' node. -%% -%% @see rule/2 - --spec rule_clauses(syntaxTree()) -> [syntaxTree()]. - -rule_clauses(Node) -> - case unwrap(Node) of - {rule, _, _, _, Clauses} -> - Clauses; - Node1 -> - (data(Node1))#rule.clauses - end. - -%% ===================================================================== -%% @doc Returns the arity of a `rule' node. The result is the -%% number of parameter patterns in the first clause of the rule; -%% subsequent clauses are ignored. -%% -%% An exception is thrown if `rule_clauses(Node)' returns -%% an empty list, or if the first element of that list is not a syntax -%% tree `C' of type `clause' such that -%% `clause_patterns(C)' is a nonempty list. -%% -%% @see rule/2 -%% @see rule_clauses/1 -%% @see clause/3 -%% @see clause_patterns/1 - --spec rule_arity(syntaxTree()) -> arity(). - -rule_arity(Node) -> - %% Note that this never accesses the arity field of - %% `erl_parse' rule nodes. - length(clause_patterns(hd(rule_clauses(Node)))). - - -%% ===================================================================== %% @doc Creates an abstract generator. The result represents %% "<code><em>Pattern</em> <- <em>Body</em></code>". %% @@ -6135,6 +7255,13 @@ abstract_tail(H, T) -> %% {@link char/1} function to explicitly create an abstract %% character.) %% +%% Note: `arity_qualifier' nodes are recognized. This is to follow The +%% Erlang Parser when it comes to wild attributes: both {F, A} and F/A +%% are recognized, which makes it possible to turn wild attributes +%% into recognized attributes without at the same time making it +%% impossible to compile files using the new syntax with the old +%% version of the Erlang Compiler. +%% %% @see abstract/1 %% @see is_literal/1 %% @see char/1 @@ -6184,6 +7311,20 @@ concrete(Node) -> {value, concrete(F), []} end, [], true), B; + arity_qualifier -> + A = erl_syntax:arity_qualifier_argument(Node), + case erl_syntax:type(A) of + integer -> + F = erl_syntax:arity_qualifier_body(Node), + case erl_syntax:type(F) of + atom -> + {F, A}; + _ -> + erlang:error({badarg, Node}) + end; + _ -> + erlang:error({badarg, Node}) + end; _ -> erlang:error({badarg, Node}) end. @@ -6301,6 +7442,8 @@ revert(Node) -> revert_root(Node) -> case type(Node) of + annotated_type -> + revert_annotated_type(Node); application -> revert_application(Node); atom -> @@ -6315,6 +7458,8 @@ revert_root(Node) -> revert_binary_field(Node); binary_generator -> revert_binary_generator(Node); + bitstring_type -> + revert_bitstring_type(Node); block_expr -> revert_block_expr(Node); case_expr -> @@ -6327,6 +7472,10 @@ revert_root(Node) -> revert_clause(Node); cond_expr -> revert_cond_expr(Node); + constrained_function_type -> + revert_constrained_function_type(Node); + constraint -> + revert_constraint(Node); eof_marker -> revert_eof_marker(Node); error_marker -> @@ -6335,8 +7484,12 @@ revert_root(Node) -> revert_float(Node); fun_expr -> revert_fun_expr(Node); + fun_type -> + revert_fun_type(Node); function -> revert_function(Node); + function_type -> + revert_function_type(Node); generator -> revert_generator(Node); if_expr -> @@ -6347,6 +7500,8 @@ revert_root(Node) -> revert_infix_expr(Node); integer -> revert_integer(Node); + integer_range_type -> + revert_integer_range_type(Node); list -> revert_list(Node); list_comp -> @@ -6357,6 +7512,12 @@ revert_root(Node) -> revert_map_field_assoc(Node); map_field_exact -> revert_map_field_exact(Node); + map_type -> + revert_map_type(Node); + map_type_assoc -> + revert_map_type_assoc(Node); + map_type_exact -> + revert_map_type_exact(Node); match_expr -> revert_match_expr(Node); module_qualifier -> @@ -6377,16 +7538,26 @@ revert_root(Node) -> revert_record_expr(Node); record_index_expr -> revert_record_index_expr(Node); - rule -> - revert_rule(Node); + record_type -> + revert_record_type(Node); + record_type_field -> + revert_record_type_field(Node); + type_application -> + revert_type_application(Node); + type_union -> + revert_type_union(Node); string -> revert_string(Node); try_expr -> revert_try_expr(Node); tuple -> revert_tuple(Node); + tuple_type -> + revert_tuple_type(Node); underscore -> revert_underscore(Node); + user_type_application -> + revert_user_type_application(Node); variable -> revert_variable(Node); warning_marker -> @@ -6514,6 +7685,9 @@ subtrees(T) -> []; false -> case type(T) of + annotated_type -> + [[annotated_type_name(T)], + [annotated_type_body(T)]]; application -> [[application_operator(T)], application_arguments(T)]; @@ -6542,6 +7716,9 @@ subtrees(T) -> binary_generator -> [[binary_generator_pattern(T)], [binary_generator_body(T)]]; + bitstring_type -> + [[bitstring_type_m(T)], + [bitstring_type_n(T)]]; block_expr -> [block_expr_body(T)]; case_expr -> @@ -6564,14 +7741,30 @@ subtrees(T) -> [cond_expr_clauses(T)]; conjunction -> [conjunction_body(T)]; + constrained_function_type -> + C = constrained_function_type_argument(T), + [[constrained_function_type_body(T)], + conjunction_body(C)]; + constraint -> + [[constraint_argument(T)], + constraint_body(T)]; disjunction -> [disjunction_body(T)]; form_list -> [form_list_elements(T)]; fun_expr -> [fun_expr_clauses(T)]; + fun_type -> + []; function -> [[function_name(T)], function_clauses(T)]; + function_type -> + case function_type_arguments(T) of + any_arity -> + [[function_type_return(T)]]; + As -> + [As,[function_type_return(T)]] + end; generator -> [[generator_pattern(T)], [generator_body(T)]]; if_expr -> @@ -6582,6 +7775,9 @@ subtrees(T) -> [[infix_expr_left(T)], [infix_expr_operator(T)], [infix_expr_right(T)]]; + integer_range_type -> + [[integer_range_type_low(T)], + [integer_range_type_high(T)]]; list -> case list_suffix(T) of none -> @@ -6611,6 +7807,14 @@ subtrees(T) -> map_field_exact -> [[map_field_exact_name(T)], [map_field_exact_value(T)]]; + map_type -> + [map_type_fields(T)]; + map_type_assoc -> + [[map_type_assoc_name(T)], + [map_type_assoc_value(T)]]; + map_type_exact -> + [[map_type_exact_name(T)], + [map_type_exact_value(T)]]; match_expr -> [[match_expr_pattern(T)], [match_expr_body(T)]]; @@ -6635,15 +7839,9 @@ subtrees(T) -> receive_expr_action(T)] end; record_access -> - case record_access_type(T) of - none -> - [[record_access_argument(T)], - [record_access_field(T)]]; - R -> - [[record_access_argument(T)], - [R], - [record_access_field(T)]] - end; + [[record_access_argument(T)], + [record_access_type(T)], + [record_access_field(T)]]; record_expr -> case record_expr_argument(T) of none -> @@ -6664,8 +7862,12 @@ subtrees(T) -> record_index_expr -> [[record_index_expr_type(T)], [record_index_expr_field(T)]]; - rule -> - [[rule_name(T)], rule_clauses(T)]; + record_type -> + [[record_type_name(T)], + record_type_fields(T)]; + record_type_field -> + [[record_type_field_name(T)], + [record_type_field_type(T)]]; size_qualifier -> [[size_qualifier_body(T)], [size_qualifier_argument(T)]]; @@ -6675,7 +7877,20 @@ subtrees(T) -> try_expr_handlers(T), try_expr_after(T)]; tuple -> - [tuple_elements(T)] + [tuple_elements(T)]; + tuple_type -> + [tuple_type_elements(T)]; + type_application -> + [[type_application_name(T)], + type_application_arguments(T)]; + type_union -> + [type_union_types(T)]; + typed_record_field -> + [[typed_record_field_body(T)], + [typed_record_field_type(T)]]; + user_type_application -> + [[user_type_application_name(T)], + user_type_application_arguments(T)] end end. @@ -6719,6 +7934,7 @@ update_tree(Node, Groups) -> -spec make_tree(atom(), [[syntaxTree()]]) -> syntaxTree(). +make_tree(annotated_type, [[N], [T]]) -> annotated_type(N, T); make_tree(application, [[F], A]) -> application(F, A); make_tree(arity_qualifier, [[N], [A]]) -> arity_qualifier(N, A); make_tree(attribute, [[N]]) -> attribute(N); @@ -6728,6 +7944,7 @@ make_tree(binary_comp, [[T], B]) -> binary_comp(T, B); make_tree(binary_field, [[B]]) -> binary_field(B); make_tree(binary_field, [[B], Ts]) -> binary_field(B, Ts); make_tree(binary_generator, [[P], [E]]) -> binary_generator(P, E); +make_tree(bitstring_type, [[M], [N]]) -> bitstring_type(M, N); make_tree(block_expr, [B]) -> block_expr(B); make_tree(case_expr, [[A], C]) -> case_expr(A, C); make_tree(catch_expr, [[B]]) -> catch_expr(B); @@ -6736,14 +7953,20 @@ make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); make_tree(cond_expr, [C]) -> cond_expr(C); make_tree(conjunction, [E]) -> conjunction(E); +make_tree(constrained_function_type, [[F],C]) -> + constrained_function_type(F, C); +make_tree(constraint, [[N], Ts]) -> constraint(N, Ts); make_tree(disjunction, [E]) -> disjunction(E); make_tree(form_list, [E]) -> form_list(E); make_tree(fun_expr, [C]) -> fun_expr(C); make_tree(function, [[N], C]) -> function(N, C); +make_tree(function_type, [[T]]) -> function_type(T); +make_tree(function_type, [A,[T]]) -> function_type(A, T); make_tree(generator, [[P], [E]]) -> generator(P, E); make_tree(if_expr, [C]) -> if_expr(C); make_tree(implicit_fun, [[N]]) -> implicit_fun(N); make_tree(infix_expr, [[L], [F], [R]]) -> infix_expr(L, F, R); +make_tree(integer_range_type, [[L],[H]]) -> integer_range_type(L, H); make_tree(list, [P]) -> list(P); make_tree(list, [P, [S]]) -> list(P, S); make_tree(list_comp, [[T], B]) -> list_comp(T, B); @@ -6753,6 +7976,9 @@ make_tree(map_expr, [Fs]) -> map_expr(Fs); make_tree(map_expr, [[E], Fs]) -> map_expr(E, Fs); make_tree(map_field_assoc, [[K], [V]]) -> map_field_assoc(K, V); make_tree(map_field_exact, [[K], [V]]) -> map_field_exact(K, V); +make_tree(map_type, [Fs]) -> map_type(Fs); +make_tree(map_type_assoc, [[N],[V]]) -> map_type_assoc(N, V); +make_tree(map_type_exact, [[N],[V]]) -> map_type_exact(N, V); make_tree(match_expr, [[P], [E]]) -> match_expr(P, E); make_tree(named_fun_expr, [[N], C]) -> named_fun_expr(N, C); make_tree(module_qualifier, [[M], [N]]) -> module_qualifier(M, N); @@ -6760,8 +7986,6 @@ make_tree(parentheses, [[E]]) -> parentheses(E); make_tree(prefix_expr, [[F], [A]]) -> prefix_expr(F, A); make_tree(receive_expr, [C]) -> receive_expr(C); make_tree(receive_expr, [C, [E], A]) -> receive_expr(C, E, A); -make_tree(record_access, [[E], [F]]) -> - record_access(E, F); make_tree(record_access, [[E], [T], [F]]) -> record_access(E, T, F); make_tree(record_expr, [[T], F]) -> record_expr(T, F); @@ -6770,10 +7994,16 @@ make_tree(record_field, [[N]]) -> record_field(N); make_tree(record_field, [[N], [E]]) -> record_field(N, E); make_tree(record_index_expr, [[T], [F]]) -> record_index_expr(T, F); -make_tree(rule, [[N], C]) -> rule(N, C); +make_tree(record_type, [[N],Fs]) -> record_type(N, Fs); +make_tree(record_type_field, [[N],[T]]) -> record_type_field(N, T); make_tree(size_qualifier, [[N], [A]]) -> size_qualifier(N, A); make_tree(try_expr, [B, C, H, A]) -> try_expr(B, C, H, A); -make_tree(tuple, [E]) -> tuple(E). +make_tree(tuple, [E]) -> tuple(E); +make_tree(tuple_type, [Es]) -> tuple_type(Es); +make_tree(type_application, [[N], Ts]) -> type_application(N, Ts); +make_tree(type_union, [Es]) -> type_union(Es); +make_tree(typed_record_field, [[F],[T]]) -> typed_record_field(F, T); +make_tree(user_type_application, [[N], Ts]) -> user_type_application(N, Ts). %% ===================================================================== @@ -7100,6 +8330,7 @@ fold_variable_names(Vs) -> unfold_variable_names(Vs, Pos) -> [set_pos(variable(V), Pos) || V <- Vs]. + %% Support functions for transforming lists of record field definitions. %% %% There is no unique representation for field definitions in the @@ -7114,6 +8345,16 @@ fold_record_fields(Fs) -> [fold_record_field(F) || F <- Fs]. fold_record_field(F) -> + case type(F) of + typed_record_field -> + Field = fold_record_field_1(typed_record_field_body(F)), + Type = typed_record_field_type(F), + {typed_record_field, Field, Type}; + record_field -> + fold_record_field_1(F) + end. + +fold_record_field_1(F) -> Pos = get_pos(F), Name = record_field_name(F), case record_field_value(F) of @@ -7126,10 +8367,11 @@ fold_record_field(F) -> unfold_record_fields(Fs) -> [unfold_record_field(F) || F <- Fs]. -unfold_record_field({typed_record_field, Field, _Type}) -> - unfold_record_field_1(Field); +unfold_record_field({typed_record_field, Field, Type}) -> + F = unfold_record_field_1(Field), + set_pos(typed_record_field(F, Type), get_pos(F)); unfold_record_field(Field) -> - unfold_record_field_1(Field). + unfold_record_field_1(Field). unfold_record_field_1({record_field, Pos, Name}) -> set_pos(record_field(Name), Pos); @@ -7156,5 +8398,4 @@ unfold_binary_field_type({Type, Size}, Pos) -> unfold_binary_field_type(Type, Pos) -> set_pos(atom(Type), Pos). - %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 2f0488abec..c7f477c4d2 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1997-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -35,8 +40,8 @@ analyze_function_name/1, analyze_implicit_fun/1, analyze_import_attribute/1, analyze_module_attribute/1, analyze_record_attribute/1, analyze_record_expr/1, - analyze_record_field/1, analyze_rule/1, - analyze_wild_attribute/1, annotate_bindings/1, + analyze_record_field/1, analyze_wild_attribute/1, annotate_bindings/1, + analyze_type_application/1, analyze_type_name/1, annotate_bindings/2, fold/3, fold_subtrees/3, foldl_listlist/3, function_name_expansions/1, is_fail_expr/1, limit/2, limit/3, map/2, map_subtrees/2, mapfold/3, mapfold_subtrees/3, @@ -280,7 +285,7 @@ mapfoldl(_, S, []) -> %% ===================================================================== %% @spec variables(syntaxTree()) -> set(atom()) %% -%% set(T) = //stdlib/sets:set(T) +%% @type set(T) = //stdlib/sets:set(T) %% %% @doc Returns the names of variables occurring in a syntax tree, The %% result is a set of variable names represented by atoms. Macro names @@ -360,9 +365,9 @@ new_variable_name(S) -> %% within a reasonably small range relative to the number of elements in %% the set. %% -%% This function uses the module `random' to generate new +%% This function uses the module `rand' to generate new %% keys. The seed it uses may be initialized by calling -%% `random:seed/0' or `random:seed/3' before this +%% `rand:seed/1' or `rand:seed/2' before this %% function is first called. %% %% @see new_variable_name/1 @@ -405,7 +410,13 @@ start_range(S) -> %% order, but (pseudo-)randomly distributed over the range. generate(_Key, Range) -> - random:uniform(Range). % works well + _ = case rand:export_seed() of + undefined -> + rand:seed(exsplus, {753,8,73}); + _ -> + ok + end, + rand:uniform(Range). % works well %% ===================================================================== @@ -527,8 +538,6 @@ vann(Tree, Env) -> vann_try_expr(Tree, Env); function -> vann_function(Tree, Env); - rule -> - vann_rule(Tree, Env); fun_expr -> vann_fun_expr(Tree, Env); list_comp -> @@ -569,15 +578,6 @@ vann_function(Tree, Env) -> Bound = [], {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. -vann_rule(Tree, Env) -> - Cs = erl_syntax:rule_clauses(Tree), - {Cs1, {_, Free}} = vann_clauses(Cs, Env), - N = erl_syntax:rule_name(Tree), - {N1, _, _} = vann(N, Env), - Tree1 = rewrite(Tree, erl_syntax:rule(N1, Cs1)), - Bound = [], - {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. - vann_fun_expr(Tree, Env) -> Cs = erl_syntax:fun_expr_clauses(Tree), {Cs1, {_, Free}} = vann_clauses(Cs, Env), @@ -946,7 +946,7 @@ is_fail_expr(E) -> %% %% Forms = syntaxTree() | [syntaxTree()] %% Key = attributes | errors | exports | functions | imports -%% | module | records | rules | warnings +%% | module | records | warnings %% %% @doc Analyzes a sequence of "program forms". The given %% `Forms' may be a single syntax tree of type @@ -1035,28 +1035,21 @@ is_fail_expr(E) -> %% <dt>`{records, Records}'</dt> %% <dd><ul> %% <li>`Records = [{atom(), Fields}]'</li> -%% <li>`Fields = [{atom(), Default}]'</li> +%% <li>`Fields = [{atom(), {Default, Type}}]'</li> %% <li>`Default = none | syntaxTree()'</li> +%% <li>`Type = none | syntaxTree()'</li> %% </ul> %% `Records' is a list of pairs representing the names %% and corresponding field declarations of all record declaration %% attributes occurring in `Forms'. For fields declared %% without a default value, the corresponding value for -%% `Default' is the atom `none' (cf. +%% `Default' is the atom `none'. Similarly, for fields declared +%% without a type, the corresponding value for `Type' is the +%% atom `none' (cf. %% `analyze_record_attribute/1'). We do not guarantee %% that each record name occurs at most once in the list. The %% order of listing is not defined.</dd> %% -%% <dt>`{rules, Rules}'</dt> -%% <dd><ul> -%% <li>`Rules = [{atom(), integer()}]'</li> -%% </ul> -%% `Rules' is a list of the names of the rules that are -%% defined in `Forms' (cf. -%% `analyze_rule/1'). We do not guarantee that each -%% name occurs at most once in the list. The order of listing is -%% not defined.</dd> -%% %% <dt>`{warnings, Warnings}'</dt> %% <dd><ul> %% <li>`Warnings = [term()]'</li> @@ -1071,15 +1064,14 @@ is_fail_expr(E) -> %% %% @see analyze_wild_attribute/1 %% @see analyze_export_attribute/1 +%% @see analyze_function/1 %% @see analyze_import_attribute/1 %% @see analyze_record_attribute/1 -%% @see analyze_function/1 -%% @see analyze_rule/1 %% @see erl_syntax:error_marker_info/1 %% @see erl_syntax:warning_marker_info/1 -type key() :: 'attributes' | 'errors' | 'exports' | 'functions' | 'imports' - | 'module' | 'records' | 'rules' | 'warnings'. + | 'module' | 'records' | 'warnings'. -type info_pair() :: {key(), term()}. -spec analyze_forms(erl_syntax:forms()) -> [info_pair()]. @@ -1099,8 +1091,6 @@ collect_form(Node, Info) -> Info; {function, Name} -> finfo_add_function(Name, Info); - {rule, Name} -> - finfo_add_rule(Name, Info); {error_marker, Data} -> finfo_add_error(Data, Info); {warning_marker, Data} -> @@ -1121,8 +1111,6 @@ collect_attribute(file, _, Info) -> Info; collect_attribute(record, {R, L}, Info) -> finfo_add_record(R, L, Info); -collect_attribute(spec, _, Info) -> - Info; collect_attribute(_, {N, V}, Info) -> finfo_add_attribute(N, V, Info). @@ -1133,13 +1121,15 @@ collect_attribute(_, {N, V}, Info) -> module_imports = [] :: [atom()], imports = [] :: [{atom(), [{atom(), arity()}]}], attributes = [] :: [{atom(), term()}], - records = [] :: [{atom(), [{atom(), field_default()}]}], + records = [] :: [{atom(), [{atom(), + field_default(), + field_type()}]}], errors = [] :: [term()], warnings = [] :: [term()], - functions = [] :: [{atom(), arity()}], - rules = [] :: [{atom(), arity()}]}). + functions = [] :: [{atom(), arity()}]}). -type field_default() :: 'none' | erl_syntax:syntaxTree(). +-type field_type() :: 'none' | erl_syntax:syntaxTree(). new_finfo() -> #forms{}. @@ -1183,9 +1173,6 @@ finfo_add_warning(R, Info) -> finfo_add_function(F, Info) -> Info#forms{functions = [F | Info#forms.functions]}. -finfo_add_rule(F, Info) -> - Info#forms{rules = [F | Info#forms.rules]}. - finfo_to_list(Info) -> [{Key, Value} || {Key, {value, Value}} <- @@ -1197,8 +1184,7 @@ finfo_to_list(Info) -> {records, list_value(Info#forms.records)}, {errors, list_value(Info#forms.errors)}, {warnings, list_value(Info#forms.warnings)}, - {functions, list_value(Info#forms.functions)}, - {rules, list_value(Info#forms.rules)} + {functions, list_value(Info#forms.functions)} ]]. list_value([]) -> @@ -1229,10 +1215,6 @@ list_value(List) -> %% %% <dd>where `Info = analyze_function(Node)'.</dd> %% -%% <dt>`{rule, Info}'</dt> -%% -%% <dd>where `Info = analyze_rule(Node)'.</dd> -%% %% <dt>`{warning_marker, Info}'</dt> %% %% <dd>where `Info = @@ -1245,7 +1227,6 @@ list_value(List) -> %% %% @see analyze_attribute/1 %% @see analyze_function/1 -%% @see analyze_rule/1 %% @see erl_syntax:is_form/1 %% @see erl_syntax:error_marker_info/1 %% @see erl_syntax:warning_marker_info/1 @@ -1258,8 +1239,6 @@ analyze_form(Node) -> {attribute, analyze_attribute(Node)}; function -> {function, analyze_function(Node)}; - rule -> - {rule, analyze_rule(Node)}; error_marker -> {error_marker, erl_syntax:error_marker_info(Node)}; warning_marker -> @@ -1357,8 +1336,6 @@ analyze_attribute(file, Node) -> analyze_file_attribute(Node); analyze_attribute(record, Node) -> analyze_record_attribute(Node); -analyze_attribute(spec, _Node) -> - spec; analyze_attribute(_, Node) -> %% A "wild" attribute (such as e.g. a `compile' directive). analyze_wild_attribute(Node). @@ -1554,6 +1531,55 @@ analyze_import_attribute(Node) -> %% ===================================================================== +%% @spec analyze_type_name(Node::syntaxTree()) -> TypeName +%% +%% TypeName = atom() +%% | {atom(), integer()} +%% | {ModuleName, {atom(), integer()}} +%% ModuleName = atom() +%% +%% @doc Returns the type name represented by a syntax tree. If +%% `Node' represents a type name, such as +%% "`foo/1'" or "`bloggs:fred/2'", a uniform +%% representation of that name is returned. +%% +%% The evaluation throws `syntax_error' if +%% `Node' does not represent a well-formed type name. + +-spec analyze_type_name(erl_syntax:syntaxTree()) -> typeName(). + +analyze_type_name(Node) -> + case erl_syntax:type(Node) of + atom -> + erl_syntax:atom_value(Node); + arity_qualifier -> + A = erl_syntax:arity_qualifier_argument(Node), + N = erl_syntax:arity_qualifier_body(Node), + + case ((erl_syntax:type(A) =:= integer) + and (erl_syntax:type(N) =:= atom)) + of + true -> + append_arity(erl_syntax:integer_value(A), + erl_syntax:atom_value(N)); + _ -> + throw(syntax_error) + end; + module_qualifier -> + M = erl_syntax:module_qualifier_argument(Node), + case erl_syntax:type(M) of + atom -> + N = erl_syntax:module_qualifier_body(Node), + N1 = analyze_type_name(N), + {erl_syntax:atom_value(M), N1}; + _ -> + throw(syntax_error) + end; + _ -> + throw(syntax_error) + end. + +%% ===================================================================== %% @spec analyze_wild_attribute(Node::syntaxTree()) -> {atom(), term()} %% %% @doc Returns the name and value of a "wild" attribute. The result is @@ -1578,6 +1604,7 @@ analyze_wild_attribute(Node) -> atom -> case erl_syntax:attribute_arguments(Node) of [V] -> + %% Note: does not work well with macros. case catch {ok, erl_syntax:concrete(V)} of {ok, Val} -> {erl_syntax:atom_value(N), Val}; @@ -1599,17 +1626,22 @@ analyze_wild_attribute(Node) -> %% @spec analyze_record_attribute(Node::syntaxTree()) -> %% {atom(), Fields} %% -%% Fields = [{atom(), none | syntaxTree()}] +%% Fields = [{atom(), {Default, Type}}] +%% Default = none | syntaxTree() +%% Type = none | syntaxTree() %% %% @doc Returns the name and the list of fields of a record declaration %% attribute. The result is a pair `{Name, Fields}', if %% `Node' represents "`-record(Name, {...}).'", %% where `Fields' is a list of pairs `{Label, -%% Default}' for each field "`Label'" or "`Label = -%% <em>Default</em>'" in the declaration, listed in left-to-right +%% {Default, Type}}' for each field "`Label'", "`Label = +%% <em>Default</em>'", "`Label :: <em>Type</em>'", or +%% "`Label = <em>Default</em> :: <em>Type</em>'" in the declaration, +%% listed in left-to-right %% order. If the field has no default-value declaration, the value for -%% `Default' will be the atom `none'. We do not -%% guarantee that each label occurs at most one in the list. +%% `Default' will be the atom `none'. If the field has no type declaration, +%% the value for `Type' will be the atom `none'. We do not +%% guarantee that each label occurs at most once in the list. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record declaration @@ -1618,7 +1650,9 @@ analyze_wild_attribute(Node) -> %% @see analyze_attribute/1 %% @see analyze_record_field/1 --type fields() :: [{atom(), 'none' | erl_syntax:syntaxTree()}]. +-type field() :: {atom(), {field_default(), field_type()}}. + +-type fields() :: [field()]. -spec analyze_record_attribute(erl_syntax:syntaxTree()) -> {atom(), fields()}. @@ -1656,7 +1690,7 @@ analyze_record_attribute_tuple(Node) -> %% {atom(), Info} | atom() %% %% Info = {atom(), [{atom(), Value}]} | {atom(), atom()} | atom() -%% Value = none | syntaxTree() +%% Value = syntaxTree() %% %% @doc Returns the record name and field name/names of a record %% expression. If `Node' has type `record_expr', @@ -1669,19 +1703,17 @@ analyze_record_attribute_tuple(Node) -> %% <dt>`record_expr':</dt> %% <dd>`{atom(), [{atom(), Value}]}'</dd> %% <dt>`record_access':</dt> -%% <dd>`{atom(), atom()} | atom()'</dd> +%% <dd>`{atom(), atom()}'</dd> %% <dt>`record_index_expr':</dt> %% <dd>`{atom(), atom()}'</dd> %% </dl> %% %% For a `record_expr' node, `Info' represents %% the record name and the list of descriptors for the involved fields, -%% listed in the order they appear. (See -%% `analyze_record_field/1' for details on the field -%% descriptors). For a `record_access' node, -%% `Info' represents the record name and the field name (or -%% if the record name is not included, only the field name; this is -%% allowed only in Mnemosyne-query syntax). For a +%% listed in the order they appear. A field descriptor is a pair +%% `{Label, Value}', if `Node' represents "`Label = <em>Value</em>'". +%% For a `record_access' node, +%% `Info' represents the record name and the field name. For a %% `record_index_expr' node, `Info' represents the %% record name and the name field name. %% @@ -1692,7 +1724,7 @@ analyze_record_attribute_tuple(Node) -> %% @see analyze_record_attribute/1 %% @see analyze_record_field/1 --type info() :: {atom(), [{atom(), 'none' | erl_syntax:syntaxTree()}]} +-type info() :: {atom(), [{atom(), erl_syntax:syntaxTree()}]} | {atom(), atom()} | atom(). -spec analyze_record_expr(erl_syntax:syntaxTree()) -> {atom(), info()} | atom(). @@ -1703,8 +1735,9 @@ analyze_record_expr(Node) -> A = erl_syntax:record_expr_type(Node), case erl_syntax:type(A) of atom -> - Fs = [analyze_record_field(F) - || F <- erl_syntax:record_expr_fields(Node)], + Fs0 = [analyze_record_field(F) + || F <- erl_syntax:record_expr_fields(Node)], + Fs = [{N, D} || {N, {D, _T}} <- Fs0], {record_expr, {erl_syntax:atom_value(A), Fs}}; _ -> throw(syntax_error) @@ -1713,18 +1746,14 @@ analyze_record_expr(Node) -> F = erl_syntax:record_access_field(Node), case erl_syntax:type(F) of atom -> - case erl_syntax:record_access_type(Node) of - none -> - {record_access, erl_syntax:atom_value(F)}; - A -> - case erl_syntax:type(A) of - atom -> - {record_access, - {erl_syntax:atom_value(A), - erl_syntax:atom_value(F)}}; - _ -> - throw(syntax_error) - end + A = erl_syntax:record_access_type(Node), + case erl_syntax:type(A) of + atom -> + {record_access, + {erl_syntax:atom_value(A), + erl_syntax:atom_value(F)}}; + _ -> + throw(syntax_error) end; _ -> throw(syntax_error) @@ -1750,16 +1779,19 @@ analyze_record_expr(Node) -> end. %% ===================================================================== -%% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), Value} +%% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), {Default, Type}} %% -%% Value = none | syntaxTree() +%% Default = none | syntaxTree() +%% Type = none | syntaxTree() %% -%% @doc Returns the label and value-expression of a record field -%% specifier. The result is a pair `{Label, Value}', if -%% `Node' represents "`Label = <em>Value</em>'" or -%% "`Label'", where in the first case, `Value' is -%% a syntax tree, and in the second case `Value' is -%% `none'. +%% @doc Returns the label, value-expression, and type of a record field +%% specifier. The result is a pair `{Label, {Default, Type}}', if +%% `Node' represents "`Label'", "`Label = <em>Default</em>'", +%% "`Label :: <em>Type</em>'", or +%% "`Label = <em>Default</em> :: <em>Type</em>'". +%% If the field has no value-expression, the value for +%% `Default' will be the atom `none'. If the field has no type, +%% the value for `Type' will be the atom `none'. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record field @@ -1768,8 +1800,7 @@ analyze_record_expr(Node) -> %% @see analyze_record_attribute/1 %% @see analyze_record_expr/1 --spec analyze_record_field(erl_syntax:syntaxTree()) -> - {atom(), 'none' | erl_syntax:syntaxTree()}. +-spec analyze_record_field(erl_syntax:syntaxTree()) -> field(). analyze_record_field(Node) -> case erl_syntax:type(Node) of @@ -1778,10 +1809,15 @@ analyze_record_field(Node) -> case erl_syntax:type(A) of atom -> T = erl_syntax:record_field_value(Node), - {erl_syntax:atom_value(A), T}; + {erl_syntax:atom_value(A), {T, none}}; _ -> throw(syntax_error) end; + typed_record_field -> + F = erl_syntax:typed_record_field_body(Node), + {N, {V, _none}} = analyze_record_field(F), + T = erl_syntax:typed_record_field_type(Node), + {N, {V, T}}; _ -> throw(syntax_error) end. @@ -1835,8 +1871,6 @@ analyze_file_attribute(Node) -> %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed function %% definition. -%% -%% @see analyze_rule/1 -spec analyze_function(erl_syntax:syntaxTree()) -> {atom(), arity()}. @@ -1857,37 +1891,6 @@ analyze_function(Node) -> %% ===================================================================== -%% @spec analyze_rule(Node::syntaxTree()) -> {atom(), integer()} -%% -%% @doc Returns the name and arity of a Mnemosyne rule. The result is a -%% pair `{Name, A}' if `Node' represents a rule -%% "`Name(<em>P_1</em>, ..., <em>P_A</em>) :- ...'". -%% -%% The evaluation throws `syntax_error' if -%% `Node' does not represent a well-formed Mnemosyne -%% rule. -%% -%% @see analyze_function/1 - --spec analyze_rule(erl_syntax:syntaxTree()) -> {atom(), arity()}. - -analyze_rule(Node) -> - case erl_syntax:type(Node) of - rule -> - N = erl_syntax:rule_name(Node), - case erl_syntax:type(N) of - atom -> - {erl_syntax:atom_value(N), - erl_syntax:rule_arity(Node)}; - _ -> - throw(syntax_error) - end; - _ -> - throw(syntax_error) - end. - - -%% ===================================================================== %% @spec analyze_implicit_fun(Node::syntaxTree()) -> FunctionName %% %% FunctionName = atom() | {atom(), integer()} @@ -1957,6 +1960,55 @@ analyze_application(Node) -> %% ===================================================================== +%% @spec analyze_type_application(Node::syntaxTree()) -> TypeName +%% +%% TypeName = {atom(), integer()} +%% | {ModuleName, {atom(), integer()}} +%% ModuleName = atom() +%% +%% @doc Returns the name of a used type. The result is a +%% representation of the name of the used pre-defined or local type `N/A', +%% if `Node' represents a local (user) type application +%% "`<em>N</em>(<em>T_1</em>, ..., <em>T_A</em>)'", or +%% a representation of the name of the used remote type `M:N/A' +%% if `Node' represents a remote user type application +%% "`<em>M</em>:<em>N</em>(<em>T_1</em>, ..., <em>T_A</em>)'". +%% +%% The evaluation throws `syntax_error' if `Node' does not represent a +%% well-formed (user) type application expression. +%% +%% @see analyze_type_name/1 + +-type typeName() :: atom() | {module(), atom(), arity()} | {atom(), arity()}. + +-spec analyze_type_application(erl_syntax:syntaxTree()) -> typeName(). + +analyze_type_application(Node) -> + case erl_syntax:type(Node) of + type_application -> + A = length(erl_syntax:type_application_arguments(Node)), + N = erl_syntax:type_application_name(Node), + case catch {ok, analyze_type_name(N)} of + {ok, TypeName} -> + append_arity(A, TypeName); + _ -> + throw(syntax_error) + end; + user_type_application -> + A = length(erl_syntax:user_type_application_arguments(Node)), + N = erl_syntax:user_type_application_name(Node), + case catch {ok, analyze_type_name(N)} of + {ok, TypeName} -> + append_arity(A, TypeName); + _ -> + throw(syntax_error) + end; + _ -> + throw(syntax_error) + end. + + +%% ===================================================================== %% @spec function_name_expansions(Names::[Name]) -> [{ShortName, Name}] %% %% Name = ShortName | {atom(), Name} diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 38e0c2099b..1ca60ea73b 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1999-2014 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -36,6 +41,11 @@ %% been reasonably well tested, but the possibility of errors remains. %% Keep backups of your original code safely stored, until you feel %% confident that the new, modified code can be trusted. +%% +%% @type syntaxTree() = erl_syntax:syntaxTree(). An abstract syntax +%% tree. See the {@link erl_syntax} module for details. +%% +%% @type filename() = file:filename(). -module(erl_tidy). @@ -79,7 +89,6 @@ dir(Dir) -> %% ===================================================================== %% @spec dir(Directory::filename(), Options::[term()]) -> ok -%% filename() = file:filename() %% %% @doc Tidies Erlang source files in a directory and its %% subdirectories. @@ -206,7 +215,7 @@ file__defaults() -> {verbose, false}]. default_printer() -> - fun (Tree, Options) -> erl_prettypr:format(Tree, Options) end. + fun erl_prettypr:format/2. %% ===================================================================== %% @spec file(Name) -> ok @@ -253,7 +262,7 @@ file(Name) -> %% %% <dt>{printer, Function}</dt> %% <dd><ul> -%% <li>`Function = (syntaxTree()) -> string()'</li> +%% <li>`Function = (syntaxTree(), [term()]) -> string()'</li> %% </ul> %% %% Specifies a function for prettyprinting Erlang syntax trees. @@ -414,7 +423,7 @@ write_module(Tree, Name, Opts) -> print_module(Tree, Opts) -> Printer = proplists:get_value(printer, Opts), - io:format(Printer(Tree, Opts)). + io:put_chars(Printer(Tree, Opts)). output(FD, Printer, Tree, Opts) -> io:put_chars(FD, Printer(Tree, Opts)), @@ -513,7 +522,6 @@ module(Forms) -> %% @spec module(Forms, Options::[term()]) -> syntaxTree() %% %% Forms = syntaxTree() | [syntaxTree()] -%% syntaxTree() = erl_syntax:syntaxTree() %% %% @doc Tidies a syntax tree representation of a module %% definition. The given `Forms' may be either a single @@ -792,16 +800,11 @@ keep_form(Form, Used, Opts) -> N = erl_syntax_lib:analyze_function(Form), case sets:is_element(N, Used) of false -> - report_removed_def("function", N, Form, Opts), - false; - true -> - true - end; - rule -> - N = erl_syntax_lib:analyze_rule(Form), - case sets:is_element(N, Used) of - false -> - report_removed_def("rule", N, Form, Opts), + {F, A} = N, + File = proplists:get_value(file, Opts, ""), + report({File, erl_syntax:get_pos(Form), + "removing unused function `~w/~w'."}, + [F, A], Opts), false; true -> true @@ -823,12 +826,6 @@ keep_form(Form, Used, Opts) -> true end. -report_removed_def(Type, {N, A}, Form, Opts) -> - File = proplists:get_value(file, Opts, ""), - report({File, erl_syntax:get_pos(Form), - "removing unused ~s `~w/~w'."}, - [Type, N, A], Opts). - collect_functions(Forms) -> lists:foldl( fun (F, {Names, Defs}) -> @@ -837,10 +834,6 @@ collect_functions(Forms) -> N = erl_syntax_lib:analyze_function(F), {sets:add_element(N, Names), dict:store(N, {F, []}, Defs)}; - rule -> - N = erl_syntax_lib:analyze_rule(F), - {sets:add_element(N, Names), - dict:store(N, {F, []}, Defs)}; _ -> {Names, Defs} end @@ -855,11 +848,6 @@ update_forms([F | Fs], Defs, Imports, Opts) -> {F1, Fs1} = dict:fetch(N, Defs), [F1 | lists:reverse(Fs1)] ++ update_forms(Fs, Defs, Imports, Opts); - rule -> - N = erl_syntax_lib:analyze_rule(F), - {F1, Fs1} = dict:fetch(N, Defs), - [F1 | lists:reverse(Fs1)] ++ update_forms(Fs, Defs, Imports, - Opts); attribute -> [update_attribute(F, Imports, Opts) | update_forms(Fs, Defs, Imports, Opts)]; @@ -957,7 +945,7 @@ hidden_uses_2(Tree, Used) -> -record(env, {file :: file:filename(), module :: atom(), - current :: fa(), + current :: fa() | 'undefined', imports = dict:new() :: dict:dict(atom(), atom()), context = normal :: context(), verbosity = 1 :: 0 | 1 | 2, @@ -969,10 +957,10 @@ hidden_uses_2(Tree, Used) -> new_guard_tests = true :: boolean(), old_guard_tests = false :: boolean()}). --record(st, {varc :: non_neg_integer(), +-record(st, {varc :: non_neg_integer() | 'undefined', used = sets:new() :: sets:set({atom(), arity()}), imported :: sets:set({atom(), arity()}), - vars :: sets:set(atom()), + vars :: sets:set(atom()) | 'undefined', functions :: sets:set({atom(), arity()}), new_forms = [] :: [erl_syntax:syntaxTree()], rename :: dict:dict(mfa(), {atom(), atom()})}). @@ -1084,13 +1072,13 @@ visit_clause(Tree, Env, St0) -> visit_infix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_infix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). visit_prefix_expr(Tree, #env{context = guard_test}, St0) -> %% Detect transition from guard test to guard expression. - visit_other(Tree, #env{context = guard_expr}, St0); + visit_other(Tree, #env{context = guard_expr, file = ""}, St0); visit_prefix_expr(Tree, Env, St0) -> visit_other(Tree, Env, St0). diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 0420508f2a..b92cd8d607 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 1998-2014 Richard Carlsson %% @author Richard Carlsson <[email protected]> @@ -151,7 +156,8 @@ default_printer(Tree, Options) -> %% @spec parse_transform(Forms::[syntaxTree()], Options::[term()]) -> %% [syntaxTree()] %% -%% syntaxTree() = erl_syntax:syntaxTree() +%% @type syntaxTree() = erl_syntax:syntaxTree(). An abstract syntax +%% tree. See the {@link erl_syntax} module for details. %% %% @doc Allows Igor to work as a component of the Erlang compiler. %% Including the term `{parse_transform, igor}' in the @@ -212,7 +218,7 @@ merge(Name, Files) -> %% @spec merge(Name::atom(), Files::[filename()], Options::[term()]) -> %% [filename()] %% -%% filename() = file:filename() +%% @type filename() = file:filename() %% %% @doc Merges source code files to a single file. `Name' %% specifies the name of the resulting module - not the name of the @@ -367,6 +373,7 @@ merge_files(Name, Files, Options) -> %% @spec merge_files(Name::atom(), Sources::[Forms], %% Files::[filename()], Options::[term()]) -> %% {syntaxTree(), [stubDescriptor()]} +%% %% Forms = syntaxTree() | [syntaxTree()] %% %% @doc Merges source code files and syntax trees to a single syntax @@ -410,7 +417,7 @@ merge_files(Name, Files, Options) -> %% %% <dd>Specifies a list of rules for associating object files with %% source files, to be passed to the function -%% `filename:find_src/2'. This can be used to change the +%% `filelib:find_source/2'. This can be used to change the %% way Igor looks for source files. If this option is not specified, %% the default system rules are used. The first occurrence of this %% option completely overrides any later in the option list.</dd> @@ -455,7 +462,7 @@ merge_files(Name, Files, Options) -> %% @see merge/3 %% @see merge_files/3 %% @see merge_sources/3 -%% @see //stdlib/filename:find_src/2 +%% @see //stdlib/filelib:find_source/2 %% @see epp_dodger -spec merge_files(atom(), erl_syntax:forms(), [file:filename()], [option()]) -> @@ -1594,10 +1601,11 @@ alias_expansions_2(Modules, Table) -> preserved :: boolean(), no_headers :: boolean(), notes :: notes(), - map :: map_fun(), + map :: map_fun() | 'undefined', renaming :: fun((atom()) -> map_fun()), expand :: dict:dict({atom(), integer()}, - {atom(), {atom(), integer()}}), + {atom(), {atom(), integer()}}) + | 'undefined', redirect :: dict:dict(atom(), atom()) }). @@ -1713,8 +1721,6 @@ transform(Tree, Env, St) -> transform_function(Tree, Env, St); implicit_fun -> transform_implicit_fun(Tree, Env, St); - rule -> - transform_rule(Tree, Env, St); record_expr -> transform_record(Tree, Env, St); record_index_expr -> @@ -1778,27 +1784,6 @@ renaming_note(Name) -> rename_atom(Node, Atom) -> rewrite(Node, erl_syntax:atom(Atom)). -%% Renaming Mnemosyne rules (just like function definitions) - -transform_rule(T, Env, St) -> - {T1, St1} = default_transform(T, Env, St), - F = erl_syntax_lib:analyze_rule(T1), - {V, Text} = case (Env#code.map)(F) of - F -> - %% Not renamed - {none, []}; - {Atom, _Arity} -> - %% Renamed - Cs = erl_syntax:rule_clauses(T1), - N = rename_atom( - erl_syntax:rule_name(T1), - Atom), - T2 = rewrite(T1, - erl_syntax:rule(N, Cs)), - {{value, T2}, renaming_note(Atom)} - end, - {maybe_modified(V, T1, 2, Text, Env), St1}. - %% Renaming "implicit fun" expressions (done quietly). transform_implicit_fun(T, Env, St) -> @@ -2634,6 +2619,19 @@ get_module_info(Forms) -> fold_record_fields(Rs) -> [{N, [fold_record_field(F) || F <- Fs]} || {N, Fs} <- Rs]. +fold_record_field({_Name, {none, _Type}} = None) -> + None; +fold_record_field({Name, {F, Type}}) -> + case erl_syntax:is_literal(F) of + true -> + {Name, {value, erl_syntax:concrete(F)}, Type}; + false -> + %% The default value for the field is not a constant, so we + %% represent it by a hash value instead. (We don't want to + %% do this in the general case.) + {Name, {hash, erlang:phash(F, 16#ffffff)}, Type} + end; +%% The following two clauses handle code before Erlang/OTP 19.0. fold_record_field({_Name, none} = None) -> None; fold_record_field({Name, F}) -> @@ -2748,8 +2746,8 @@ read_module(Name, Options) -> %% It seems that we have no file - go on anyway, %% just to get a decent error message. read_module_1(Name, Options); - {Name1, _} -> - read_module_1(Name1 ++ ".erl", Options) + {ok, Name1} -> + read_module_1(Name1, Options) end end. @@ -2809,9 +2807,9 @@ check_forms([], _) -> ok. find_src(Name, undefined) -> - filename:find_src(filename(Name)); + filelib:find_source(filename(Name)); find_src(Name, Rules) -> - filename:find_src(filename(Name), Rules). + filelib:find_source(filename(Name), Rules). %% file_type(filename()) -> {value, Type} | none diff --git a/lib/syntax_tools/src/merl.erl b/lib/syntax_tools/src/merl.erl new file mode 100644 index 0000000000..d6cf208998 --- /dev/null +++ b/lib/syntax_tools/src/merl.erl @@ -0,0 +1,1250 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. +%% +%% Note: EDoc uses @@ and @} as escape sequences, so in the doc text below, +%% `@@' must be written `@@@@' and `@}' must be written `@@}'. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2010-2015 Richard Carlsson +%% +%% @doc Metaprogramming in Erlang. +%% Merl is a more user friendly interface to the `erl_syntax' module, making +%% it easy both to build new ASTs from scratch and to +%% match and decompose existing ASTs. For details that are outside the scope +%% of Merl itself, please see the documentation of {@link erl_syntax}. +%% +%% == Quick start == +%% +%% To enable the full power of Merl, your module needs to include the Merl +%% header file: +%% ```-include_lib("syntax_tools/include/merl.hrl").''' +%% +%% Then, you can use the `?Q(Text)' macros in your code to create ASTs or match +%% on existing ASTs. For example: +%% ```Tuple = ?Q("{foo, 42}"), +%% ?Q("{foo, _@Number}") = Tuple, +%% Call = ?Q("foo:bar(_@Number)")''' +%% +%% Calling `merl:print(Call)' will then print the following code: +%% ```foo:bar(42)''' +%% +%% The `?Q' macros turn the quoted code fragments into ASTs, and lifts +%% metavariables such as `_@Tuple' and `_@Number' to the level of your Erlang +%% code, so you can use the corresponding Erlang variables `Tuple' and `Number' +%% directly. This is the most straightforward way to use Merl, and in many +%% cases it's all you need. +%% +%% You can even write case switches using `?Q' macros as patterns. For example: +%% ```case AST of +%% ?Q("{foo, _@Foo}") -> handle(Foo); +%% ?Q("{bar, _@Bar}") when erl_syntax:is_integer(Bar) -> handle(Bar); +%% _ -> handle_default() +%% end''' +%% +%% These case switches only allow `?Q(...)' or `_' as clause patterns, and the +%% guards may contain any expressions, not just Erlang guard expressions. +%% +%% If the macro `MERL_NO_TRANSFORM' is defined before the `merl.hrl' header +%% file is included, the parse transform used by Merl will be disabled, and in +%% that case, the match expressions `?Q(...) = ...', case switches using +%% `?Q(...)' patterns, and automatic metavariables like `_@Tuple' cannot be +%% used in your code, but the Merl macros and functions still work. To do +%% metavariable substitution, you need to use the `?Q(Text, Map)' macro, e.g.: +%% ```Tuple = ?Q("{foo, _@bar, _@baz}", [{bar, Bar}, {baz,Baz}])''' +%% +%% The text given to a `?Q(Text)' macro can be either a single string, or a +%% list of strings. The latter is useful when you need to split a long +%% expression over multiple lines, e.g.: +%% ```?Q(["case _@Expr of", +%% " {foo, X} -> f(X);", +%% " {bar, X} -> g(X)", +%% " _ -> h(X)" +%% "end"])''' +%% If there is a syntax error somewhere in the text (like the missing semicolon +%% in the second clause above) this allows Merl to generate an error message +%% pointing to the exact line in your source code. (Just remember to +%% comma-separate the strings in the list, otherwise Erlang will concatenate +%% the string fragments as if they were a single string.) +%% +%% == Metavariable syntax == +%% +%% There are several ways to write a metavariable in your quoted code: +%% <ul> +%% <li>Atoms starting with `@', for example `` '@foo' '' or `` '@Foo' ''</li> +%% <li>Variables starting with `_@', for example `_@bar' or `_@Bar'</li> +%% <li>Strings starting with ``"'@'', for example ``"'@File"''</li> +%% <li>Integers starting with 909, for example `9091' or `909123'</li> +%% </ul> +%% Following the prefix, one or more `_' or `0' characters may be used to +%% indicate "lifting" of the variable one or more levels, and after that, a `@' +%% or `9' character indicates a glob metavariable (matching zero or more +%% elements in a sequence) rather than a normal metavariable. For example: +%% <ul> +%% <li>`` '@_foo' '' is lifted one level, and `_@__foo' is lifted two +%% levels</li> +%% <li>`_@@@@bar' is a glob variable, and `_@_@bar' is a lifted glob +%% variable</li> +%% <li>`90901' is a lifted variable,`90991' is a glob variable, and `9090091' +%% is a glob variable lifted two levels</li> +%% </ul> +%% (Note that the last character in the name is never considered to be a lift +%% or glob marker, hence, `_@__' and `90900' are only lifted one level, not +%% two. Also note that globs only matter for matching; when doing +%% substitutions, a non-glob variable can be used to inject a sequence of +%% elements, and vice versa.) +%% +%% If the name after the prefix and any lift and glob markers is `_' or `0', +%% the variable is treated as an anonymous catch-all pattern in matches. For +%% example, `_@_', `_@@@@_', `_@__', or even `_@__@_'. +%% +%% Finally, if the name without any prefixes or lift/glob markers begins with +%% an uppercase character, as in `_@Foo' or `_@_@Foo', it will become a +%% variable on the Erlang level, and can be used to easily deconstruct and +%% construct syntax trees: +%% ```case Input of +%% ?Q("{foo, _@Number}") -> ?Q("foo:bar(_@Number)"); +%% ...''' +%% We refer to these as "automatic metavariables". If in addition the name ends +%% with `@', as in `_@Foo@', the value of the variable as an Erlang term will +%% be automatically converted to the corresponding abstract syntax tree when +%% used to construct a larger tree. For example, in: +%% ```Bar = {bar, 42}, +%% Foo = ?Q("{foo, _@Bar@@}")''' +%% (where Bar is just some term, not a syntax tree) the result `Foo' will be a +%% syntax tree representing `{foo, {bar, 42}}'. This avoids the need for +%% temporary variables in order to inject data, as in +%% ```TmpBar = erl_syntax:abstract(Bar), +%% Foo = ?Q("{foo, _@TmpBar}")''' +%% +%% If the context requires an integer rather than a variable, an atom, or a +%% string, you cannot use the uppercase convention to mark an automatic +%% metavariable. Instead, if the integer (without the `909'-prefix and +%% lift/glob markers) ends in a `9', the integer will become an Erlang-level +%% variable prefixed with `Q', and if it ends with `99' it will also be +%% automatically abstracted. For example, the following will increment the +%% arity of the exported function f: +%% ```case Form of +%% ?Q("-export([f/90919]).") -> +%% Q2 = erl_syntax:concrete(Q1) + 1, +%% ?Q("-export([f/909299])."); +%% ...''' +%% +%% == When to use the various forms of metavariables == +%% +%% Merl can only parse a fragment of text if it follows the basic syntactical +%% rules of Erlang. In most places, a normal Erlang variable can be used as +%% metavariable, for example: +%% ```?Q("f(_@Arg)") = Expr''' +%% but if you want to match on something like the name of a function, you have +%% to use an atom as metavariable: +%% ```?Q("'@Name'() -> _@@@@_." = Function''' +%% (note the anonymous glob variable `_@@@@_' to ignore the function body). +%% +%% In some contexts, only a string or an integer is allowed. For example, the +%% directive `-file(Name, Line)' requires that `Name' is a string literal and +%% `Line' an integer literal: +%% +%% ```?Q("-file(\"'@File\", 9090).") = ?Q("-file(\"foo.erl\", 42).")).''' +%% This will extract the string literal `"foo.erl"' into the variable `Foo'. +%% Note the use of the anonymous variable `9090' to ignore the line number. To +%% match and also bind a metavariable that must be an integer literal, we can +%% use the convention of ending the integer with a 9, turning it into a +%% Q-prefixed variable on the Erlang level (see the previous section). +%% +%% === Globs === +%% +%% Whenever you want to match out a number of elements in a sequence (zero or +%% more) rather than a fixed set of elements, you need to use a glob. For +%% example: +%% ```?Q("{_@@@@Elements}") = ?Q({a, b, c})''' +%% will bind Elements to the list of individual syntax trees representing the +%% atoms `a', `b', and `c'. This can also be used with static prefix and suffix +%% elements in the sequence. For example: +%% ```?Q("{a, b, _@@@@Elements}") = ?Q({a, b, c, d})''' +%% will bind Elements to the list of the `c' and `d' subtrees, and +%% ```?Q("{_@@@@Elements, c, d}") = ?Q({a, b, c, d})''' +%% will bind Elements to the list of the `a' and `b' subtrees. You can even use +%% plain metavariables in the prefix or suffix: +%% ```?Q("{_@First, _@@@@Rest}") = ?Q({a, b, c})''' +%% or +%% ```?Q("{_@@@@_, _@Last}") = ?Q({a, b, c})''' +%% (ignoring all but the last element). You cannot however have two globs as +%% part of the same sequence. +%% +%% === Lifted metavariables === +%% +%% In some cases, the Erlang syntax rules make it impossible to place a +%% metavariable directly where you would like it. For example, you cannot +%% write: +%% ```?Q("-export([_@@@@Name]).")''' +%% to match out all name/arity pairs in the export list, or to insert a list of +%% exports in a declaration, because the Erlang parser only allows elements on +%% the form `A/I' (where `A' is an atom and `I' an integer) in the export list. +%% A variable like the above is not allowed, but neither is a single atom or +%% integer, so `` '@@@@Name' '' or `909919' wouldn't work either. +%% +%% What you have to do in such cases is to write your metavariable in a +%% syntactically valid position, and use lifting markers to denote where it +%% should really apply, as in: +%% ```?Q("-export(['@@_@@Name'/0]).")''' +%% This causes the variable to be lifted (after parsing) to the next higher +%% level in the syntax tree, replacing that entire subtree. In this case, the +%% `` '@@_@@Name'/0 '' will be replaced with `` '@@@@Name' '', and the ``/0'' +%% part was just used as dummy notation and will be discarded. +%% +%% You may even need to apply lifting more than once. To match the entire +%% export list as a single syntax tree, you can write: +%% ```?Q("-export(['@@__Name'/0]).")''' +%% using two underscores, but with no glob marker this time. This will make the +%% entire ``['@@__Name'/0]'' part be replaced with `` '@@Name' ''. +%% +%% Sometimes, the tree structure of a code fragment isn't very obvious, and +%% parts of the structure may be invisible when printed as source code. For +%% instance, a simple function definition like the following: +%% ```zero() -> 0.''' +%% consists of the name (the atom `zero'), and a list of clauses containing the +%% single clause `() -> 0'. The clause consists of an argument list (empty), a +%% guard (empty), and a body (which is always a list of expressions) containing +%% the single expression `0'. This means that to match out the name and the +%% list of clauses of any function, you'll need to use a pattern like +%% ``?Q("'@Name'() -> _@_@Body.")'', using a dummy clause whose body is a glob +%% lifted one level. +%% +%% To visualize the structure of a syntax tree, you can use the function +%% `merl:show(T)', which prints a summary. For example, entering +%% ```merl:show(merl:quote("inc(X, Y) when Y > 0 -> X + Y."))''' +%% in the Erlang shell will print the following (where the `+' signs separate +%% groups of subtrees on the same level): +%% ```function: inc(X, Y) when ... -> X + Y. +%% atom: inc +%% + +%% clause: (X, Y) when ... -> X + Y +%% variable: X +%% variable: Y +%% + +%% disjunction: Y > 0 +%% conjunction: Y > 0 +%% infix_expr: Y > 0 +%% variable: Y +%% + +%% operator: > +%% + +%% integer: 0 +%% + +%% infix_expr: X + Y +%% variable: X +%% + +%% operator: + +%% + +%% variable: Y''' +%% +%% This shows another important non-obvious case: a clause guard, even if it's +%% as simple as `Y > 0', always consists of a single disjunction of one or more +%% conjunctions of tests, much like a tuple of tuples. Thus: +%% <ul> +%% <li>``"when _@Guard ->"'' will only match a guard with exactly one +%% test</li> +%% <li>``"when _@@@@Guard ->"'' will match a guard with one or more +%% comma-separated tests (but no semicolons), binding `Guard' to the list +%% of tests</li> +%% <li>``"when _@_Guard ->"'' will match just like the previous pattern, but +%% binds `Guard' to the conjunction subtree</li> +%% <li>``"when _@_@Guard ->"'' will match an arbitrary nonempty guard, +%% binding `Guard' to the list of conjunction subtrees</li> +%% <li>``"when _@__Guard ->"'' will match like the previous pattern, but +%% binds `Guard' to the whole disjunction subtree</li> +%% <li>and finally, ``"when _@__@Guard ->"'' will match any clause, +%% binding `Guard' to `[]' if the guard is empty and to `[Disjunction]' +%% otherwise</li> +%% </ul> +%% +%% Thus, the following pattern matches all possible clauses: +%% ```"(_@@Args) when _@__@Guard -> _@@Body"''' +%% @end + +-module(merl). + +-export([term/1, var/1, print/1, show/1]). + +-export([quote/1, quote/2, qquote/2, qquote/3]). + +-export([template/1, tree/1, subst/2, tsubst/2, alpha/2, match/2, switch/2]). + +-export([template_vars/1, meta_template/1]). + +-export([compile/1, compile/2, compile_and_load/1, compile_and_load/2]). + +%% NOTE: this module may not include merl.hrl! + +-type tree() :: erl_syntax:syntaxTree(). + +-type tree_or_trees() :: tree() | [tree()]. + +-type pattern() :: tree() | template(). + +-type pattern_or_patterns() :: pattern() | [pattern()]. + +-type env() :: [{Key::id(), pattern_or_patterns()}]. + +-type id() :: atom() | integer(). + +%% A list of strings or binaries is assumed to represent individual lines, +%% while a flat string or binary represents source code containing newlines. +-type text() :: string() | binary() | [string()] | [binary()]. + +-type location() :: erl_anno:location(). + + +%% ------------------------------------------------------------------------ +%% Compiling and loading code directly to memory + +%% @equiv compile(Code, []) +compile(Code) -> + compile(Code, []). + +%% @doc Compile a syntax tree or list of syntax trees representing a module +%% into a binary BEAM object. +%% @see compile_and_load/2 +%% @see compile/1 +compile(Code, Options) when not is_list(Code)-> + case type(Code) of + form_list -> compile(erl_syntax:form_list_elements(Code)); + _ -> compile([Code], Options) + end; +compile(Code, Options0) when is_list(Options0) -> + Forms = [erl_syntax:revert(F) || F <- Code], + Options = [verbose, report_errors, report_warnings, binary | Options0], + compile:noenv_forms(Forms, Options). + + +%% @equiv compile_and_load(Code, []) +compile_and_load(Code) -> + compile_and_load(Code, []). + +%% @doc Compile a syntax tree or list of syntax trees representing a module +%% and load the resulting module into memory. +%% @see compile/2 +%% @see compile_and_load/1 +compile_and_load(Code, Options) -> + case compile(Code, Options) of + {ok, ModuleName, Binary} -> + _ = code:load_binary(ModuleName, "", Binary), + {ok, Binary}; + Other -> Other + end. + + +%% ------------------------------------------------------------------------ +%% Utility functions + + +-spec var(atom()) -> tree(). + +%% @doc Create a variable. + +var(Name) -> + erl_syntax:variable(Name). + + +-spec term(term()) -> tree(). + +%% @doc Create a syntax tree for a constant term. + +term(Term) -> + erl_syntax:abstract(Term). + + +%% @doc Pretty-print a syntax tree or template to the standard output. This +%% is a utility function for development and debugging. + +print(Ts) when is_list(Ts) -> + lists:foreach(fun print/1, Ts); +print(T) -> + io:put_chars(erl_prettypr:format(tree(T))), + io:nl(). + +%% @doc Print the structure of a syntax tree or template to the standard +%% output. This is a utility function for development and debugging. + +show(Ts) when is_list(Ts) -> + lists:foreach(fun show/1, Ts); +show(T) -> + io:put_chars(pp(tree(T), 0)), + io:nl(). + +pp(T, I) -> + [lists:duplicate(I, $\s), + limit(lists:flatten([atom_to_list(type(T)), ": ", + erl_prettypr:format(erl_syntax_lib:limit(T,3))]), + 79-I), + $\n, + pp_1(lists:filter(fun (X) -> X =/= [] end, subtrees(T)), I+2) + ]. + +pp_1([G], I) -> + pp_2(G, I); +pp_1([G | Gs], I) -> + [pp_2(G, I), lists:duplicate(I, $\s), "+\n" | pp_1(Gs, I)]; +pp_1([], _I) -> + []. + +pp_2(G, I) -> + [pp(E, I) || E <- G]. + +%% limit string to N characters, stay on a single line and compact whitespace +limit([$\n | Cs], N) -> limit([$\s | Cs], N); +limit([$\r | Cs], N) -> limit([$\s | Cs], N); +limit([$\v | Cs], N) -> limit([$\s | Cs], N); +limit([$\t | Cs], N) -> limit([$\s | Cs], N); +limit([$\s, $\s | Cs], N) -> limit([$\s | Cs], N); +limit([C | Cs], N) when C < 32 -> limit(Cs, N); +limit([C | Cs], N) when N > 3 -> [C | limit(Cs, N-1)]; +limit([_C1, _C2, _C3, _C4 | _Cs], 3) -> "..."; +limit(Cs, 3) -> Cs; +limit([_C1, _C2, _C3 | _], 2) -> ".."; +limit(Cs, 2) -> Cs; +limit([_C1, _C2 | _], 1) -> "."; +limit(Cs, 1) -> Cs; +limit(_, _) -> []. + +%% ------------------------------------------------------------------------ +%% Parsing and instantiating code fragments + + +-spec qquote(Text::text(), Env::env()) -> tree_or_trees(). + +%% @doc Parse text and substitute meta-variables. +%% +%% @equiv qquote(1, Text, Env) + +qquote(Text, Env) -> + qquote(1, Text, Env). + + +-spec qquote(StartPos::location(), Text::text(), Env::env()) -> tree_or_trees(). + +%% @doc Parse text and substitute meta-variables. Takes an initial scanner +%% starting position as first argument. +%% +%% The macro `?Q(Text, Env)' expands to `merl:qquote(?LINE, Text, Env)'. +%% +%% @see quote/2 + +qquote(StartPos, Text, Env) -> + subst(quote(StartPos, Text), Env). + + +-spec quote(Text::text()) -> tree_or_trees(). + +%% @doc Parse text. +%% +%% @equiv quote(1, Text) + +quote(Text) -> + quote(1, Text). + + +-spec quote(StartPos::location(), Text::text()) -> tree_or_trees(). + +%% @doc Parse text. Takes an initial scanner starting position as first +%% argument. +%% +%% The macro `?Q(Text)' expands to `merl:quote(?LINE, Text, Env)'. +%% +%% @see quote/1 + +quote({Line, Col}, Text) + when is_integer(Line), is_integer(Col) -> + quote_1(Line, Col, Text); +quote(StartPos, Text) when is_integer(StartPos) -> + quote_1(StartPos, undefined, Text). + +quote_1(StartLine, StartCol, Text) -> + %% be backwards compatible as far as R12, ignoring any starting column + StartPos = case erlang:system_info(version) of + "5.6" ++ _ -> StartLine; + "5.7" ++ _ -> StartLine; + "5.8" ++ _ -> StartLine; + _ when StartCol =:= undefined -> StartLine; + _ -> {StartLine, StartCol} + end, + FlatText = flatten_text(Text), + {ok, Ts, _} = erl_scan:string(FlatText, StartPos), + merge_comments(StartLine, erl_comment_scan:string(FlatText), parse_1(Ts)). + +parse_1(Ts) -> + %% if dot tokens are present, it is assumed that the text represents + %% complete forms, not dot-terminated expressions or similar + case split_forms(Ts) of + {ok, Fs} -> parse_forms(Fs); + error -> + parse_2(Ts) + end. + +split_forms(Ts) -> + split_forms(Ts, [], []). + +split_forms([{dot,_}=T|Ts], Fs, As) -> + split_forms(Ts, [lists:reverse(As, [T]) | Fs], []); +split_forms([T|Ts], Fs, As) -> + split_forms(Ts, Fs, [T|As]); +split_forms([], Fs, []) -> + {ok, lists:reverse(Fs)}; +split_forms([], [], _) -> + error; % no dot tokens found - not representing form(s) +split_forms([], _, [T|_]) -> + fail("incomplete form after ~p", [T]). + +parse_forms([Ts | Tss]) -> + case erl_parse:parse_form(Ts) of + {ok, Form} -> [Form | parse_forms(Tss)]; + {error, R} -> parse_error(R) + end; +parse_forms([]) -> + []. + +parse_2(Ts) -> + %% one or more comma-separated expressions? + %% (recall that Ts has no dot tokens if we get to this stage) + A = a0(), + case erl_parse:parse_exprs(Ts ++ [{dot,A}]) of + {ok, Exprs} -> Exprs; + {error, E} -> + parse_3(Ts ++ [{'end',A}, {dot,A}], [E]) + end. + +parse_3(Ts, Es) -> + %% try-clause or clauses? + A = a0(), + case erl_parse:parse_exprs([{'try',A}, {atom,A,true}, {'catch',A} | Ts]) of + {ok, [{'try',_,_,_,_,_}=X]} -> + %% get the right kind of qualifiers in the clause patterns + erl_syntax:try_expr_handlers(X); + {error, E} -> + parse_4(Ts, [E|Es]) + end. + +parse_4(Ts, Es) -> + %% fun-clause or clauses? (`(a)' is also a pattern, but `(a,b)' isn't, + %% so fun-clauses must be tried before normal case-clauses + A = a0(), + case erl_parse:parse_exprs([{'fun',A} | Ts]) of + {ok, [{'fun',_,{clauses,Cs}}]} -> Cs; + {error, E} -> + parse_5(Ts, [E|Es]) + end. + +parse_5(Ts, Es) -> + %% case-clause or clauses? + A = a0(), + case erl_parse:parse_exprs([{'case',A}, {atom,A,true}, {'of',A} | Ts]) of + {ok, [{'case',_,_,Cs}]} -> Cs; + {error, E} -> + %% select the best error to report + parse_error(lists:last(lists:sort([E|Es]))) + end. + +-dialyzer({nowarn_function, parse_error/1}). % no local return + +parse_error({L, M, R}) when is_atom(M), is_integer(L) -> + fail("~w: ~s", [L, M:format_error(R)]); +parse_error({{L,C}, M, R}) when is_atom(M), is_integer(L), is_integer(C) -> + fail("~w:~w: ~s", [L,C,M:format_error(R)]); +parse_error({_, M, R}) when is_atom(M) -> + fail(M:format_error(R)); +parse_error(R) -> + fail("unknown parse error: ~p", [R]). + +%% ------------------------------------------------------------------------ +%% Templates, substitution and matching + +%% Leaves are normal syntax trees, and inner nodes are tuples +%% {template,Type,Attrs,Groups} where Groups are lists of lists of nodes. +%% Metavariables are 1-tuples {VarName}, where VarName is an atom or an +%% integer. {'_'} and {0} work as anonymous variables in matching. Glob +%% metavariables are tuples {'*',VarName}, and {'*','_'} and {'*',0} are +%% anonymous globs. + +%% Note that although template() :: tree() | ..., it is implied that these +%% syntax trees are free from metavariables, so pattern() :: tree() | +%% template() is in fact a wider type than template(). + +-type template() :: tree() + | {id()} + | {'*',id()} + | {template, atom(), term(), [[template()]]}. + +-type template_or_templates() :: template() | [template()]. + +-spec template(pattern_or_patterns()) -> template_or_templates(). + +%% @doc Turn a syntax tree or list of trees into a template or templates. +%% Templates can be instantiated or matched against, and reverted back to +%% normal syntax trees using {@link tree/1}. If the input is already a +%% template, it is not modified further. +%% +%% @see subst/2 +%% @see match/2 +%% @see tree/1 + +template(Trees) when is_list(Trees) -> + [template_0(T) || T <- Trees]; +template(Tree) -> + template_0(Tree). + +template_0({template, _, _, _}=Template) -> Template; +template_0({'*',_}=Template) -> Template; +template_0({_}=Template) -> Template; +template_0(Tree) -> + case template_1(Tree) of + false -> Tree; + {Name} when is_list(Name) -> + fail("bad metavariable: '~s'", [tl(Name)]); % drop v/n from name + Template -> Template + end. + +%% returns either a template or a lifted metavariable {String}, or 'false' +%% if Tree contained no metavariables +template_1(Tree) -> + case subtrees(Tree) of + [] -> + case metavar(Tree) of + {"v_"++Cs}=V when Cs =/= [] -> V; % to be lifted + {"n0"++Cs}=V when Cs =/= [] -> V; % to be lifted + {"v@"++Cs} when Cs =/= [] -> {'*',list_to_atom(Cs)}; + {"n9"++Cs} when Cs =/= [] -> {'*',list_to_integer(Cs)}; + {"v"++Cs} -> {list_to_atom(Cs)}; + {"n"++Cs} -> {list_to_integer(Cs)}; + false -> false + end; + Gs -> + case template_2(Gs, [], false) of + Gs1 when is_list(Gs1) -> + {template, type(Tree), erl_syntax:get_attrs(Tree), Gs1}; + Other -> + Other + end + end. + +template_2([G | Gs], As, Bool) -> + case template_3(G, [], false) of + {"v_"++Cs}=V when Cs =/= [] -> V; % lift further + {"n0"++Cs}=V when Cs =/= [] -> V; % lift further + {"v@"++Cs} when Cs =/= [] -> {'*',list_to_atom(Cs)}; % stop + {"n9"++Cs} when Cs =/= [] -> {'*',list_to_integer(Cs)}; % stop + {"v"++Cs} when is_list(Cs) -> {list_to_atom(Cs)}; % stop + {"n"++Cs} when is_list(Cs) -> {list_to_integer(Cs)}; % stop + false -> template_2(Gs, [G | As], Bool); + G1 -> template_2(Gs, [G1 | As], true) + end; +template_2([], _As, false) -> false; +template_2([], As, true) -> lists:reverse(As). + +template_3([T | Ts], As, Bool) -> + case template_1(T) of + {"v_"++Cs} when Cs =/= [] -> {"v"++Cs}; % lift + {"n0"++Cs} when Cs =/= [] -> {"n"++Cs}; % lift + false -> template_3(Ts, [T | As], Bool); + T1 -> template_3(Ts, [T1 | As], true) + end; +template_3([], _As, false) -> false; +template_3([], As, true) -> lists:reverse(As). + + +%% @doc Turn a template into a syntax tree representing the template. +%% Meta-variables in the template are turned into normal Erlang variables if +%% their names (after the metavariable prefix characters) begin with an +%% uppercase character. E.g., `_@Foo' in the template becomes the variable +%% `Foo' in the meta-template. Furthermore, variables ending with `@' are +%% automatically wrapped in a call to merl:term/1, so e.g. `_@Foo@ in the +%% template becomes `merl:term(Foo)' in the meta-template. + +-spec meta_template(template_or_templates()) -> tree_or_trees(). + +meta_template(Templates) when is_list(Templates) -> + [meta_template_1(T) || T <- Templates]; +meta_template(Template) -> + meta_template_1(Template). + +meta_template_1({template, Type, Attrs, Groups}) -> + erl_syntax:tuple( + [erl_syntax:atom(template), + erl_syntax:atom(Type), + erl_syntax:abstract(Attrs), + erl_syntax:list([erl_syntax:list([meta_template_1(T) || T <- G]) + || G <- Groups])]); +meta_template_1({Var}=V) -> + meta_template_2(Var, V); +meta_template_1({'*',Var}=V) -> + meta_template_2(Var, V); +meta_template_1(Leaf) -> + erl_syntax:abstract(Leaf). + +meta_template_2(Var, V) when is_atom(Var) -> + case atom_to_list(Var) of + [C|_]=Name when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× -> + case lists:reverse(Name) of + "@"++([_|_]=RevRealName) -> % don't allow empty RealName + RealName = lists:reverse(RevRealName), + erl_syntax:application(erl_syntax:atom(merl), + erl_syntax:atom(term), + [erl_syntax:variable(RealName)]); + _ -> + %% plain automatic metavariable + erl_syntax:variable(Name) + end; + _ -> + erl_syntax:abstract(V) + end; +meta_template_2(Var, V) when is_integer(Var) -> + if Var > 9, (Var rem 10) =:= 9 -> + %% at least 2 digits, ends in 9: make it a Q-variable + if Var > 99, (Var rem 100) =:= 99 -> + %% at least 3 digits, ends in 99: wrap in merl:term/1 + Name = "Q" ++ integer_to_list(Var div 100), + erl_syntax:application(erl_syntax:atom(merl), + erl_syntax:atom(term), + [erl_syntax:variable(Name)]); + true -> + %% plain automatic Q-variable + Name = integer_to_list(Var div 10), + erl_syntax:variable("Q" ++ Name) + end; + true -> + erl_syntax:abstract(V) + end. + + + +-spec template_vars(template_or_templates()) -> [id()]. + +%% @doc Return an ordered list of the metavariables in the template. + +template_vars(Template) -> + template_vars(Template, []). + +template_vars(Templates, Vars) when is_list(Templates) -> + lists:foldl(fun template_vars_1/2, Vars, Templates); +template_vars(Template, Vars) -> + template_vars_1(Template, Vars). + +template_vars_1({template, _, _, Groups}, Vars) -> + lists:foldl(fun (G, V) -> lists:foldl(fun template_vars_1/2, V, G) end, + Vars, Groups); +template_vars_1({Var}, Vars) -> + ordsets:add_element(Var, Vars); +template_vars_1({'*',Var}, Vars) -> + ordsets:add_element(Var, Vars); +template_vars_1(_, Vars) -> + Vars. + + +-spec tree(template_or_templates()) -> tree_or_trees(). + +%% @doc Revert a template to a normal syntax tree. Any remaining +%% metavariables are turned into `@'-prefixed atoms or `909'-prefixed +%% integers. +%% @see template/1 + +tree(Templates) when is_list(Templates) -> + [tree_1(T) || T <- Templates]; +tree(Template) -> + tree_1(Template). + +tree_1({template, Type, Attrs, Groups}) -> + %% flattening here is needed for templates created via source transforms + Gs = [lists:flatten([tree_1(T) || T <- G]) || G <- Groups], + erl_syntax:set_attrs(make_tree(Type, Gs), Attrs); +tree_1({Var}) when is_atom(Var) -> + erl_syntax:atom(list_to_atom("@"++atom_to_list(Var))); +tree_1({Var}) when is_integer(Var) -> + erl_syntax:integer(list_to_integer("909"++integer_to_list(Var))); +tree_1({'*',Var}) when is_atom(Var) -> + erl_syntax:atom(list_to_atom("@@"++atom_to_list(Var))); +tree_1({'*',Var}) when is_integer(Var) -> + erl_syntax:integer(list_to_integer("9099"++integer_to_list(Var))); +tree_1(Leaf) -> + Leaf. % any syntax tree, not necessarily atomic (due to substitutions) + + +-spec subst(pattern_or_patterns(), env()) -> tree_or_trees(). + +%% @doc Substitute metavariables in a pattern or list of patterns, yielding +%% a syntax tree or list of trees as result. Both for normal metavariables +%% and glob metavariables, the substituted value may be a single element or +%% a list of elements. For example, if a list representing `1, 2, 3' is +%% substituted for `var' in either of `[foo, _@var, bar]' or `[foo, _@@var, +%% bar]', the result represents `[foo, 1, 2, 3, bar]'. + +subst(Trees, Env) when is_list(Trees) -> + [subst_0(T, Env) || T <- Trees]; +subst(Tree, Env) -> + subst_0(Tree, Env). + +subst_0(Tree, Env) -> + tree_1(subst_1(template(Tree), Env)). + + +-spec tsubst(pattern_or_patterns(), env()) -> template_or_templates(). + +%% @doc Like subst/2, but does not convert the result from a template back +%% to a tree. Useful if you want to do multiple separate substitutions. +%% @see subst/2 +%% @see tree/1 + +tsubst(Trees, Env) when is_list(Trees) -> + [subst_1(template(T), Env) || T <- Trees]; +tsubst(Tree, Env) -> + subst_1(template(Tree), Env). + +subst_1({template, Type, Attrs, Groups}, Env) -> + Gs1 = [lists:flatten([subst_1(T, Env) || T <- G]) || G <- Groups], + {template, Type, Attrs, Gs1}; +subst_1({Var}=V, Env) -> + case lists:keyfind(Var, 1, Env) of + {Var, TreeOrTrees} -> TreeOrTrees; + false -> V + end; +subst_1({'*',Var}=V, Env) -> + case lists:keyfind(Var, 1, Env) of + {Var, TreeOrTrees} -> TreeOrTrees; + false -> V + end; +subst_1(Leaf, _Env) -> + Leaf. + + +-spec alpha(pattern_or_patterns(), [{id(), id()}]) -> template_or_templates(). + +%% @doc Alpha converts a pattern (renames variables). Similar to tsubst/1, +%% but only renames variables (including globs). +%% @see tsubst/2 + +alpha(Trees, Env) when is_list(Trees) -> + [alpha_1(template(T), Env) || T <- Trees]; +alpha(Tree, Env) -> + alpha_1(template(Tree), Env). + +alpha_1({template, Type, Attrs, Groups}, Env) -> + Gs1 = [lists:flatten([alpha_1(T, Env) || T <- G]) || G <- Groups], + {template, Type, Attrs, Gs1}; +alpha_1({Var}=V, Env) -> + case lists:keyfind(Var, 1, Env) of + {Var, NewVar} -> {NewVar}; + false -> V + end; +alpha_1({'*',Var}=V, Env) -> + case lists:keyfind(Var, 1, Env) of + {Var, NewVar} -> {'*',NewVar}; + false -> V + end; +alpha_1(Leaf, _Env) -> + Leaf. + + +-spec match(pattern_or_patterns(), tree_or_trees()) -> + {ok, env()} | error. + +%% @doc Match a pattern against a syntax tree (or patterns against syntax +%% trees) returning an environment mapping variable names to subtrees; the +%% environment is always sorted on keys. Note that multiple occurrences of +%% metavariables in the pattern is not allowed, but is not checked. +%% +%% @see template/1 +%% @see switch/2 + +match(Patterns, Trees) when is_list(Patterns), is_list(Trees) -> + try {ok, match_1(Patterns, Trees, [])} + catch + error -> error + end; +match(Patterns, Tree) when is_list(Patterns) -> match(Patterns, [Tree]); +match(Pattern, Trees) when is_list(Trees) -> match([Pattern], Trees); +match(Pattern, Tree) -> + try {ok, match_template(template(Pattern), Tree, [])} + catch + error -> error + end. + +match_1([P|Ps], [T | Ts], Dict) -> + match_1(Ps, Ts, match_template(template(P), T, Dict)); +match_1([], [], Dict) -> + Dict; +match_1(_, _, _Dict) -> + erlang:error(merl_match_arity). + +%% match a template against a syntax tree +match_template({template, Type, _, Gs}, Tree, Dict) -> + case type(Tree) of + Type -> match_template_1(Gs, subtrees(Tree), Dict); + _ -> throw(error) % type mismatch + end; +match_template({Var}, _Tree, Dict) + when Var =:= '_' ; Var =:= 0 -> + Dict; % anonymous variable +match_template({Var}, Tree, Dict) -> + orddict:store(Var, Tree, Dict); +match_template(Tree1, Tree2, Dict) -> + %% if Tree1 is not a template, Tree1 and Tree2 are both syntax trees + case compare_trees(Tree1, Tree2) of + true -> Dict; + false -> throw(error) % different trees + end. + +match_template_1([G1 | Gs1], [G2 | Gs2], Dict) -> + match_template_2(G1, G2, match_template_1(Gs1, Gs2, Dict)); +match_template_1([], [], Dict) -> + Dict; +match_template_1(_, _, _Dict) -> + throw(error). % shape mismatch + +match_template_2([{Var} | Ts1], [_ | Ts2], Dict) + when Var =:= '_' ; Var =:= 0 -> + match_template_2(Ts1, Ts2, Dict); % anonymous variable +match_template_2([{Var} | Ts1], [Tree | Ts2], Dict) -> + match_template_2(Ts1, Ts2, orddict:store(Var, Tree, Dict)); +match_template_2([{'*',Var} | Ts1], Ts2, Dict) -> + match_glob(lists:reverse(Ts1), lists:reverse(Ts2), Var, Dict); +match_template_2([T1 | Ts1], [T2 | Ts2], Dict) -> + match_template_2(Ts1, Ts2, match_template(T1, T2, Dict)); +match_template_2([], [], Dict) -> + Dict; +match_template_2(_, _, _Dict) -> + throw(error). % shape mismatch + +%% match the tails in reverse order; no further globs allowed +match_glob([{'*',Var} | _], _, _, _) -> + fail("multiple glob variables in same match group: ~w", [Var]); +match_glob([T1 | Ts1], [T2 | Ts2], Var, Dict) -> + match_glob(Ts1, Ts2, Var, match_template(T1, T2, Dict)); +match_glob([], _Group, Var, Dict) when Var =:= '_' ; Var =:= 0 -> + Dict; % anonymous glob variable +match_glob([], Group, Var, Dict) -> + orddict:store(Var, lists:reverse(Group), Dict); +match_glob(_, _, _, _Dict) -> + throw(error). % shape mismatch + + +%% compare two syntax trees for equivalence +compare_trees(T1, T2) -> + Type1 = type(T1), + case type(T2) of + Type1 -> + case subtrees(T1) of + [] -> + case subtrees(T2) of + [] -> compare_leaves(Type1, T1, T2); + _Gs2 -> false % shape mismatch + end; + Gs1 -> + case subtrees(T2) of + [] -> false; % shape mismatch + Gs2 -> compare_trees_1(Gs1, Gs2) + end + end; + _Type2 -> + false % different tree types + end. + +compare_trees_1([G1 | Gs1], [G2 | Gs2]) -> + compare_trees_2(G1, G2) andalso compare_trees_1(Gs1, Gs2); +compare_trees_1([], []) -> + true; +compare_trees_1(_, _) -> + false. % shape mismatch + +compare_trees_2([T1 | Ts1], [T2 | Ts2]) -> + compare_trees(T1, T2) andalso compare_trees_2(Ts1, Ts2); +compare_trees_2([], []) -> + true; +compare_trees_2(_, _) -> + false. % shape mismatch + +compare_leaves(Type, T1, T2) -> + case Type of + atom -> + erl_syntax:atom_value(T1) + =:= erl_syntax:atom_value(T2); + char -> + erl_syntax:char_value(T1) + =:= erl_syntax:char_value(T2); + float -> + erl_syntax:float_value(T1) + =:= erl_syntax:float_value(T2); + integer -> + erl_syntax:integer_value(T1) + =:= erl_syntax:integer_value(T2); + string -> + erl_syntax:string_value(T1) + =:= erl_syntax:string_value(T2); + operator -> + erl_syntax:operator_name(T1) + =:= erl_syntax:operator_name(T2); + text -> + erl_syntax:text_string(T1) + =:= erl_syntax:text_string(T2); + variable -> + erl_syntax:variable_name(T1) + =:= erl_syntax:variable_name(T2); + _ -> + true % trivially equal nodes + end. + + +%% @doc Match against one or more clauses with patterns and optional guards. +%% +%% Note that clauses following a default action will be ignored. +%% +%% @see match/2 + +-type switch_clause() :: + {pattern_or_patterns(), guarded_actions()} + | {pattern_or_patterns(), guard_test(), switch_action()} + | default_action(). + +-type guarded_actions() :: guarded_action() | [guarded_action()]. + +-type guarded_action() :: switch_action() | {guard_test(), switch_action()}. + +-type switch_action() :: fun( (env()) -> any() ). + +-type guard_test() :: fun( (env()) -> boolean() ). + +-type default_action() :: fun( () -> any() ). + + +-spec switch(tree_or_trees(), [switch_clause()]) -> any(). + +switch(Trees, [{Patterns, GuardedActions} | Cs]) when is_list(GuardedActions) -> + switch_1(Trees, Patterns, GuardedActions, Cs); +switch(Trees, [{Patterns, GuardedAction} | Cs]) -> + switch_1(Trees, Patterns, [GuardedAction], Cs); +switch(Trees, [{Patterns, Guard, Action} | Cs]) -> + switch_1(Trees, Patterns, [{Guard, Action}], Cs); +switch(_Trees, [Default | _Cs]) when is_function(Default, 0) -> + Default(); +switch(_Trees, []) -> + erlang:error(merl_switch_clause); +switch(_Tree, _) -> + erlang:error(merl_switch_badarg). + +switch_1(Trees, Patterns, GuardedActions, Cs) -> + case match(Patterns, Trees) of + {ok, Env} -> + switch_2(Env, GuardedActions, Trees, Cs); + error -> + switch(Trees, Cs) + end. + +switch_2(Env, [{Guard, Action} | Bs], Trees, Cs) + when is_function(Guard, 1), is_function(Action, 1) -> + case Guard(Env) of + true -> Action(Env); + false -> switch_2(Env, Bs, Trees, Cs) + end; +switch_2(Env, [Action | _Bs], _Trees, _Cs) when is_function(Action, 1) -> + Action(Env); +switch_2(_Env, [], Trees, Cs) -> + switch(Trees, Cs); +switch_2(_Env, _, _Trees, _Cs) -> + erlang:error(merl_switch_badarg). + + +%% ------------------------------------------------------------------------ +%% Internal utility functions + +-dialyzer({nowarn_function, fail/1}). % no local return + +fail(Text) -> + fail(Text, []). + +fail(Fs, As) -> + throw({error, lists:flatten(io_lib:format(Fs, As))}). + +flatten_text([L | _]=Lines) when is_list(L) -> + lists:foldr(fun(S, T) -> S ++ [$\n | T] end, "", Lines); +flatten_text([B | _]=Lines) when is_binary(B) -> + lists:foldr(fun(S, T) -> binary_to_list(S) ++ [$\n | T] end, "", Lines); +flatten_text(Text) when is_binary(Text) -> + binary_to_list(Text); +flatten_text(Text) -> + Text. + +-spec metavar(tree()) -> {string()} | false. + +%% Check if a syntax tree represents a metavariable. If not, 'false' is +%% returned; otherwise, this returns a 1-tuple with a string containing the +%% variable name including lift/glob prefixes but without any leading +%% metavariable prefix, and instead prefixed with "v" for a variable or "i" +%% for an integer. +%% +%% Metavariables are atoms starting with @, variables starting with _@, +%% strings starting with "'@, or integers starting with 909. Following the +%% prefix, one or more _ or 0 characters (unless it's the last character in +%% the name) may be used to indicate "lifting" of the variable one or more +%% levels , and after that, a @ or 9 character indicates a glob metavariable +%% rather than a normal metavariable. If the name after the prefix is _ or +%% 0, the variable is treated as an anonymous catch-all pattern in matches. + +metavar(Tree) -> + case type(Tree) of + atom -> + case erl_syntax:atom_name(Tree) of + "@" ++ Cs when Cs =/= [] -> {"v"++Cs}; + _ -> false + end; + variable -> + case erl_syntax:variable_literal(Tree) of + "_@" ++ Cs when Cs =/= [] -> {"v"++Cs}; + _ -> false + end; + integer -> + case erl_syntax:integer_value(Tree) of + N when N >= 9090 -> + case integer_to_list(N) of + "909" ++ Cs -> {"n"++Cs}; + _ -> false + end; + _ -> false + end; + string -> + case erl_syntax:string_value(Tree) of + "'@" ++ Cs -> {"v"++Cs}; + _ -> false + end; + _ -> + false + end. + +%% wrappers around erl_syntax functions to provide more uniform shape of +%% generic subtrees (maybe this can be fixed in syntax_tools one day) + +type(T) -> + case erl_syntax:type(T) of + nil -> list; + Type -> Type + end. + +subtrees(T) -> + case erl_syntax:type(T) of + tuple -> + [erl_syntax:tuple_elements(T)]; %% don't treat {} as a leaf + nil -> + [[], []]; %% don't treat [] as a leaf, but as a list + list -> + case erl_syntax:list_suffix(T) of + none -> + [erl_syntax:list_prefix(T), []]; + S -> + [erl_syntax:list_prefix(T), [S]] + end; + binary_field -> + [[erl_syntax:binary_field_body(T)], + erl_syntax:binary_field_types(T)]; + clause -> + case erl_syntax:clause_guard(T) of + none -> + [erl_syntax:clause_patterns(T), [], + erl_syntax:clause_body(T)]; + G -> + [erl_syntax:clause_patterns(T), [G], + erl_syntax:clause_body(T)] + end; + receive_expr -> + case erl_syntax:receive_expr_timeout(T) of + none -> + [erl_syntax:receive_expr_clauses(T), [], []]; + E -> + [erl_syntax:receive_expr_clauses(T), [E], + erl_syntax:receive_expr_action(T)] + end; + record_expr -> + case erl_syntax:record_expr_argument(T) of + none -> + [[], [erl_syntax:record_expr_type(T)], + erl_syntax:record_expr_fields(T)]; + V -> + [[V], [erl_syntax:record_expr_type(T)], + erl_syntax:record_expr_fields(T)] + end; + record_field -> + case erl_syntax:record_field_value(T) of + none -> + [[erl_syntax:record_field_name(T)], []]; + V -> + [[erl_syntax:record_field_name(T)], [V]] + end; + _ -> + erl_syntax:subtrees(T) + end. + +make_tree(list, [P, []]) -> erl_syntax:list(P); +make_tree(list, [P, [S]]) -> erl_syntax:list(P, S); +make_tree(tuple, [E]) -> erl_syntax:tuple(E); +make_tree(binary_field, [[B], Ts]) -> erl_syntax:binary_field(B, Ts); +make_tree(clause, [P, [], B]) -> erl_syntax:clause(P, none, B); +make_tree(clause, [P, [G], B]) -> erl_syntax:clause(P, G, B); +make_tree(receive_expr, [C, [], _A]) -> erl_syntax:receive_expr(C); +make_tree(receive_expr, [C, [E], A]) -> erl_syntax:receive_expr(C, E, A); +make_tree(record_expr, [[], [T], F]) -> erl_syntax:record_expr(T, F); +make_tree(record_expr, [[E], [T], F]) -> erl_syntax:record_expr(E, T, F); +make_tree(record_field, [[N], []]) -> erl_syntax:record_field(N); +make_tree(record_field, [[N], [E]]) -> erl_syntax:record_field(N, E); +make_tree(Type, Groups) -> + erl_syntax:make_tree(Type, Groups). + +merge_comments(_StartLine, [], [T]) -> T; +merge_comments(_StartLine, [], Ts) -> Ts; +merge_comments(StartLine, Comments, Ts) -> + merge_comments(StartLine, Comments, Ts, []). + +merge_comments(_StartLine, [], [], [T]) -> T; +merge_comments(_StartLine, [], [T], []) -> T; +merge_comments(_StartLine, [], Ts, Acc) -> + lists:reverse(Acc, Ts); +merge_comments(StartLine, Cs, [], Acc) -> + merge_comments(StartLine, [], [], + [erl_syntax:set_pos( + erl_syntax:comment(Indent, Text), + anno(StartLine + Line - 1)) + || {Line, _, Indent, Text} <- Cs] ++ Acc); +merge_comments(StartLine, [C|Cs], [T|Ts], Acc) -> + {Line, _Col, Indent, Text} = C, + CommentLine = StartLine + Line - 1, + case erl_syntax:get_pos(T) of + Pos when Pos < CommentLine -> + %% TODO: traverse sub-tree rather than only the top level nodes + merge_comments(StartLine, [C|Cs], Ts, [T|Acc]); + CommentLine -> + Tc = erl_syntax:add_postcomments( + [erl_syntax:comment(Indent, Text)], T), + merge_comments(StartLine, Cs, [Tc|Ts], Acc); + _ -> + Tc = erl_syntax:add_precomments( + [erl_syntax:comment(Indent, Text)], T), + merge_comments(StartLine, Cs, [Tc|Ts], Acc) + end. + +a0() -> + anno(0). + +anno(Location) -> + erl_anno:new(Location). diff --git a/lib/syntax_tools/src/merl_tests.erl b/lib/syntax_tools/src/merl_tests.erl new file mode 100644 index 0000000000..61efc6935e --- /dev/null +++ b/lib/syntax_tools/src/merl_tests.erl @@ -0,0 +1,564 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012-2015 Richard Carlsson +%% @doc Unit tests for merl. +%% @private + +-module(merl_tests). + +%-define(MERL_NO_TRANSFORM, true). +-include("merl.hrl"). + +-include_lib("eunit/include/eunit.hrl"). + + +%% utilities + +f(Ts) when is_list(Ts) -> + lists:flatmap(fun erl_prettypr:format/1, Ts); +f(T) -> + erl_prettypr:format(T). + +fe(Env) -> [{Key, f(T)} || {Key, T} <- Env]. + +g_exported_() -> + %% for testing the parse transform, autoexported to avoid complaints + {ok, merl:quote(?LINE, "42")}. + + +ok({ok, X}) -> X. + + +%% +%% tests +%% + +parse_error_test_() -> + [?_assertThrow({error, "1: syntax error before: '{'" ++ _}, + f(merl:quote("{"))) + ]. + +transform_parse_error_test_() -> + [?_assertEqual("merl:quote(\"{\")", + f(merl_transform:parse_transform( + [?Q("merl:quote(\"{\")")], []))), + ?_assertEqual("merl:quote(2, \"{\")", + f(merl_transform:parse_transform( + [?Q("merl:quote(2, \"{\")")], []))), + ?_assertEqual("merl:qquote(\"{\", [{var, V}])", + f(merl_transform:parse_transform( + [?Q("merl:qquote(\"{\", [{var, V}])")], []))), + ?_assertEqual("merl:qquote(2, \"{\", [{var, V}])", + f(merl_transform:parse_transform( + [?Q("merl:qquote(2, \"{\", [{var, V}])")], []))) + ]. + +term_test_() -> + [?_assertEqual(tuple, erl_syntax:type(merl:term({}))), + ?_assertEqual("{foo, 42}", f(merl:term({foo, 42}))) + ]. + +quote_form_test_() -> + [?_assertEqual("f(X) -> {ok, X}.", + f(?Q("f(X) -> {ok, X}."))), + ?_assertEqual("-module(foo).", + f(?Q("-module(foo)."))), + ?_assertEqual("-import(bar, [f/1, g/2]).", + f(?Q("-import(bar, [f/1, g/2])."))), + ?_assertEqual(("-module(foo)." + "-export([f/1])." + "f(X) -> {ok, X}."), + f(?Q(["-module(foo).", + "-export([f/1]).", + "f(X) -> {ok, X}."]))) + ]. + +quote_term_test_() -> + [?_assertEqual("foo", + f(?Q("foo"))), + ?_assertEqual("42", + f(?Q("42"))), + ?_assertEqual("{foo, 42}", + f(?Q("{foo, 42}"))), + ?_assertEqual(("1" ++ "2" ++ "3"), + f(?Q("1, 2, 3"))), + ?_assertEqual(("foo" "42" "{}" "true"), + f(?Q("foo, 42, {}, (true)"))) + ]. + +quote_expr_test_() -> + [?_assertEqual("2 + 2", + f(?Q("2 + 2"))), + ?_assertEqual("f(foo, 42)", + f(?Q("f(foo, 42)"))), + ?_assertEqual("case X of\n a -> 1;\n b -> 2\nend", + f(?Q("case X of a -> 1; b -> 2 end"))), + ?_assertEqual(("2 + 2" ++ "f(42)" ++ "catch 22"), + f(?Q("2 + 2, f(42), catch 22"))) + ]. + +quote_try_clause_test_() -> + [?_assertEqual("(error:R) when R =/= foo -> ok", + f(?Q("error:R when R =/= foo -> ok"))), + %% note that without any context, clauses are printed as fun-clauses + ?_assertEqual(("(error:badarg) -> badarg" + "(exit:normal) -> normal" + "(_) -> other"), + f(?Q(["error:badarg -> badarg;", + "exit:normal -> normal;" + "_ -> other"]))) + ]. + +quote_fun_clause_test_() -> + [?_assertEqual("(X, Y) when X < Y -> {ok, X}", + f(?Q("(X, Y) when X < Y -> {ok, X}"))), + ?_assertEqual(("(X, Y) when X < Y -> less" + "(X, Y) when X > Y -> greater" + "(_, _) -> equal"), + f(?Q(["(X, Y) when X < Y -> less;", + "(X, Y) when X > Y -> greater;" + "(_, _) -> equal"])))]. + +quote_case_clause_test_() -> + [?_assertEqual("({X, Y}) when X < Y -> X", + f(?Q("{X, Y} when X < Y -> X"))), + ?_assertEqual(("({X, Y}) when X < Y -> -1" + "({X, Y}) when X > Y -> 1" + "(_) -> 0"), + f(?Q(["{X, Y} when X < Y -> -1;", + "{X, Y} when X > Y -> 1;" + "_ -> 0"])))]. + +quote_comment_test_() -> + [?_assertEqual("%% comment preserved\n" + "{foo, 42}", + f(?Q(["%% comment preserved", + "{foo, 42}"]))), + ?_assertEqual("{foo, 42}" + "%% comment preserved\n", + f(?Q(["{foo, 42}", + "%% comment preserved"]))), + ?_assertEqual(" % just a comment (with indent)\n", + f(?Q(" % just a comment (with indent)"))) + ]. + +metavar_test_() -> + [?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("'@foo'"))))), + ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("_@foo"))))), + ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("\"'@foo\""))))), + ?_assertEqual("{'@foo'}", f(merl:tree(merl:template(?Q("{_@foo}"))))), + ?_assertEqual("'@foo'", f(merl:tree(merl:template(?Q("{_@_foo}"))))), + ?_assertEqual("909123", f(merl:tree(merl:template(?Q("{9090123}"))))), + ?_assertEqual("{'@foo'}", + f(merl:tree(merl:template(?Q("{{{_@__foo}}}"))))), + ?_assertEqual("{909123}", + f(merl:tree(merl:template(?Q("{{{90900123}}}"))))), + ?_assertEqual("{'@@foo'}", + f(merl:tree(merl:template(?Q("{{{_@__@foo}}}"))))), + ?_assertEqual("{9099123}", + f(merl:tree(merl:template(?Q("{{{909009123}}}"))))) + ]. + +subst_test_() -> + [?_assertEqual("42", + f(merl:subst(?Q("_@foo"), [{foo, merl:term(42)}]))), + ?_assertEqual("'@foo'", + f(merl:subst(?Q("_@foo"), []))), + ?_assertEqual("{42}", + f(merl:subst(?Q("{_@foo}"), + [{foo, merl:term(42)}]))), + ?_assertEqual("{'@foo'}", + f(merl:subst(?Q("{_@foo}"), []))), + ?_assertEqual("fun bar/0", + f(merl:subst(merl:template(?Q("fun '@foo'/0")), + [{foo, merl:term(bar)}]))), + ?_assertEqual("fun foo/3", + f(merl:subst(merl:template(?Q("fun foo/9091")), + [{1, merl:term(3)}]))), + ?_assertEqual("[42]", + f(merl:subst(merl:template(?Q("[_@foo]")), + [{foo, merl:term(42)}]))), + ?_assertEqual("[foo, bar]", + f(merl:subst(merl:template(?Q("[_@foo]")), + [{foo, [merl:term(foo),merl:term(bar)]}]))), + ?_assertEqual("{fee, fie, foe, fum}", + f(merl:subst(merl:template(?Q("{fee, _@foo, fum}")), + [{foo, [merl:term(fie),merl:term(foe)]}]))), + ?_assertEqual("[foo, bar]", + f(merl:subst(merl:template(?Q("[_@@foo]")), + [{foo, [merl:term(foo),merl:term(bar)]}]))), + ?_assertEqual("{fee, fie, foe, fum}", + f(merl:subst(merl:template(?Q("{fee, _@@foo, fum}")), + [{foo, [merl:term(fie),merl:term(foe)]}]))), + ?_assertEqual("['@@foo']", + f(merl:subst(merl:template(?Q("[_@@foo]")), []))), + ?_assertEqual("foo", + f(merl:subst(merl:template(?Q("[_@_foo]")), + [{foo, merl:term(foo)}]))), + ?_assertEqual("{'@foo'}", + f(merl:subst(merl:template(?Q("{[_@_foo]}")), []))), + ?_assertEqual("{'@@foo'}", + f(merl:subst(merl:template(?Q("{[_@_@foo]}")), []))), + ?_assertEqual("-export([foo/1, bar/2]).", + f(merl:subst(merl:template(?Q("-export(['@_@foo'/0]).")), + [{foo, [erl_syntax:arity_qualifier( + merl:term(foo), + merl:term(1)), + erl_syntax:arity_qualifier( + merl:term(bar), + merl:term(2)) + ]} + ]))) + ]. + +match_test_() -> + [?_assertEqual({ok, []}, merl:match(?Q("foo"), ?Q("foo"))), + ?_assertEqual(error, merl:match(?Q("foo"), ?Q("bar"))), + ?_assertEqual({ok,[]}, merl:match(?Q("{foo,42}"), ?Q("{foo,42}"))), + ?_assertEqual(error, merl:match(?Q("{foo,42}"), ?Q("{foo,bar}"))), + ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[42]]"), ?Q("[foo,[42]]"))), + ?_assertEqual(error, merl:match(?Q("[foo,[42]]"), ?Q("[foo,{42}]"))), + ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[_@_]]"), + ?Q("[foo,[42]]"))), + ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[9090]]"), + ?Q("[foo,[42]]"))), + ?_assertEqual({ok,[]}, merl:match(?Q("{_@_,[_@_,2]}"), + ?Q("{foo,[1,2]}"))), + ?_assertEqual(error, merl:match(?Q("{_@_,[_@_,2]}"), + ?Q("{foo,[1,3]}"))), + ?_assertEqual({ok,[]}, merl:match(?Q("[foo,[9090,9090]]"), + ?Q("[foo,[1,2]]"))), + ?_assertEqual(error, merl:match(?Q("[foo,[9090,9090]]"), + ?Q("[foo,[1,2,3]]"))), + ?_assertEqual([{foo,"42"}], + fe(ok(merl:match(?Q("_@foo"), ?Q("42"))))), + ?_assertEqual([{foo,"42"}], + fe(ok(merl:match(?Q("{_@foo}"), ?Q("{42}"))))), + ?_assertEqual([{1,"0"},{foo,"bar"}], + fe(ok(merl:match(?Q("fun '@foo'/9091"), + ?Q("fun bar/0"))))), + ?_assertEqual([{line,"17"},{text,"\"hello\""}], + fe(ok(merl:match(?Q("{_@line, _@text}"), + ?Q("{17, \"hello\"}"))))), + ?_assertEqual([{line,"17"},{text,"\"hello\""}], + fe(ok(merl:match(?Q("foo(_@line, _@text)"), + ?Q("foo(17, \"hello\")"))))), + ?_assertEqual([{foo,""}], + fe(ok(merl:match(?Q("f(_@@foo)"), + ?Q("f()"))))), + ?_assertEqual([{foo,"fee"}], + fe(ok(merl:match(?Q("f(_@@foo)"), + ?Q("f(fee)"))))), + ?_assertEqual([{foo,"feefiefum"}], + fe(ok(merl:match(?Q("f(_@@foo)"), + ?Q("f(fee, fie, fum)"))))), + ?_assertEqual([{foo,""}], + fe(ok(merl:match(?Q("[_@@foo]"), + ?Q("[]"))))), + ?_assertEqual([{foo,"fee"}], + fe(ok(merl:match(?Q("[_@@foo]"), + ?Q("[fee]"))))), + ?_assertEqual([{foo,"feefiefoefum"}], + fe(ok(merl:match(?Q("[_@@foo]"), + ?Q("[fee, fie, foe, fum]"))))), + ?_assertEqual([{foo,""}], + fe(ok(merl:match(?Q("{_@@foo}"), + ?Q("{}"))))), + ?_assertEqual([{foo,"fee"}], + fe(ok(merl:match(?Q("{_@@foo}"), + ?Q("{fee}"))))), + ?_assertEqual([{foo,"feefiefoefum"}], + fe(ok(merl:match(?Q("{_@@foo}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([{foo,"fie"}], + fe(ok(merl:match(?Q("{fee, _@@foo}"), + ?Q("{fee, fie}"))))), + ?_assertEqual([{foo,"fiefoefum"}], + fe(ok(merl:match(?Q("{fee, _@@foo}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([{foo,"fie"}], + fe(ok(merl:match(?Q("{_@@foo, foe, fum}"), + ?Q("{fie, foe, fum}"))))), + ?_assertEqual([{foo,"feefie"}], + fe(ok(merl:match(?Q("{_@@foo, foe, fum}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([{foo,"fie"}], + fe(ok(merl:match(?Q("{fee, _@@foo, fum}"), + ?Q("{fee, fie, fum}"))))), + ?_assertEqual([{foo,"fiefoe"}], + fe(ok(merl:match(?Q("{fee, _@@foo, fum}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([{foo,"fiefoe"},{post,"fum"},{pre,"fee"}], + fe(ok(merl:match(?Q("{_@pre, _@@foo, _@post}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertThrow({error, "multiple glob variables"++_}, + fe(ok(merl:match(?Q("{_@@foo, _@@bar}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([], + fe(ok(merl:match(?Q("{fee, _@@_}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([], + fe(ok(merl:match(?Q("{_@@_, foe, fum}"), + ?Q("{fee, fie, foe, fum}"))))), + ?_assertEqual([{post,"fum"},{pre,"fee"}], + fe(ok(merl:match(?Q("{_@pre, _@@_, _@post}"), + ?Q("{fee, fie, foe, fum}"))))) + ]. + +switch_test_() -> + [?_assertEqual(42, merl:switch(?Q("foo"), [fun () -> 42 end])), + ?_assertEqual(17, merl:switch(?Q("foo"), [fun () -> 17 end, + fun () -> 42 end])), + ?_assertEqual(17, merl:switch(?Q("foo"), [{?Q("foo"), + fun ([]) -> 17 end}, + fun () -> 42 end])), + ?_assertEqual(17, + merl:switch(?Q("foo"), [{?Q("bar"), fun ([]) -> 0 end}, + {?Q("foo"), fun ([]) -> 17 end}, + fun () -> 42 end])), + ?_assertEqual([{foo,"17"}], + merl:switch(?Q("{foo,17}"), + [{?Q("{bar, _@foo}"), fun (_) -> 0 end}, + {?Q("{foo, _@foo}"), fun fe/1}, + fun () -> 42 end])), + ?_assertEqual(17, + merl:switch(?Q("{foo, 17}"), + [{?Q("{foo, _@foo}"), + fun ([{foo, X}]) -> f(X) =:= "17" end, + fun (_) -> 17 end}, + fun () -> 42 end])), + ?_assertEqual([{foo,"17"}], + merl:switch(?Q("{foo, 17}"), + [{?Q("{foo, _@foo}"), + fun ([{foo, X}]) -> f(X) =:= "42" end, + fun (_) -> 0 end}, + {?Q("{foo, _@foo}"), fun fe/1}, + fun () -> 42 end])), + ?_assertEqual(17, + merl:switch(?Q("{foo, 17}"), + [{?Q("{foo, _@foo}"), + [{fun ([{foo, X}]) -> f(X) =:= "17" end, + fun (_) -> 17 end}, + fun (_) -> 0 end]}, + fun () -> 42 end])), + ?_assertEqual([{foo,"17"}], + merl:switch(?Q("{foo, 17}"), + [{?Q("{foo, _@foo}"), + [{fun ([{foo, X}]) -> f(X) =:= "42" end, + fun (_) -> 0 end}, + fun fe/1]}, + fun () -> 42 end])) + ]. + +-ifndef(MERL_NO_TRANSFORM). + +inline_meta_test_() -> + [?_assertEqual("{foo}", + f(begin + Foo = ?Q("foo"), + ?Q("{_@Foo}") + end)), + ?_assertEqual("{foo, '@bar'}", + f(begin + Foo = ?Q("foo"), + ?Q("{_@Foo,_@bar}") + end)), + ?_assertEqual("{foo, '@bar'}", + f(begin + Q1 = ?Q("foo"), + ?Q("{90919,_@bar}") + end)) + ]. + +inline_meta_autoabstract_test_() -> + [?_assertEqual("{foo}", + f(begin + Foo = foo, + ?Q("{_@Foo@}") + end)), + ?_assertEqual("{foo, '@bar@'}", + f(begin + Foo = foo, + ?Q("{_@Foo@,_@bar@}") + end)), + ?_assertEqual("{foo, '@bar@'}", + f(begin + Q1 = foo, + ?Q("{909199,_@bar@}") + end)) + ]. + +meta_match_test_() -> + [?_assertEqual("{[bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + ?Q("{foo, _@Bar, '@Baz'}") = Tree, + ?Q("{_@Bar, _@Baz}") + end)), + ?_assertEqual("{[bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + ?Q("{foo, 90919, 90929}") = Tree, + ?Q("{_@Q1, _@Q2}") + end)), + ?_assertError({badmatch,error}, + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + ?Q("{fie, _@Bar, '@Baz'}") = Tree, + ?Q("{_@Bar, _@Baz}") + end)) + ]. + +meta_case_test_() -> + [?_assertEqual("{[bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{foo, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}") + end + end)), + ?_assertEqual("{foo, [bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{fie, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}"); + _ -> Tree + end + end)), + ?_assertError(merl_switch_clause, + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{fie, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}") + end + end)), + ?_assertEqual("{foo, 4}", + f(begin + Tree = ?Q("{foo, 3}"), + case Tree of + ?Q("{foo, _@N}") -> + N1 = erl_syntax:concrete(N) + 1, + ?Q("{foo, _@N1@}"); + _ -> Tree + end + end)), + ?_assertEqual("-export([f/4]).", + f(begin + Tree = ?Q("-export([f/3])."), + case Tree of + ?Q("-export([f/90919]).") -> + Q2 = erl_syntax:concrete(Q1) + 1, + ?Q("-export([f/909299])."); + _ -> Tree + end + end)), + ?_assertEqual("{1, [bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{foo, _@Bar, '@Baz'}") -> + ?Q("{1, _@Bar, _@Baz}"); + ?Q("{fie, _@Bar, '@Baz'}") -> + ?Q("{2, _@Bar, _@Baz}"); + _ -> Tree + end + end)), + ?_assertEqual("{2, [bar], baz()}", + f(begin + Tree = ?Q("{fie, [bar], baz()}"), + case Tree of + ?Q("{foo, _@Bar, '@Baz'}") -> + ?Q("{1, _@Bar, _@Baz}"); + ?Q("{fie, _@Bar, '@Baz'}") -> + ?Q("{2, _@Bar, _@Baz}"); + _ -> Tree + end + end)), + ?_assertEqual("{2, baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, foo) -> + ?Q("{1, _@Baz}"); + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, bar) -> + ?Q("{2, _@Baz}"); + ?Q("{foo, [_@Bar], '@Baz'}") -> + ?Q("{3, _@Baz}"); + _ -> Tree + end + end)), + ?_assertEqual("{2, 42}", + f(begin + Tree = ?Q("{foo, [bar], 42}"), + case Tree of + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, bar), + erl_syntax:is_integer(Baz, 17) -> + ?Q("{1, _@Bar}"); + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, bar), + erl_syntax:is_integer(Baz, 42) -> + ?Q("{2, _@Baz}"); + ?Q("{foo, [_@Bar], '@Baz'}") -> + ?Q("{3, _@Baz}"); + _ -> Tree + end + end)), + ?_assertEqual("{2, 42}", + f(begin + Tree = ?Q("{foo, [baz], 42}"), + case Tree of + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, bar), + erl_syntax:is_integer(Baz, 17) + ; erl_syntax:is_atom(Bar, baz), + erl_syntax:is_integer(Baz, 17) -> + ?Q("{1, _@Bar}"); + ?Q("{foo, [_@Bar], '@Baz'}") + when erl_syntax:is_atom(Bar, bar), + erl_syntax:is_integer(Baz, 42) + ; erl_syntax:is_atom(Bar, baz), + erl_syntax:is_integer(Baz, 42) -> + ?Q("{2, _@Baz}"); + ?Q("{foo, [_@Bar], '@Baz'}") -> + ?Q("{3, _@Baz}"); + _ -> Tree + end + end)), + ?_assertEqual("{2, foo, Bar, Baz, Bar(), Baz()}", + f(begin + Tree = ?Q("foo(Bar, Baz) -> Bar(), Baz()."), + case Tree of + ?Q("'@Func'(_@Args) -> _@Body.") -> + ?Q("{1, _@Func, _@Args, _@Body}"); + ?Q("'@Func'(_@@Args) -> _@@Body.") -> + ?Q("{2, _@Func, _@Args, _@Body}"); + ?Q("'@Func'(_@Args, Baz) -> _@Body1, _@Body2.") -> + ?Q("{3, _@Func, _@Args, _@Body1, _@Body2}") + end + end)) + ]. + +-endif. diff --git a/lib/syntax_tools/src/merl_transform.erl b/lib/syntax_tools/src/merl_transform.erl new file mode 100644 index 0000000000..b298bc407f --- /dev/null +++ b/lib/syntax_tools/src/merl_transform.erl @@ -0,0 +1,285 @@ +%% --------------------------------------------------------------------- +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. +%% +%% @author Richard Carlsson <[email protected]> +%% @copyright 2012-2015 Richard Carlsson +%% @doc Parse transform for merl. Enables the use of automatic metavariables +%% and using quasi-quotes in matches and case switches. Also optimizes calls +%% to functions in `merl' by partially evaluating them, turning strings to +%% templates, etc., at compile-time. +%% +%% Using `-include_lib("syntax_tools/include/merl.hrl").' enables this +%% transform, unless the macro `MERL_NO_TRANSFORM' is defined first. + +-module(merl_transform). + +-export([parse_transform/2]). + +%% NOTE: We cannot use inline metavariables or any other parse transform +%% features in this module, because it must be possible to compile it with +%% the parse transform disabled! +-include("merl.hrl"). + +%% TODO: unroll calls to switch? it will probably get messy + +%% TODO: use Igor to make resulting code independent of merl at runtime? + +parse_transform(Forms, _Options) -> + erl_syntax:revert_forms(expand(erl_syntax:form_list(Forms))). + +expand(Tree0) -> + Tree = pre(Tree0), + post(case erl_syntax:subtrees(Tree) of + [] -> + Tree; + Gs -> + erl_syntax:update_tree(Tree, + [[expand(T) || T <- G] || G <- Gs]) + end). + +pre(T) -> + merl:switch( + T, + [{?Q("merl:quote(_@line, _@text) = _@expr"), + fun ([{expr,_}, {line,Line}, {text,Text}]) -> + erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line) + end, + fun ([{expr,Expr}, {line,Line}, {text,Text}]) -> + pre_expand_match(Expr, erl_syntax:concrete(Line), + erl_syntax:concrete(Text)) + end}, + {?Q(["case _@expr of", + " merl:quote(_@_, _@text) when _@__@_ -> _@@_; _@_@_ -> 0", + "end"]), + fun case_guard/1, + fun (As) -> case_body(As, T) end}, + fun () -> T end + ]). + +case_guard([{expr,_}, {text,Text}]) -> + erl_syntax:is_literal(Text). + +case_body([{expr,Expr}, {text,_Text}], T) -> + pre_expand_case(Expr, erl_syntax:case_expr_clauses(T), get_location(T)). + +post(T) -> + merl:switch( + T, + [{?Q("merl:_@function(_@@args)"), + [{fun ([{args, As}, {function, F}]) -> + lists:all(fun erl_syntax:is_literal/1, [F|As]) + end, + fun ([{args, As}, {function, F}]) -> + Line = get_location(F), + [F1|As1] = lists:map(fun erl_syntax:concrete/1, [F|As]), + eval_call(Line, F1, As1, T) + end}, + fun ([{args, As}, {function, F}]) -> + merl:switch( + F, + [{?Q("qquote"), fun ([]) -> expand_qquote(As, T, 1) end}, + {?Q("subst"), fun ([]) -> expand_template(F, As, T) end}, + {?Q("match"), fun ([]) -> expand_template(F, As, T) end}, + fun () -> T end + ]) + end]}, + fun () -> T end]). + +expand_qquote([Line, Text, Env], T, _) -> + case erl_syntax:is_literal(Line) of + true -> + expand_qquote([Text, Env], T, erl_syntax:concrete(Line)); + false -> + T + end; +expand_qquote([Text, Env], T, Line) -> + case erl_syntax:is_literal(Text) of + true -> + As = [Line, erl_syntax:concrete(Text)], + case eval_call(Line, quote, As, failed) of + failed -> + T; + T1 -> + %% expand further if possible + expand(merl:qquote(Line, "merl:subst(_@tree, _@env)", + [{tree, T1}, + {env, Env}])) + end; + false -> + T + end; +expand_qquote(_As, T, _StartPos) -> + T. + +expand_template(F, [Pattern | Args], T) -> + case erl_syntax:is_literal(Pattern) of + true -> + Line = get_location(Pattern), + As = [erl_syntax:concrete(Pattern)], + merl:qquote(Line, "merl:_@function(_@pattern, _@args)", + [{function, F}, + {pattern, eval_call(Line, template, As, T)}, + {args, Args}]); + false -> + T + end; +expand_template(_F, _As, T) -> + T. + +eval_call(Line, F, As, T) -> + try apply(merl, F, As) of + T1 when F =:= quote -> + %% lift metavariables in a template to Erlang variables + Template = merl:template(T1), + Vars = merl:template_vars(Template), + case lists:any(fun is_inline_metavar/1, Vars) of + true when is_list(T1) -> + merl:qquote(Line, "merl:tree([_@template])", + [{template, merl:meta_template(Template)}]); + true -> + merl:qquote(Line, "merl:tree(_@template)", + [{template, merl:meta_template(Template)}]); + false -> + merl:term(T1) + end; + T1 -> + merl:term(T1) + catch + throw:_Reason -> T + end. + +pre_expand_match(Expr, Line, Text) -> + {Template, Out, _Vars} = rewrite_pattern(Line, Text), + merl:qquote(Line, "{ok, _@out} = merl:match(_@template, _@expr)", + [{expr, Expr}, + {out, Out}, + {template, erl_syntax:abstract(Template)}]). + +rewrite_pattern(Line, Text) -> + %% we must rewrite the metavariables in the pattern to use lowercase, + %% and then use real matching to bind the Erlang-level variables + T0 = merl:template(merl:quote(Line, Text)), + Vars = [V || V <- merl:template_vars(T0), is_inline_metavar(V)], + {merl:alpha(T0, [{V, var_to_tag(V)} || V <- Vars]), + erl_syntax:list([erl_syntax:tuple([erl_syntax:abstract(var_to_tag(V)), + erl_syntax:variable(var_name(V))]) + || V <- Vars]), + Vars}. + +var_name(V) when is_integer(V) -> + V1 = if V > 99, (V rem 100) =:= 99 -> + V div 100; + V > 9, (V rem 10) =:= 9 -> + V div 10; + true -> V + end, + list_to_atom("Q" ++ integer_to_list(V1)); +var_name(V) -> V. + +var_to_tag(V) when is_integer(V) -> V; +var_to_tag(V) -> + list_to_atom(string:to_lower(atom_to_list(V))). + +pre_expand_case(Expr, Clauses, Line) -> + merl:qquote(Line, "merl:switch(_@expr, _@clauses)", + [{clauses, erl_syntax:list([pre_expand_case_clause(C) + || C <- Clauses])}, + {expr, Expr}]). + +pre_expand_case_clause(T) -> + %% note that the only allowed non ``?Q(...) -> ...'' clause is ``_ -> ...'' + merl:switch( + T, + [{?Q("(merl:quote(_@line, _@text)) when _@__@guard -> _@@body"), + fun ([{body,_}, {guard,_}, {line,Line}, {text,Text}]) -> + erl_syntax:is_literal(Text) andalso erl_syntax:is_literal(Line) + end, + fun ([{body,Body}, {guard,Guard}, {line,Line}, {text,Text}]) -> + pre_expand_case_clause(Body, Guard, erl_syntax:concrete(Line), + erl_syntax:concrete(Text)) + end}, + {?Q("_ -> _@@body"), + fun (Env) -> merl:qquote("fun () -> _@body end", Env) end} + ]). + +pre_expand_case_clause(Body, Guard, Line, Text) -> + %% this is similar to a meta-match ``?Q("...") = Term'' + %% (note that the guards may in fact be arbitrary expressions) + {Template, Out, Vars} = rewrite_pattern(Line, Text), + GuardExprs = rewrite_guard(Guard), + Param = [{body, Body}, + {guard,GuardExprs}, + {out, Out}, + {template, erl_syntax:abstract(Template)}, + {unused, dummy_uses(Vars)}], + case GuardExprs of + [] -> + merl:qquote(Line, ["{_@template, ", + " fun (_@out) -> _@unused, _@body end}"], + Param); + _ -> + merl:qquote(Line, ["{_@template, ", + " fun (_@out) -> _@unused, _@guard end, ", + " fun (_@out) -> _@unused, _@body end}"], + Param) + end. + +%% We have to insert dummy variable uses at the beginning of the "guard" and +%% "body" function bodies to avoid warnings for unused variables in the +%% generated code. (Expansions at the Erlang level can't be marked up as +%% compiler generated to allow later compiler stages to ignore them.) +dummy_uses(Vars) -> + [?Q("_ = _@var", [{var, erl_syntax:variable(var_name(V))}]) + || V <- Vars]. + +rewrite_guard([]) -> []; +rewrite_guard([D]) -> [make_orelse(erl_syntax:disjunction_body(D))]. + +make_orelse([]) -> []; +make_orelse([C]) -> make_andalso(erl_syntax:conjunction_body(C)); +make_orelse([C | Cs]) -> + ?Q("_@expr orelse _@rest", + [{expr, make_andalso(erl_syntax:conjunction_body(C))}, + {rest, make_orelse(Cs)}]). + +make_andalso([E]) -> E; +make_andalso([E | Es]) -> + ?Q("_@expr andalso _@rest", [{expr, E}, {rest, make_andalso(Es)}]). + +is_inline_metavar(Var) when is_atom(Var) -> + is_erlang_var(atom_to_list(Var)); +is_inline_metavar(Var) when is_integer(Var) -> + Var > 9 andalso (Var rem 10) =:= 9; +is_inline_metavar(_) -> false. + +is_erlang_var([C|_]) when C >= $A, C =< $Z ; C >= $À, C =< $Þ, C /= $× -> + true; +is_erlang_var(_) -> + false. + +get_location(T) -> + Pos = erl_syntax:get_pos(T), + case erl_anno:is_anno(Pos) of + true -> + erl_anno:location(Pos); + false -> + Pos + end. diff --git a/lib/syntax_tools/src/prettypr.erl b/lib/syntax_tools/src/prettypr.erl index 1b5ba6b05a..61a8993b84 100644 --- a/lib/syntax_tools/src/prettypr.erl +++ b/lib/syntax_tools/src/prettypr.erl @@ -1,18 +1,23 @@ %% ===================================================================== -%% 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 of the -%% License, or (at your option) any later version. +%% Licensed under the Apache License, Version 2.0 (the "License"); you may +%% not use this file except in compliance with the License. You may obtain +%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0> %% -%% 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. +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% -%% 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 -%% USA +%% Alternatively, you may use this file under the terms of the GNU Lesser +%% General Public License (the "LGPL") as published by the Free Software +%% Foundation; either version 2.1, or (at your option) any later version. +%% If you wish to allow use of your version of this file only under the +%% terms of the LGPL, you should delete the provisions above and replace +%% them with the notice and other provisions required by the LGPL; see +%% <http://www.gnu.org/licenses/>. If you do not delete the provisions +%% above, a recipient may use your version of this file under the terms of +%% either the Apache License or the LGPL. %% %% @copyright 2000-2006 Richard Carlsson %% @author Richard Carlsson <[email protected]> diff --git a/lib/syntax_tools/src/syntax_tools.app.src b/lib/syntax_tools/src/syntax_tools.app.src index 83dcb5fe23..5c6008a5f0 100644 --- a/lib/syntax_tools/src/syntax_tools.app.src +++ b/lib/syntax_tools/src/syntax_tools.app.src @@ -11,8 +11,11 @@ erl_syntax_lib, erl_tidy, igor, + merl, + merl_transform, prettypr]}, {registered,[]}, {applications, [stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. + {runtime_dependencies, + ["compiler-7.0","erts-8.0","kernel-5.0","stdlib-3.0"]}]}. diff --git a/lib/syntax_tools/src/syntax_tools.appup.src b/lib/syntax_tools/src/syntax_tools.appup.src index 89c25d14d7..0dad228ca3 100644 --- a/lib/syntax_tools/src/syntax_tools.appup.src +++ b/lib/syntax_tools/src/syntax_tools.appup.src @@ -1,18 +1,19 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% {"%VSN%", diff --git a/lib/syntax_tools/syntax_tools.pub b/lib/syntax_tools/syntax_tools.pub deleted file mode 100644 index 6d69b31818..0000000000 --- a/lib/syntax_tools/syntax_tools.pub +++ /dev/null @@ -1,13 +0,0 @@ -{name, "syntax_tools"}. -{vsn, {1,3}}. -{summary, "A set of modules for working with Erlang source code."}. -{author, "Richard Carlsson", "[email protected]", "031124"}. -{keywords, ["source code", "syntax", "syntax trees", "erl_parse", - "pretty printing", "comments", "tidying"]}. -{needs, []}. -{abstract, "This package defines an abstract datatype that is\n" - "compatible with the `erl_parse' data structures, and\n" - "provides modules for analysis and manipulation,\n" - "flexible pretty printing, and preservation of source-code\n" - "comments. Also includes `erl_tidy': automatic code tidying\n" - "and checking."}. diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile index f67e3f8984..4ace860223 100644 --- a/lib/syntax_tools/test/Makefile +++ b/lib/syntax_tools/test/Makefile @@ -6,7 +6,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # ---------------------------------------------------- MODULES= \ - syntax_tools_SUITE + syntax_tools_SUITE \ + merl_SUITE ERL_FILES= $(MODULES:%=%.erl) @@ -25,7 +26,7 @@ RELSYSDIR = $(RELEASE_PATH)/syntax_tools_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += EBIN = . diff --git a/lib/syntax_tools/test/merl_SUITE.erl b/lib/syntax_tools/test/merl_SUITE.erl new file mode 100644 index 0000000000..52bbd9b3b8 --- /dev/null +++ b/lib/syntax_tools/test/merl_SUITE.erl @@ -0,0 +1,109 @@ +%% ``Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. +%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +%% AB. All Rights Reserved.'' +%% +-module(merl_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% include the Merl header file +-include_lib("syntax_tools/include/merl.hrl"). + +%% for assert macros +-include_lib("eunit/include/eunit.hrl"). + +%% Test server specific exports +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2]). + +%% Test cases +-export([merl_smoke_test/1, + transform_parse_error_test/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [merl_smoke_test, + transform_parse_error_test]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +-define(tokens2str(X), ??X). + +merl_smoke_test(Config) when is_list(Config) -> + ?assertThrow({error, "1: syntax error before: '{'" ++ _}, + f(merl:quote("{"))), + ?assertEqual(tuple, erl_syntax:type(merl:term({}))), + ?assertEqual("{foo, 42}", f(merl:term({foo, 42}))), + ?assertEqual("f(X) -> {ok, X}.", f(?Q("f(X) -> {ok, X}."))), + ?assertEqual("{foo, 42}", f(?Q("{foo, 42}"))), + ?assertEqual("2 + 2", f(?Q("2 + 2"))), + ?assertEqual("%% comment preserved\n{foo, 42}", + f(?Q(["%% comment preserved", "{foo, 42}"]))), + ?assertEqual("'@foo'", f(merl:tree(merl:template(?Q("'@foo'"))))), + ?assertEqual("42", f(merl:subst(?Q("_@foo"), [{foo, merl:term(42)}]))), + ?assertEqual({ok, []}, merl:match(?Q("foo"), ?Q("foo"))), + ?assertEqual(42, merl:switch(?Q("foo"), [fun () -> 42 end])), + ?assertEqual("{foo}", f(begin Foo = ?Q("foo"), ?Q("{_@Foo}") end)), + ?assertEqual("{foo}", f(begin Foo = foo, ?Q("{_@Foo@}") end)), + ?assertEqual("{[bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + ?Q("{foo, _@Bar, '@Baz'}") = Tree, + ?Q("{_@Bar, _@Baz}") + end)), + ?assertEqual("{[bar], baz()}", + f(begin + Tree = ?Q("{foo, [bar], baz()}"), + case Tree of + ?Q("{foo, _@Bar, '@Baz'}") -> ?Q("{_@Bar, _@Baz}") + end + end)), + ok. + +transform_parse_error_test(_Config) -> + ?assertEqual("merl:quote(\"{\")", + f(merl_transform:parse_transform( + [?Q("merl:quote(\"{\")")], []))), + ?assertEqual("merl:quote(2, \"{\")", + f(merl_transform:parse_transform( + [?Q("merl:quote(2, \"{\")")], []))), + ?assertEqual("merl:qquote(\"{\", [{var, V}])", + f(merl_transform:parse_transform( + [?Q("merl:qquote(\"{\", [{var, V}])")], []))), + ?assertEqual("merl:qquote(2, \"{\", [{var, V}])", + f(merl_transform:parse_transform( + [?Q("merl:qquote(2, \"{\", [{var, V}])")], []))), + ok. + +%% utilities + +f(Ts) when is_list(Ts) -> + lists:flatmap(fun erl_prettypr:format/1, Ts); +f(T) -> + erl_prettypr:format(T). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 3c6b33f459..868f43b8ee 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -1,23 +1,22 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% +%% ``Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings %% AB. All Rights Reserved.'' -%% -%% $Id$ -%% + -module(syntax_tools_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -26,14 +25,14 @@ %% Test cases -export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1, t_abstract_type/1,t_erl_parse_type/1,t_epp_dodger/1, - t_comment_scan/1,t_igor/1]). + t_comment_scan/1,t_igor/1,t_erl_tidy/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [app_test,appup_test,smoke_test,revert,revert_map, t_abstract_type,t_erl_parse_type,t_epp_dodger, - t_comment_scan,t_igor]. + t_comment_scan,t_igor,t_erl_tidy]. groups() -> []. @@ -60,7 +59,7 @@ appup_test(Config) when is_list(Config) -> smoke_test(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:minutes(12)), Wc = filename:join([code:lib_dir(),"*","src","*.erl"]), - Fs = filelib:wildcard(Wc), + Fs = filelib:wildcard(Wc) ++ test_files(Config), io:format("~p files\n", [length(Fs)]), case p_run(fun smoke_test_file/1, Fs) of 0 -> ok; @@ -92,7 +91,7 @@ print_error_markers(F, File) -> revert(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:minutes(12)), Wc = filename:join([code:lib_dir("stdlib"),"src","*.erl"]), - Fs = filelib:wildcard(Wc), + Fs = filelib:wildcard(Wc) ++ test_files(Config), Path = [filename:join(code:lib_dir(stdlib), "include"), filename:join(code:lib_dir(kernel), "include")], io:format("~p files\n", [length(Fs)]), @@ -202,18 +201,25 @@ t_erl_parse_type(Config) when is_list(Config) -> t_epp_dodger(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), - Filenames = ["syntax_tools_SUITE_test_module.erl", - "syntax_tools_test.erl"], + Filenames = test_files(), ok = test_epp_dodger(Filenames,DataDir,PrivDir), ok. t_comment_scan(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), - Filenames = ["syntax_tools_SUITE_test_module.erl", - "syntax_tools_test.erl"], + Filenames = test_files(), ok = test_comment_scan(Filenames,DataDir), ok. +test_files(Config) -> + DataDir = ?config(data_dir, Config), + [ filename:join(DataDir,Filename) || Filename <- test_files() ]. + +test_files() -> + ["syntax_tools_SUITE_test_module.erl", + "syntax_tools_test.erl", + "type_specs.erl"]. + t_igor(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -221,6 +227,18 @@ t_igor(Config) when is_list(Config) -> FileM2 = filename:join(DataDir,"m2.erl"), ["m.erl",_]=R = igor:merge(m,[FileM1,FileM2],[{outdir,PrivDir}]), io:format("igor:merge/3 = ~p~n", [R]), + + FileTypeSpecs = filename:join(DataDir,"igor_type_specs.erl"), + Empty = filename:join(DataDir,"empty.erl"), + ["n.erl",_]=R2 = igor:merge(n,[FileTypeSpecs,Empty],[{outdir,PrivDir}]), + io:format("igor:merge/3 = ~p~n", [R2]), + + ok. + +t_erl_tidy(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + File = filename:join(DataDir,"erl_tidy_tilde.erl"), + ok = erl_tidy:file(File, [{stdout, true}]), ok. test_comment_scan([],_) -> ok; diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl new file mode 100644 index 0000000000..877ff66013 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl @@ -0,0 +1 @@ +-module(empty). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/erl_tidy_tilde.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/erl_tidy_tilde.erl new file mode 100644 index 0000000000..888264bad6 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/erl_tidy_tilde.erl @@ -0,0 +1,13 @@ +%% +%% File: erl_tidy_tilde.erl +%% Author: Mark Bucciarelli +%% Created: 2016-06-05 +%% + +-module(erl_tidy_tilde). + +-export([start/0]). + +start() -> + io:put_chars("tilde characters ('~')in source were " + "breaking erl_tidy\n"). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl new file mode 100644 index 0000000000..5a156c7fa3 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl @@ -0,0 +1,80 @@ +%% Same as ./type_specs.erl, but without macros. +-module(igor_type_specs). + +-include_lib("syntax_tools/include/merl.hrl"). + +-export([f/1, b/0, c/2]). + +-export_type([t/0, ot/2, ff2/0]). + +-type aa() :: _. + +-type t() :: integer(). + +-type ff(A) :: ot(A, A) | tuple() | 1..3 | map() | {}. +-type ff1() :: ff(bin()) | foo:bar(). +-type ff2() :: {list(), [_], list(integer()), + nonempty_list(), nonempty_list(atom()), [ff1(), ...], + nil(), []}. +-type bin() :: <<>> + | <<_:(+4)>> + | <<_:_*8>> + | <<_:12, _:_*16>> + | <<_:16, _:_*(0)>> % same as "<<_:16>>" + | <<_:16, _:_*(+0)>>. + +-callback cb() -> t(). + +-optional_callbacks([cb/0]). + +-opaque ot(A, B) :: {A, B}. + +-type f1() :: fun(). +-type f2() :: fun((...) -> t()). +-type f3() :: fun(() -> t()). +-type f4() :: fun((t(), t()) -> t()). + +-wild(attribute). + +-record(par, {a :: undefined | igor_type_specs}). + +-record(r0, {}). + +-record(r, + {f1 :: integer(), + f2 = a :: atom(), + f3 :: fun(), + f4 = 7}). + +-type r0() :: #r0{} | #r{f1 :: 3} | #r{f1 :: 3, f2 :: 'sju'}. + +-type m1() :: #{}. +-type m2() :: #{a => m1(), b => #{} | fy:m2()}. +-type b1() :: B1 :: binary() | (BitString :: bitstring()). + +-define(PAIR(A, B), {(A), (B)}). + +-spec igor_type_specs:f({r0(), r0()}) -> {t(), t()}. + +f({R, R}) -> + _ = "igor_type_specs" ++ "hej", + _ = <<"foo">>, + _ = R#r.f1, + _ = R#r{f1 = 17, f2 = b}, + {1, 1}. + +-spec igor_type_specs:b() -> integer() | fun(). + +b() -> + case foo:bar() of + #{a := 2} -> 19 + end. + +-spec c(Atom :: atom(), Integer :: integer()) -> {atom(), integer()}; + (X, Y) -> {atom(), float()} when X :: atom(), + is_subtype(Y, float()); + (integer(), atom()) -> {integer(), atom()}. + +c(A, B) -> + _ = integer, + {A, B}. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl new file mode 100644 index 0000000000..e4f8a1c3de --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl @@ -0,0 +1,87 @@ +-module(type_specs). + +-include_lib("syntax_tools/include/merl.hrl"). + +-export([f/1, b/0, c/2]). + +-export_type([t/0, ot/2, ff2/0]). + +-type aa() :: _. + +-type t() :: integer(). + +-type ff(A) :: ot(A, A) | tuple() | 1..3 | map() | {}. +-type ff1() :: ff(bin()) | foo:bar(). +-type ff2() :: {list(), [_], list(integer()), + nonempty_list(), nonempty_list(atom()), [ff1(), ...], + nil(), []}. +-type bin() :: <<>> + | <<_:(+4)>> + | <<_:_*8>> + | <<_:12, _:_*16>> + | <<_:16, _:_*(0)>> % same as "<<_:16>>" + | <<_:16, _:_*(+0)>>. + +-callback cb() -> t(). + +-optional_callbacks([cb/0]). + +-opaque ot(A, B) :: {A, B}. + +-type f1() :: fun(). +-type f2() :: fun((...) -> t()). +-type f3() :: fun(() -> t()). +-type f4() :: fun((t(), t()) -> t()). + +-wild(attribute). + +-record(par, {a :: undefined | ?MODULE}). + +-record(r0, {}). + +-record(r, + {f1 :: integer(), + f2 = a :: atom(), + f3 :: fun(), + f4 = 7}). + +-type r0() :: #r0{} | #r{f1 :: 3} | #r{f1 :: 3, f2 :: 'sju'}. + +-type m1() :: #{} | map(). +-type m2() :: #{a := m1(), b => #{} | fy:m2()}. +%-type m3() :: #{...}. +%-type m4() :: #{_ => _, ...}. +%-type m5() :: #{any() => any(), ...}. +-type m3() :: #{any() => any()}. +-type m4() :: #{_ => _, any() => any()}. +-type m5() :: #{any() => any(), any() => any()}. +-type b1() :: B1 :: binary() | (BitString :: bitstring()). + +-define(PAIR(A, B), {(A), (B)}). + +-spec ?MODULE:f(?PAIR(r0(), r0())) -> ?PAIR(t(), t()). + +f({R, R}) -> + _ = ?MODULE_STRING ++ "hej", + _ = <<"foo">>, + _ = R#r.f1, + _ = R#r{f1 = 17, f2 = b}, + {1, 1}. + +-spec ?MODULE:b() -> integer() | fun(). + +b() -> + case foo:bar() of + #{a := 2} -> 19 + end. + +-define(I, integer). + +-spec c(Atom :: atom(), Integer :: ?I()) -> {atom(), integer()}; + (X, Y) -> {atom(), float()} when X :: atom(), + is_subtype(Y, float()); + (integer(), atom()) -> {integer(), atom()}. + +c(A, B) -> + _ = ?I, + {A, B}. diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index 1c42ef0ddb..9b33f1e1f4 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 1.6.18 +SYNTAX_TOOLS_VSN = 2.1.2 |