diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index b3998cd73e9..bc9c3d95222 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -461,7 +461,6 @@ jobs: OPAMYES: 1 MACOSX_DEPLOYMENT_TARGET: 10.13 OCAML_VERSION: 5.1.1 - CTYPES: 0.21.1 steps: - uses: actions/checkout@main with: @@ -472,7 +471,7 @@ jobs: uses: actions/cache@v4 with: path: ~/.opam/ - key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }} + key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-1 - name: Install Neko from S3 run: | @@ -502,6 +501,8 @@ jobs: run: | set -ex brew update + brew uninstall --force pkg-config + brew install pkgconf --overwrite brew bundle --file=tests/Brewfile --no-upgrade cpanm IPC::System::Simple cpanm String::ShellQuote @@ -529,7 +530,6 @@ jobs: opam switch create ${{env.OCAML_VERSION}} eval $(opam env) opam env - opam pin add ctypes ${{env.CTYPES}} --yes opam pin add haxe . --no-action opam install haxe --deps-only --assume-depexts opam list diff --git a/.vscode/tasks.json b/.vscode/tasks.json index 5d63d3481c7..f481cb28ee6 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -5,6 +5,9 @@ "label": "make: haxe", "type": "shell", "command": "make ADD_REVISION=1 -s -j haxe", + "osx": { + "command": "eval $(opam env) && make ADD_REVISION=1 -s -j haxe", + }, "windows": { "command": "make ADD_REVISION=1 -f Makefile.win -s -j haxe" }, @@ -48,4 +51,4 @@ "problemMatcher": [] } ] -} \ No newline at end of file +} diff --git a/extra/LICENSE.txt b/extra/LICENSE.txt index b4142af748d..15b9c38afc5 100644 --- a/extra/LICENSE.txt +++ b/extra/LICENSE.txt @@ -1,9 +1,29 @@ Haxe Licenses ------------- -For details about Haxe Licenses, please read http://haxe.org/foundation/open-source.html +The Haxe toolkit is Free and Open-Source software that uses several licenses. -The Haxe Standard Library MIT License : +The Haxe compiler is licensed under the GNU GPL v2+ license (SPDX: GPL-2.0-or-later). + +The compiler is built around the Haxe source code base. + +If a file does not have a license header or does not fall under one of the exceptions listed below, +it should be assumed to be licensed under the GNU GPL v2+ license with the standard copyright notice: +Copyright (C) 2005-2024 Haxe Foundation. + +- The Haxe Standard Library is licensed under the MIT License, which is reproduced below. + It is located in the `std/` directory, and the MIT license applies to this part of Haxe. + +- Haxe contains third-party source code, some of which is located in the `libs/` directory. + Each third-party module includes its own license. + For integration with Haxe, these modules may contain Haxe-related files such as a "dune" file + or other files for integration with Haxe or OCaml. + These files are licensed under the Haxe Compiler license (GNU GPL v2+). + +For a summary of Haxe licenses, please read [http://haxe.org/foundation/open-source.html](http://haxe.org/foundation/open-source.html). + + +The Haxe Standard Library MIT License: -------------------------- Copyright (C)2005-2016 Haxe Foundation @@ -26,7 +46,7 @@ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -The Haxe compiler GPL License : +The Haxe compiler GPL License: ------------------------------- GNU GENERAL PUBLIC LICENSE diff --git a/extra/github-actions/build-mac.yml b/extra/github-actions/build-mac.yml index 65dcc41b4d8..738f422680a 100644 --- a/extra/github-actions/build-mac.yml +++ b/extra/github-actions/build-mac.yml @@ -7,6 +7,8 @@ run: | set -ex brew update + brew uninstall --force pkg-config + brew install pkgconf --overwrite brew bundle --file=tests/Brewfile --no-upgrade cpanm IPC::System::Simple cpanm String::ShellQuote @@ -34,7 +36,6 @@ opam switch create ${{env.OCAML_VERSION}} eval $(opam env) opam env - opam pin add ctypes ${{env.CTYPES}} --yes opam pin add haxe . --no-action opam install haxe --deps-only --assume-depexts opam list diff --git a/extra/github-actions/workflows/main.yml b/extra/github-actions/workflows/main.yml index 89e419a7698..5991147bf4b 100644 --- a/extra/github-actions/workflows/main.yml +++ b/extra/github-actions/workflows/main.yml @@ -315,7 +315,6 @@ jobs: OPAMYES: 1 MACOSX_DEPLOYMENT_TARGET: 10.13 OCAML_VERSION: 5.1.1 - CTYPES: 0.21.1 steps: - uses: actions/checkout@main with: @@ -326,7 +325,7 @@ jobs: uses: actions/cache@v4 with: path: ~/.opam/ - key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }} + key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-1 @import install-neko-unix.yml @import build-mac.yml diff --git a/extra/haxelib_src b/extra/haxelib_src index 3a6aebf35e5..5a836287828 160000 --- a/extra/haxelib_src +++ b/extra/haxelib_src @@ -1 +1 @@ -Subproject commit 3a6aebf35e5eac2a1318f556a413a06c7b7912f5 +Subproject commit 5a836287828fdaeb6aa91695a5eb399cee0f6640 diff --git a/haxe.opam b/haxe.opam index cdb3abc0bee..2ac471c4cf9 100644 --- a/haxe.opam +++ b/haxe.opam @@ -31,7 +31,7 @@ depends: [ "conf-libpcre2-8" "conf-zlib" "conf-neko" - "luv" {= "0.5.12"} + "luv" {>= "0.5.13"} "ipaddr" "terminal_size" ] diff --git a/libs/extlib-leftovers/LICENSE b/libs/extlib-leftovers/LICENSE new file mode 100644 index 00000000000..f6683e74e0f --- /dev/null +++ b/libs/extlib-leftovers/LICENSE @@ -0,0 +1,501 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + + 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. + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, see . + +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. + + , 1 April 1990 + Moe Ghoul, President of Vice + +That's all there is to it! diff --git a/libs/objsize/LICENSE b/libs/objsize/LICENSE new file mode 100644 index 00000000000..146efe37d76 --- /dev/null +++ b/libs/objsize/LICENSE @@ -0,0 +1,7 @@ +According to the README and to [README from backup of objsize new version](https://github.com/ygrek/objsize), +objsize is licensed either under BSD 3 Clause License or any version of GNU GENERAL PUBLIC LICENSE +published by Free Software Foundation. + +For use in Haxe, it was incorporated under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. diff --git a/src-json/meta.json b/src-json/meta.json index aa231387571..4e46889ada4 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -487,7 +487,7 @@ "name": "InheritDoc", "metadata": ":inheritDoc", "doc": "Append documentation from a parent field or class (if used without an argument) or from a specified class or field (if used like @:inheritDoc(pack.Some.field)).", - "targets": ["TClass", "TClass", "TEnum", "TAbstract", "TAnyField"] + "targets": ["TClass", "TEnum", "TAbstract", "TAnyField"] }, { "name": "InitPackage", diff --git a/src-json/warning.json b/src-json/warning.json index 03e5eab0fc2..fa322c7bc9e 100644 --- a/src-json/warning.json +++ b/src-json/warning.json @@ -118,6 +118,12 @@ "doc": "Constructor call could not be inlined because a field is uninitialized", "parent": "WTyper" }, + { + "name": "WUnsafeEnumEquality", + "doc": "Equality operations on enums with parameters might not work as expected", + "parent": "WTyper", + "enabled": false + }, { "name": "WHxb", "doc": "Hxb (either --hxb output or haxe compiler cache) related warnings" diff --git a/src-prebuild/prebuild.ml b/src-prebuild/prebuild.ml index 22e54e6cc65..e6decc46fbb 100644 --- a/src-prebuild/prebuild.ml +++ b/src-prebuild/prebuild.ml @@ -7,6 +7,7 @@ type parsed_warning = { w_doc : string; w_parent : string option; w_generic : bool; + w_enabled : bool; } type parsed_meta = { @@ -143,6 +144,7 @@ let parse_warning json = w_doc = get_field "doc" as_string fields; w_parent = get_optional_field2 "parent" as_string fields; w_generic = get_optional_field "generic" as_bool false fields; + w_enabled = get_optional_field "enabled" as_bool true fields; } let parse_file_array path map = @@ -255,6 +257,15 @@ let gen_warning_obj warnings = ) warnings in String.concat "\n" warning_str +let gen_disabled_warnings warnings = + let warning_str = ExtList.List.filter_map (fun w -> + if w.w_enabled then + None + else + Some w.w_name + ) warnings in + String.concat ";" warning_str + let autogen_header = "(* This file is auto-generated using prebuild from files in src-json *) (* Do not edit manually! *) " @@ -355,6 +366,10 @@ match Array.to_list (Sys.argv) with print_endline ""; print_endline "let warning_obj = function"; print_endline (gen_warning_obj warnings); + print_endline ";;"; + print_endline "let disabled_warnings = ["; + print_endline (gen_disabled_warnings warnings); + print_endline "];;"; print_endline ""; print_endline "let from_string = function"; print_endline (gen_warning_parse warnings); diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 00ee5968e28..9c0881c43ce 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -418,13 +418,12 @@ end Build a default safe-cast expression : { var $t = ; if( Std.is($t,) ) $t else throw "Class cast error"; } *) -let default_cast ?(vtmp="$t") com e texpr t p = - let api = com.basic in +let default_cast ?(vtmp="$t") api std e texpr t p = let vtmp = alloc_var VGenerated vtmp e.etype e.epos in let var = mk (TVar (vtmp,Some e)) api.tvoid p in let vexpr = mk (TLocal vtmp) e.etype p in let texpr = Texpr.Builder.make_typeexpr texpr p in - let is = Texpr.Builder.resolve_and_make_static_call com.std "isOfType" [vexpr;texpr] p in + let is = Texpr.Builder.resolve_and_make_static_call std "isOfType" [vexpr;texpr] p in let enull = Texpr.Builder.make_null vexpr.etype p in let eop = Texpr.Builder.binop OpEq vexpr enull api.tbool p in let echeck = Texpr.Builder.binop OpBoolOr is eop api.tbool p in @@ -453,12 +452,12 @@ module UnificationCallback = struct List.map (fun e -> f e t_dynamic) el end;; -let interpolate_code com code tl f_string f_expr p = +let interpolate_code error code tl f_string f_expr p = let exprs = Array.of_list tl in let i = ref 0 in let err msg = let pos = { p with pmin = p.pmin + !i } in - com.error msg pos + error msg pos in let regex = Str.regexp "[{}]" in let rec loop m = match m with @@ -487,12 +486,6 @@ let interpolate_code com code tl f_string f_expr p = in loop (Str.full_split regex code) -let map_source_header com f = - match Common.defined_value_safe com Define.SourceHeader with - | "" -> () - | s -> f s - - (* Static extensions for classes *) module ExtClass = struct let add_static_init c cf e p = diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index e03926e85a3..2a56cefa378 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -672,13 +672,13 @@ module SignatureConverter = struct and convert_signature ctx p jsig = match jsig with - | TByte -> mk_type_path (["java"; "types"], "Int8") [] p - | TChar -> mk_type_path (["java"; "types"], "Char16") [] p + | TByte -> mk_type_path (["jvm"], "Int8") [] p + | TChar -> mk_type_path (["jvm"], "Char16") [] p | TDouble -> mk_type_path ([], "Float") [] p | TFloat -> mk_type_path ([], "Single") [] p | TInt -> mk_type_path ([], "Int") [] p | TLong -> mk_type_path (["haxe"], "Int64") [] p - | TShort -> mk_type_path (["java"; "types"], "Int16") [] p + | TShort -> mk_type_path (["jvm"], "Int16") [] p | TBool -> mk_type_path ([], "Bool") [] p | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ([], name) (List.map (convert_arg ctx p) args) p | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ([], "Dynamic") [] p @@ -693,7 +693,7 @@ module SignatureConverter = struct | _ -> die "" __LOC__ in mk_type_path (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param) p | TObjectInner (pack, inners) -> die "" __LOC__ - | TArray (jsig, _) -> mk_type_path (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,p) ] p + | TArray (jsig, _) -> mk_type_path (["jvm"], "NativeArray") [ TPType (convert_signature ctx p jsig,p) ] p | TMethod _ -> failwith "TMethod cannot be converted directly into Complex Type" | TTypeParameter s -> try diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index e3c432e93dd..8a1a1c437d1 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -241,7 +241,7 @@ module Setup = struct message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Information) ); com.warning <- (fun ?(depth=0) ?(from_macro=false) w options msg p -> - match Warning.get_mode w (com.warning_options @ options) with + match Warning.get_mode w (options @ com.warning_options) with | WMEnable -> let wobj = Warning.warning_obj w in let msg = if wobj.w_generic then @@ -578,6 +578,7 @@ module HighLevel = struct let args = !each_args @ args in let added_libs = Hashtbl.create 0 in let server_mode = ref SMNone in + let hxml_stack = ref [] in let create_context args = let ctx = create (server_api.on_context_create()) args in ctx @@ -637,6 +638,11 @@ module HighLevel = struct | arg :: l -> match List.rev (ExtString.String.nsplit arg ".") with | "hxml" :: _ :: _ when (match acc with "-cmd" :: _ | "--cmd" :: _ -> false | _ -> true) -> + let full_path = Extc.get_full_path arg in + if List.mem full_path !hxml_stack then + raise (Arg.Bad (Printf.sprintf "Duplicate hxml inclusion: %s" full_path)) + else + hxml_stack := full_path :: !hxml_stack; let acc, l = (try acc, Helper.parse_hxml arg @ l with Not_found -> (arg ^ " (file not found)") :: acc, l) in loop acc l | _ -> diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index c868b8a2e3b..950f5622c02 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -96,7 +96,7 @@ let process_display_configuration ctx = add_diagnostics_message ?depth com s p DKCompilerMessage Information ); com.warning <- (fun ?(depth = 0) ?from_macro w options s p -> - match Warning.get_mode w (com.warning_options @ options) with + match Warning.get_mode w (options @ com.warning_options) with | WMEnable -> let wobj = Warning.warning_obj w in add_diagnostics_message ~depth ~code:(Some wobj.w_name) com s p DKCompilerMessage Warning diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index ede254bec78..e40fee92022 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -174,11 +174,11 @@ let generate ctx tctx ext actx = with Not_found -> None in - Genswf.generate header,"swf" + Genswf.generate header com.Common.native_libs.swf_libs com.Common.flash_version,"swf" | Neko -> - Genneko.generate,"neko" + Genneko.generate com.neko_lib_paths,"neko" | Js -> - Genjs.generate,"js" + Genjs.generate com.js_gen,"js" | Lua -> Genlua.generate,"lua" | Php -> @@ -201,7 +201,7 @@ let generate ctx tctx ext actx = else begin Common.log com ("Generating " ^ name ^ ": " ^ com.file); let t = Timer.timer ["generate";name] in - generate com; + generate (Common.to_gctx com); t() end end diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index 50d6ac45ba5..6185ef167d0 100644 --- a/src/context/abstractCast.ml +++ b/src/context/abstractCast.ml @@ -296,8 +296,8 @@ let handle_abstract_casts ctx e = | TCast(e2,None) -> {e1 with eexpr = TCast(find_field e2,None)} | TField(e2,fa) -> - let e2 = loop e2 in let a,pl,e2 = find_abstract e2 e2.etype in + let e2 = loop e2 in let m = Abstract.get_underlying_type a pl in let fname = field_name fa in let el = List.map loop el in diff --git a/src/context/common.ml b/src/context/common.ml index b0662d700b2..eaf0048645e 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -348,11 +348,6 @@ class virtual abstract_hxb_lib = object(self) method virtual get_string_pool : string -> string array option end -type context_main = { - mutable main_class : path option; - mutable main_expr : texpr option; -} - type context = { compilation_step : int; mutable stage : compiler_stage; @@ -371,15 +366,15 @@ type context = { mutable config : platform_config; empty_class_path : ClassPath.class_path; class_paths : ClassPaths.class_paths; - main : context_main; + main : Gctx.context_main; mutable package_rules : (string,package_rule) PMap.t; mutable report_mode : report_mode; (* communication *) mutable print : string -> unit; - mutable error : ?depth:int -> string -> pos -> unit; + mutable error : Gctx.error_function; mutable error_ext : Error.error -> unit; mutable info : ?depth:int -> ?from_macro:bool -> string -> pos -> unit; - mutable warning : ?depth:int -> ?from_macro:bool -> warning -> Warning.warning_option list list -> string -> pos -> unit; + mutable warning : Gctx.warning_function; mutable warning_options : Warning.warning_option list list; mutable get_messages : unit -> compiler_message list; mutable filter_messages : (compiler_message -> bool) -> unit; @@ -433,6 +428,32 @@ type context = { mutable hxb_writer_config : HxbWriterConfig.t option; } +let to_gctx com = { + Gctx.platform = com.platform; + defines = com.defines; + basic = com.basic; + class_paths = com.class_paths; + run_command = com.run_command; + run_command_args = com.run_command_args; + warning = com.warning; + error = com.error; + print = com.print; + debug = com.debug; + file = com.file; + version = com.version; + features = com.features; + modules = com.modules; + main = com.main; + types = com.types; + resources = com.resources; + native_libs = (match com.platform with + | Jvm -> (com.native_libs.java_libs :> NativeLibraries.native_library_base list) + | Flash -> (com.native_libs.swf_libs :> NativeLibraries.native_library_base list) + | _ -> []); + include_files = com.include_files; + std = com.std; +} + let enter_stage com stage = (* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *) com.stage <- stage @@ -522,9 +543,6 @@ let defines_for_external ctx = | split -> PMap.add (String.concat "-" split) v added_underscore; ) ctx.defines.values PMap.empty -let get_es_version com = - try int_of_string (defined_value com Define.JsEs) with _ -> 0 - let short_platform_name = function | Cross -> "x" | Js -> "js" @@ -587,7 +605,7 @@ let get_config com = (* impossible to reach. see update_platform_config *) raise Exit | Js -> - let es6 = get_es_version com >= 6 in + let es6 = Gctx.get_es_version com.defines >= 6 in { default_config with pf_static = false; @@ -827,7 +845,7 @@ let create compilation_step cs version args display_mode = get_macros = (fun() -> None); info = (fun ?depth ?from_macro _ _ -> die "" __LOC__); warning = (fun ?depth ?from_macro _ _ _ -> die "" __LOC__); - warning_options = []; + warning_options = [List.map (fun w -> {wo_warning = w;wo_mode = WMDisable}) WarningList.disabled_warnings]; error = (fun ?depth _ _ -> die "" __LOC__); error_ext = (fun _ -> die "" __LOC__); get_messages = (fun() -> []); @@ -927,27 +945,6 @@ let flash_versions = List.map (fun v -> v, string_of_int maj ^ (if min = 0 then "" else "_" ^ string_of_int min) ) [9.;10.;10.1;10.2;10.3;11.;11.1;11.2;11.3;11.4;11.5;11.6;11.7;11.8;11.9;12.0;13.0;14.0;15.0;16.0;17.0;18.0;19.0;20.0;21.0;22.0;23.0;24.0;25.0;26.0;27.0;28.0;29.0;31.0;32.0] -let flash_version_tag = function - | 6. -> 6 - | 7. -> 7 - | 8. -> 8 - | 9. -> 9 - | 10. | 10.1 -> 10 - | 10.2 -> 11 - | 10.3 -> 12 - | 11. -> 13 - | 11.1 -> 14 - | 11.2 -> 15 - | 11.3 -> 16 - | 11.4 -> 17 - | 11.5 -> 18 - | 11.6 -> 19 - | 11.7 -> 20 - | 11.8 -> 21 - | 11.9 -> 22 - | v when v >= 12.0 && float_of_int (int_of_float v) = v -> int_of_float v + 11 - | v -> failwith ("Invalid SWF version " ^ string_of_float v) - let update_platform_config com = match com.platform with | CustomTarget _ -> @@ -1093,90 +1090,6 @@ let hash f = done; if Sys.word_size = 64 then Int32.to_int (Int32.shift_right (Int32.shift_left (Int32.of_int !h) 1) 1) else !h -let url_encode s add_char = - let hex = "0123456789ABCDEF" in - for i = 0 to String.length s - 1 do - let c = String.unsafe_get s i in - match c with - | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' | '.' -> - add_char c - | _ -> - add_char '%'; - add_char (String.unsafe_get hex (int_of_char c lsr 4)); - add_char (String.unsafe_get hex (int_of_char c land 0xF)); - done - -let url_encode_s s = - let b = Buffer.create 0 in - url_encode s (Buffer.add_char b); - Buffer.contents b - -(* UTF8 *) - -let to_utf8 str p = - let u8 = try - UTF8.validate str; - str; - with - UTF8.Malformed_code -> - (* ISO to utf8 *) - let b = UTF8.Buf.create 0 in - String.iter (fun c -> UTF8.Buf.add_char b (UCharExt.of_char c)) str; - UTF8.Buf.contents b - in - let ccount = ref 0 in - UTF8.iter (fun c -> - let c = UCharExt.code c in - if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then Error.abort "Invalid unicode char" p; - incr ccount; - if c > 0x10000 then incr ccount; - ) u8; - u8, !ccount - -let utf16_add buf c = - let add c = - Buffer.add_char buf (char_of_int (c land 0xFF)); - Buffer.add_char buf (char_of_int (c lsr 8)); - in - if c >= 0 && c < 0x10000 then begin - if c >= 0xD800 && c <= 0xDFFF then failwith ("Invalid unicode char " ^ string_of_int c); - add c; - end else if c < 0x110000 then begin - let c = c - 0x10000 in - add ((c asr 10) + 0xD800); - add ((c land 1023) + 0xDC00); - end else - failwith ("Invalid unicode char " ^ string_of_int c) - -let utf8_to_utf16 str zt = - let b = Buffer.create (String.length str * 2) in - (try UTF8.iter (fun c -> utf16_add b (UCharExt.code c)) str with Invalid_argument _ | UCharExt.Out_of_range -> ()); (* if malformed *) - if zt then utf16_add b 0; - Buffer.contents b - -let utf16_to_utf8 str = - let b = Buffer.create 0 in - let add c = Buffer.add_char b (char_of_int (c land 0xFF)) in - let get i = int_of_char (String.unsafe_get str i) in - let rec loop i = - if i >= String.length str then () - else begin - let c = get i in - if c < 0x80 then begin - add c; - loop (i + 2); - end else if c < 0x800 then begin - let c = c lor ((get (i + 1)) lsl 8) in - add c; - add (c lsr 8); - loop (i + 2); - end else - die "" __LOC__; - end - in - loop 0; - Buffer.contents b - let add_diagnostics_message ?(depth = 0) ?(code = None) com s p kind sev = if sev = MessageSeverity.Error then com.has_error <- true; let di = com.shared.shared_display_information in diff --git a/src/context/display/display.ml b/src/context/display/display.ml index 075839bbe12..b7256cbea6e 100644 --- a/src/context/display/display.ml +++ b/src/context/display/display.ml @@ -35,21 +35,12 @@ let preprocess_expr com e = match com.display.dms_kind with | DMSignature -> ExprPreprocessing.find_display_call e | _ -> e -let get_expected_name with_type = match with_type with - | WithType.Value (Some src) | WithType.WithType(_,Some src) -> - (match src with - | WithType.FunctionArgument si -> Some si.si_name - | WithType.StructureField si -> Some si .si_name - | WithType.ImplicitReturn -> None - ) - | _ -> None - let sort_fields l with_type tk = let p = match tk with | TKExpr p | TKField p -> Some p | _ -> None in - let expected_name = get_expected_name with_type in + let expected_name = WithType.get_expected_name with_type in let l = List.map (fun ci -> let i = get_sort_index tk ci (Option.default Globals.null_pos p) expected_name in ci,i diff --git a/src/context/display/displayException.ml b/src/context/display/displayException.ml index 59c2d8d9454..f2b402db377 100644 --- a/src/context/display/displayException.ml +++ b/src/context/display/displayException.ml @@ -184,7 +184,8 @@ let to_json ctx de = let named_source_kind = function | WithType.FunctionArgument name -> (0, name) | WithType.StructureField name -> (1, name) - | _ -> die "" __LOC__ + | LocalVariable name -> (2, name) + | ImplicitReturn -> die "" __LOC__ in let ctx = Genjson.create_context GMFull in let generate_name kind = diff --git a/src/context/nativeLibraries.ml b/src/context/nativeLibraries.ml index fe7de4b6396..bf922c9e2da 100644 --- a/src/context/nativeLibraries.ml +++ b/src/context/nativeLibraries.ml @@ -23,7 +23,7 @@ type native_lib_flags = | FlagIsStd | FlagIsExtern -class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self) +class virtual native_library_base (name : string) (file_path : string) = object(self) val mutable flags : native_lib_flags list = [] method add_flag flag = flags <- flag :: flags @@ -31,6 +31,10 @@ class virtual ['a,'data] native_library (name : string) (file_path : string) = o method get_name = name method get_file_path = file_path +end + +class virtual ['a,'data] native_library (name : string) (file_path : string) = object(self) + inherit native_library_base name file_path method virtual build : path -> pos -> Ast.package option method virtual close : unit diff --git a/src/context/sourcemaps.ml b/src/context/sourcemaps.ml index 3dd3e39cb47..761109bd108 100644 --- a/src/context/sourcemaps.ml +++ b/src/context/sourcemaps.ml @@ -1,6 +1,6 @@ open Extlib_leftovers open Globals -open Common +open Gctx (** Characters used for base64 VLQ encoding @@ -127,7 +127,7 @@ class sourcemap_writer (generated_file:string) = output_string channel ("\"sources\":[" ^ (String.concat "," (List.map (fun s -> "\"" ^ to_url s ^ "\"") sources)) ^ "],\n"); - if Common.defined com Define.SourceMapContent then begin + if Gctx.defined com Define.SourceMapContent then begin output_string channel ("\"sourcesContent\":[" ^ (String.concat "," (List.map (fun s -> try "\"" ^ StringHelper.s_escape (Std.input_file ~bin:true s) ^ "\"" with _ -> "null") sources)) ^ "],\n"); diff --git a/src/context/typecore.ml b/src/context/typecore.ml index d1307bd3c4f..08ffb0d085a 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -358,7 +358,7 @@ let type_generic_function_ref : (typer -> field_access -> (unit -> texpr) field_ let create_context_ref : (Common.context -> ((unit -> unit) * typer) option -> typer) ref = ref (fun _ -> assert false) let warning ?(depth=0) ctx w msg p = - let options = (Warning.from_meta ctx.c.curclass.cl_meta) @ (Warning.from_meta ctx.f.curfield.cf_meta) in + let options = (Warning.from_meta ctx.f.curfield.cf_meta) @ (Warning.from_meta ctx.c.curclass.cl_meta) in match Warning.get_mode w options with | WMEnable -> module_warning ctx.com ctx.m.curmod w options msg p diff --git a/src/core/stringHelper.ml b/src/core/stringHelper.ml index 824e8e1aa99..aca5df70c86 100644 --- a/src/core/stringHelper.ml +++ b/src/core/stringHelper.ml @@ -1,3 +1,6 @@ +open Globals +open Extlib_leftovers + let uppercase s = let bytes = Bytes.of_string s in Bytes.iteri @@ -68,4 +71,88 @@ let extension file = let dot_pos = String.rindex file '.' in String.sub file dot_pos (String.length file - dot_pos) with Not_found -> - file \ No newline at end of file + file + +(* UTF8 *) + +let to_utf8 str p = + let u8 = try + UTF8.validate str; + str; + with + UTF8.Malformed_code -> + (* ISO to utf8 *) + let b = UTF8.Buf.create 0 in + String.iter (fun c -> UTF8.Buf.add_char b (UCharExt.of_char c)) str; + UTF8.Buf.contents b + in + let ccount = ref 0 in + UTF8.iter (fun c -> + let c = UCharExt.code c in + if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then failwith "Invalid unicode char"; + incr ccount; + if c > 0x10000 then incr ccount; + ) u8; + u8, !ccount + +let utf16_add buf c = + let add c = + Buffer.add_char buf (char_of_int (c land 0xFF)); + Buffer.add_char buf (char_of_int (c lsr 8)); + in + if c >= 0 && c < 0x10000 then begin + if c >= 0xD800 && c <= 0xDFFF then failwith ("Invalid unicode char " ^ string_of_int c); + add c; + end else if c < 0x110000 then begin + let c = c - 0x10000 in + add ((c asr 10) + 0xD800); + add ((c land 1023) + 0xDC00); + end else + failwith ("Invalid unicode char " ^ string_of_int c) + +let utf8_to_utf16 str zt = + let b = Buffer.create (String.length str * 2) in + (try UTF8.iter (fun c -> utf16_add b (UCharExt.code c)) str with Invalid_argument _ | UCharExt.Out_of_range -> ()); (* if malformed *) + if zt then utf16_add b 0; + Buffer.contents b + +let utf16_to_utf8 str = + let b = Buffer.create 0 in + let add c = Buffer.add_char b (char_of_int (c land 0xFF)) in + let get i = int_of_char (String.unsafe_get str i) in + let rec loop i = + if i >= String.length str then () + else begin + let c = get i in + if c < 0x80 then begin + add c; + loop (i + 2); + end else if c < 0x800 then begin + let c = c lor ((get (i + 1)) lsl 8) in + add c; + add (c lsr 8); + loop (i + 2); + end else + die "" __LOC__; + end + in + loop 0; + Buffer.contents b + +let url_encode s add_char = + let hex = "0123456789ABCDEF" in + for i = 0 to String.length s - 1 do + let c = String.unsafe_get s i in + match c with + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' | '.' -> + add_char c + | _ -> + add_char '%'; + add_char (String.unsafe_get hex (int_of_char c lsr 4)); + add_char (String.unsafe_get hex (int_of_char c land 0xF)); + done + +let url_encode_s s = + let b = Buffer.create 0 in + url_encode s (Buffer.add_char b); + Buffer.contents b diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index a1834532288..880fa528403 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -432,6 +432,7 @@ let dynamify_monos t = loop t exception ApplyParamsRecursion +exception ApplyParamsMismatch (* substitute parameters with other types *) let apply_params ?stack cparams params t = @@ -442,7 +443,7 @@ let apply_params ?stack cparams params t = match l1, l2 with | [] , [] -> [] | ttp :: l1 , t2 :: l2 -> (ttp.ttp_class,t2) :: loop l1 l2 - | _ -> die "" __LOC__ + | _ -> raise ApplyParamsMismatch in let subst = loop cparams params in let rec loop t = diff --git a/src/core/tType.ml b/src/core/tType.ml index a60b67b47b8..b8b2730cbd5 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -505,10 +505,11 @@ type flag_tclass_field = | CfPostProcessed (* Marker to indicate the field has been post-processed *) | CfUsed (* Marker for DCE *) | CfMaybeUsed (* Marker for DCE *) + | CfNoLookup (* Field cannot be accessed by-name. *) (* Order has to match declaration for printing*) let flag_tclass_field_names = [ - "CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed";"CfUsed";"CfMaybeUsed" + "CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed";"CfUsed";"CfMaybeUsed";"CfNoLookup" ] type flag_tenum = diff --git a/src/core/texpr.ml b/src/core/texpr.ml index 558b8c963fe..53c62f586d1 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -328,6 +328,7 @@ let duplicate_tvars f_this e = let v2 = alloc_var v.v_kind v.v_name v.v_type v.v_pos in v2.v_meta <- v.v_meta; v2.v_extra <- v.v_extra; + v2.v_flags <- v.v_flags; Hashtbl.add vars v.v_id v2; v2; in diff --git a/src/core/warning.ml b/src/core/warning.ml index 4cc152a577c..8fe357934bc 100644 --- a/src/core/warning.ml +++ b/src/core/warning.ml @@ -79,17 +79,20 @@ let get_mode w (l : warning_option list list) = | None -> false | Some w' -> matches w' id in - let rec loop mode l = match l with + let rec loop l = match l with | [] -> - mode + WMEnable | l2 :: l -> - let rec loop2 mode l = match l with + let rec loop2 l = match l with | [] -> - mode + None | opt :: l -> - let mode = if matches w opt.wo_warning then opt.wo_mode else mode in - loop2 mode l + if matches w opt.wo_warning then Some opt.wo_mode else loop2 l in - loop (loop2 mode l2) l + match loop2 l2 with + | None -> + loop l + | Some mode -> + mode in - loop WMEnable (* ? *) l + loop l diff --git a/src/core/withType.ml b/src/core/withType.ml index 6f42b3d4f96..f5620b77eb5 100644 --- a/src/core/withType.ml +++ b/src/core/withType.ml @@ -8,6 +8,7 @@ type with_type_source_information = { type with_type_source = | FunctionArgument of with_type_source_information | StructureField of with_type_source_information + | LocalVariable of with_type_source_information | ImplicitReturn type t = @@ -25,18 +26,46 @@ let of_implicit_return t = WithType(t,Some ImplicitReturn) let with_argument t name = WithType(t,Some(FunctionArgument (make_with_type_source_information name None))) let with_argument_and_doc t name doc = WithType(t,Some(FunctionArgument (make_with_type_source_information name (Some doc)))) let with_structure_field t name = WithType(t,Some(StructureField (make_with_type_source_information name None))) +let with_local_variable t name = WithType(t,Some(LocalVariable (make_with_type_source_information name None))) let value = Value None let named_argument name = Value (Some(FunctionArgument (make_with_type_source_information name None))) let named_structure_field name = Value (Some(StructureField (make_with_type_source_information name None))) let no_value = NoValue +let get_source_info_name = function + | FunctionArgument si -> Some si.si_name + | StructureField si -> Some si.si_name + | LocalVariable si -> Some si.si_name + | ImplicitReturn -> None + +let string_of_with_type_source = function + | FunctionArgument si -> + Printf.sprintf "FunctionArgument(%s)" si.si_name + | StructureField si -> + Printf.sprintf "StructureField(%s)" si.si_name + | LocalVariable si -> + Printf.sprintf "LocalVariable(%s)" si.si_name + | ImplicitReturn -> + "ImplicitReturn" + +let get_expected_name with_type = match with_type with + | Value (Some si) | WithType(_,Some si) -> + get_source_info_name si + | _ -> + None + let to_string = function - | NoValue -> "NoValue" - | Value (None | Some ImplicitReturn) -> "Value" - | Value (Some(FunctionArgument si | StructureField si)) -> "Value " ^ si.si_name - | WithType(t,s) -> - let name = match s with - | Some(FunctionArgument si | StructureField si) -> si.si_name - | _ -> "None" + | NoValue -> + "NoValue" + | Value None -> + "Value(None)" + | Value (Some wts) -> + Printf.sprintf "Value(Some(%s))" (string_of_with_type_source wts) + | WithType(t,wts) -> + let s = match wts with + | None -> + "None" + | Some wts -> + Printf.sprintf "Some(%s)" (string_of_with_type_source wts) in - Printf.sprintf "WithType(%s, %s)" (s_type (print_context()) t) name + Printf.sprintf "WithType(%s, %s)" (s_type (print_context()) t) s \ No newline at end of file diff --git a/src/filters/ES6Ctors.ml b/src/filters/ES6Ctors.ml index 8dd2b526fcb..82126bb68d0 100644 --- a/src/filters/ES6Ctors.ml +++ b/src/filters/ES6Ctors.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) -open Common +open Gctx open Globals open Type open Texpr.Builder diff --git a/src/filters/capturedVars.ml b/src/filters/capturedVars.ml index b5bf1f81c3f..0bba9dc44b8 100644 --- a/src/filters/capturedVars.ml +++ b/src/filters/capturedVars.ml @@ -47,7 +47,7 @@ let captured_vars com e = | Jvm -> let cnativearray = match (List.find (fun md -> match md with - | TClassDecl ({ cl_path = ["java"],"NativeArray" }) -> true + | TClassDecl ({ cl_path = ["jvm"],"NativeArray" }) -> true | _ -> false ) com.types) with TClassDecl cl -> cl | _ -> die "" __LOC__ diff --git a/src/filters/filters.ml b/src/filters/filters.ml index b8efae167a4..e2baac24dcf 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -441,7 +441,7 @@ module ForRemap = struct | TFor(v,e1,e2) -> let e1 = loop e1 in let e2 = loop e2 in - let iterator = ForLoop.IterationKind.of_texpr ctx e1 (ForLoop.is_cheap_enough_t ctx e2) e.epos in + let iterator = ForLoop.IterationKind.of_texpr ctx e1 (ForLoop.get_unroll_params_t ctx e2) e.epos in let restore = save_locals ctx in let e = ForLoop.IterationKind.to_texpr ctx v iterator e2 e.epos in restore(); diff --git a/src/filters/localStatic.ml b/src/filters/localStatic.ml index 3f462265d07..9c3cbb28bdb 100644 --- a/src/filters/localStatic.ml +++ b/src/filters/localStatic.ml @@ -18,7 +18,8 @@ let promote_local_static lsctx run v eo = ] v.v_pos); with Not_found -> let cf = mk_field name ~static:true v.v_type v.v_pos v.v_pos in - cf.cf_meta <- v.v_meta; + cf.cf_meta <- (Meta.NoCompletion,[],Globals.null_pos) :: v.v_meta; + add_class_field_flag cf CfNoLookup; begin match eo with | None -> () diff --git a/src/generators/cpp/cppAst.ml b/src/generators/cpp/cppAst.ml new file mode 100644 index 00000000000..96707878ff3 --- /dev/null +++ b/src/generators/cpp/cppAst.ml @@ -0,0 +1,157 @@ +open Extlib_leftovers +open Ast +open Type +open Error +open Globals + +type tcpp = + | TCppDynamic + | TCppUnchanged + | TCppObject + | TCppObjectPtr + | TCppVoid + | TCppNull + | TCppEnum of tenum + | TCppScalar of string + | TCppString + | TCppFastIterator of tcpp + | TCppPointer of string * tcpp + | TCppRawPointer of string * tcpp + | TCppFunction of tcpp list * tcpp * string + | TCppObjCBlock of tcpp list * tcpp + | TCppRest of tcpp + | TCppReference of tcpp + | TCppStruct of tcpp + | TCppStar of tcpp * bool + | TCppVoidStar + | TCppVarArg + | TCppAutoCast + | TCppDynamicArray + | TCppObjectArray of tcpp + | TCppWrapped of tcpp + | TCppScalarArray of tcpp + | TCppObjC of tclass + | TCppNativePointer of tclass + | TCppVariant + | TCppCode of tcpp + | TCppInst of tclass * tcpp list + | TCppInterface of tclass + | TCppProtocol of tclass + | TCppClass + | TCppGlobal + +and tcppexpr = { cppexpr : tcpp_expr_expr; cpptype : tcpp; cpppos : pos } + +and tcpp_closure = { + close_type : tcpp; + close_args : (tvar * texpr option) list; + close_expr : tcppexpr; + close_id : int; + close_undeclared : (string, tvar) Hashtbl.t; + close_this : tcppthis option; +} + +and tcppcrementop = CppIncrement | CppDecrement +and tcppunop = CppNeg | CppNegBits | CppNot +and tcppthis = ThisReal | ThisFake | ThisDynamic + +and tcppvarloc = + | VarLocal of tvar + | VarClosure of tvar + | VarThis of tclass_field * tcpp + | VarInstance of tcppexpr * tclass_field * string * string + | VarInterface of tcppexpr * tclass_field + | VarStatic of tclass * bool * tclass_field + | VarInternal of tcppexpr * string * string + +and tcppinst = InstPtr | InstObjC | InstStruct + +and tcppfuncloc = + | FuncThis of tclass_field * tcpp + | FuncInstance of tcppexpr * tcppinst * tclass_field + | FuncStatic of tclass * bool * tclass_field + | FuncTemplate of tclass * tclass_field * path * bool + | FuncInterface of tcppexpr * tclass * tclass_field + | FuncEnumConstruct of tenum * tenum_field + | FuncSuperConstruct of tcpp + | FuncSuper of tcppthis * tcpp * tclass_field + | FuncNew of tcpp + | FuncExpression of tcppexpr + | FuncInternal of tcppexpr * string * string + | FuncExtern of string * bool + | FuncFromStaticFunction + +and tcpparrayloc = + | ArrayTyped of tcppexpr * tcppexpr * tcpp + | ArrayPointer of tcppexpr * tcppexpr + | ArrayRawPointer of tcppexpr * tcppexpr + | ArrayObject of tcppexpr * tcppexpr * tcpp + | ArrayVirtual of tcppexpr * tcppexpr + | ArrayImplements of tclass * tcppexpr * tcppexpr + | ArrayDynamic of tcppexpr * tcppexpr + +and tcpplvalue = + | CppVarRef of tcppvarloc + | CppArrayRef of tcpparrayloc + | CppDynamicRef of tcppexpr * string + | CppExternRef of string * bool + +and tcpp_expr_expr = + | CppInt of int32 + | CppFloat of string + | CppString of string + | CppBool of bool + | CppNull + | CppNullAccess + | CppNil + | CppThis of tcppthis + | CppSuper of tcppthis + | CppCode of string * tcppexpr list + | CppClosure of tcpp_closure + | CppVar of tcppvarloc + | CppExtern of string * bool + | CppDynamicField of tcppexpr * string + | CppFunction of tcppfuncloc * tcpp + | CppEnumIndex of tcppexpr + | CppEnumField of tenum * tenum_field + | CppCall of tcppfuncloc * tcppexpr list + | CppFunctionAddress of tclass * tclass_field + | CppNewNative of tcppexpr + | CppAddressOf of tcppexpr + | CppDereference of tcppexpr + | CppArray of tcpparrayloc + | CppCrement of tcppcrementop * Ast.unop_flag * tcpplvalue + | CppSet of tcpplvalue * tcppexpr + | CppModify of Ast.binop * tcpplvalue * tcppexpr + | CppBinop of Ast.binop * tcppexpr * tcppexpr + | CppCompare of string * tcppexpr * tcppexpr * Ast.binop + | CppNullCompare of string * tcppexpr + | CppObjectDecl of (string * tcppexpr) list * bool + | CppPosition of string * int32 * string * string + | CppArrayDecl of tcppexpr list + | CppUnop of tcppunop * tcppexpr + | CppVarDecl of tvar * tcppexpr option + | CppBlock of tcppexpr list * tcpp_closure list * bool + | CppFor of tvar * tcppexpr * tcppexpr + | CppIf of tcppexpr * tcppexpr * tcppexpr option + | CppWhile of tcppexpr * tcppexpr * Ast.while_flag * int + | CppIntSwitch of tcppexpr * (Int32.t list * tcppexpr) list * tcppexpr option + | CppSwitch of + tcppexpr * tcpp * (tcppexpr list * tcppexpr) list * tcppexpr option * int + | CppTry of tcppexpr * (tvar * tcppexpr) list + | CppBreak + | CppContinue + | CppClassOf of path * bool + | CppGoto of int + | CppReturn of tcppexpr option + | CppThrow of tcppexpr + | CppEnumParameter of tcppexpr * tenum_field * int + | CppTCast of tcppexpr * tcpp + | CppCast of tcppexpr * tcpp + | CppCastStatic of tcppexpr * tcpp + | CppCastScalar of tcppexpr * string + | CppCastVariant of tcppexpr + | CppCastObjC of tcppexpr * tclass + | CppCastObjCBlock of tcppexpr * tcpp list * tcpp + | CppCastProtocol of tcppexpr * tclass + | CppCastNative of tcppexpr \ No newline at end of file diff --git a/src/generators/cpp/cppAstTools.ml b/src/generators/cpp/cppAstTools.ml new file mode 100644 index 00000000000..6e0882f38d0 --- /dev/null +++ b/src/generators/cpp/cppAstTools.ml @@ -0,0 +1,729 @@ +open Extlib_leftovers +open Ast +open Type +open Error +open Globals +open CppAst +open CppTypeUtils + +let follow = Abstract.follow_with_abstracts + +(* + A class_path is made from a package (array of strings) and a class name. + Join these together, inclding a separator. eg, "/" for includes : pack1/pack2/Name or "::" + for namespace "pack1::pack2::Name" +*) +let join_class_path path separator = + let result = + match (fst path, snd path) with + | [], s -> s + | el, s -> String.concat separator el ^ separator ^ s + in + if String.contains result '+' then + let idx = String.index result '+' in + String.sub result 0 idx + ^ String.sub result (idx + 1) (String.length result - idx - 1) + else result + +let class_text path = "::" ^ join_class_path path "::" + +let is_internal_member member = + member = "toString" || String.length member > 1 && String.sub member 0 2 = "__" && + match member with + | "__ArgCount" + | "__ArrayImplRef" + | "__CStr" + | "__Compare" + | "__Create" + | "__CreateEmpty" + | "__FieldRef" + | "__FindArgCount" + | "__GetFieldMap" + | "__GetHandle" + | "__GetItem" + | "__GetScriptCallable" + | "__GetScriptVTable" + | "__Param" + | "__Remove" + | "__SGetClass" + | "__Set" + | "__SetItem" + | "__TArrayImplRef" + | "__ToDouble" + | "__ToInt" + | "__ToInterface" + | "__ToObject" + | "__Visit" + | "__WCStr" + | "__a" + | "__blit" + | "__boot" + | "__boot_all" + | "__compare" + | "__concat" + | "__construct" + | "__copy" + | "__filter" + | "__get_args" + | "__hx_dump_stack" + | "__hx_field_iter" + | "__hxt_gc_new" + | "__indexOf" + | "__insert" + | "__instanceof" + | "__int" + | "__iterator" + | "__join" + | "__lastIndexOf" + | "__loadprim" + | "__mClass" + | "__mDynamicFields" + | "__map" + | "__memcmp" + | "__new" + | "__pop" + | "__prime" + | "__push" + | "__qsort" + | "__unshift" + | "__unsafeStringReference" + | "__time_stamp" + | "__superString" + | "__splice" + | "__shift" + | "__slice" + | "__sort" + | "__s_id" + | "__run" + | "__root" + | "__register" + | "__remove" + | "__removeAt" + | "__reverse" + | "__zero" + | "__Field" + | "__IField" + | "__Run" + | "__Is" + | "__GetClass" + | "__GetType" + | "__ToString" + | "__s" + | "__GetPtr" + | "__SetField" + | "__length" + | "__IsArray" + | "__SetThis" + | "__Internal" + | "__EnumParams" + | "__Index" + | "__Tag" + | "__GetFields" + | "__HasField" + | "__get" + | "__set" + | "__unsafe_get" + | "__unsafe_set" + | "__global__" + | "__SetSize" + | "__trace" + | "__GetRealObject" + | "__SetSizeExact" + | "__cpp__" + | "__URLEncode" + | "__URLDecode" + | "__IsEnum" -> + true + | _ -> + String.length member > 4 && String.sub member 0 4 = "__hx" + +let is_known_member member = + match member with "__meta__" | "__rtti" | "_Compare" -> true | _ -> false + +(* Convert function names that can't be written in c++ ... *) +let keyword_remap name = + if is_internal_member name || is_known_member name then name + else if String.length name > 1 && String.sub name 0 2 = "__" then + "_hx_" ^ name + else + match name with + | "int" + | "Int" + | "Bool" + | "super" + | "auto" + | "char" + | "const" + | "delete" + | "double" + | "Float" + | "enum" + | "extern" + | "float" + | "friend" + | "goto" + | "long" + | "operator" + | "protected" + | "register" + | "short" + | "signed" + | "sizeof" + | "template" + | "typedef" + | "union" + | "unsigned" + | "void" + | "volatile" + | "or" + | "and" + | "xor" + | "or_eq" + | "not" + | "and_eq" + | "xor_eq" + | "typeof" + | "stdin" + | "stdout" + | "stderr" + | "system" + | "BIG_ENDIAN" + | "LITTLE_ENDIAN" + | "assert" + | "NULL" + | "wchar_t" + | "EOF" + | "bool" + | "const_cast" + | "dynamic_cast" + | "explicit" + | "export" + | "mutable" + | "namespace" + | "reinterpret_cast" + | "static_cast" + | "typeid" + | "typename" + | "virtual" + | "_Complex" + | "INFINITY" + | "NAN" + | "INT_MIN" + | "INT_MAX" + | "INT8_MIN" + | "INT8_MAX" + | "UINT8_MAX" + | "INT16_MIN" + | "INT16_MAX" + | "UINT16_MAX" + | "INT32_MIN" + | "INT32_MAX" + | "UINT32_MAX" + | "asm" + | "near" + | "far" + | "_w64" + | "HX_" + | "HXLINE" + | "HXDLIN" + | "NO" + | "YES" + | "abstract" + | "decltype" + | "finally" + | "nullptr" + | "static_assert" + | "struct" + | "_Atomic" + | "constexpr" + | "consteval" + | "constinit" + | "co_await" + | "co_return" + | "co_yield" + | "alignas" + | "alignof" + | "_Alignas" + | "_Alignof" + | "requires" -> + "_hx_" ^ name + | x -> x + +let remap_class_path class_path = + let path_remap with_keywords name = + let len = String.length name in + if len > 3 && String.sub name 0 3 = " ::" then String.sub name 3 (len - 3) + else if len > 2 && String.sub name 0 2 = "::" then + String.sub name 2 (len - 2) + else if with_keywords then keyword_remap name + else name + in + ( List.map (path_remap true) (fst class_path), + path_remap false (snd class_path) ) + +let join_class_path_remap path separator = + match join_class_path (remap_class_path path) separator with + | "Class" -> "hx::Class" + | x -> x + +let rec s_tcpp = function + | CppInt _ -> "CppInt" + | CppFloat _ -> "CppFloat" + | CppString _ -> "CppString" + | CppBool _ -> "CppBool" + | CppNull -> "CppNull" + | CppNil -> "CppNil" + | CppThis _ -> "CppThis" + | CppSuper _ -> "CppSuper" + | CppCode _ -> "CppCode" + | CppClosure _ -> "CppClosure" + | CppVar (VarLocal _) -> "CppVarLocal" + | CppVar (VarClosure _) -> "CppVarClosure" + | CppVar (VarThis _) -> "CppVarThis" + | CppVar (VarInstance (expr, field, clazz, op)) -> + "CppVarInstance(" ^ clazz ^ "::" ^ op ^ field.cf_name ^ ")" + | CppVar (VarInterface _) -> "CppVarInterface" + | CppVar (VarStatic (_, true, _)) -> "CppObjcVarStatic" + | CppVar (VarStatic _) -> "CppVarStatic" + | CppVar (VarInternal _) -> "CppVarInternal" + | CppDynamicField _ -> "CppDynamicField" + | CppExtern _ -> "CppExtern" + | CppFunction _ -> "CppFunction" + | CppEnumIndex _ -> "CppEnumIndex" + | CppEnumField _ -> "CppEnumField" + | CppNullAccess -> "CppNullAccess" + | CppCall (FuncThis _, _) -> "CppCallThis" + | CppCall (FuncInstance (obj, inst, field), _) -> + (match inst with + | InstObjC -> "CppCallObjCInstance(" + | InstPtr -> "CppCallInstance(" + | _ -> "CppCallStruct(") + ^ tcpp_to_string obj.cpptype ^ "," ^ field.cf_name ^ ")" + | CppCall (FuncInterface _, _) -> "CppCallInterface" + | CppCall (FuncStatic (_, objC, _), _) -> + if objC then "CppCallStaticObjC" else "CppCallStatic" + | CppCall (FuncTemplate _, _) -> "CppCallTemplate" + | CppCall (FuncEnumConstruct _, _) -> "CppCallEnumConstruct" + | CppCall (FuncSuperConstruct _, _) -> "CppCallSuperConstruct" + | CppCall (FuncSuper _, _) -> "CppCallSuper" + | CppCall (FuncNew _, _) -> "CppCallNew" + | CppCall (FuncExpression _, _) -> "CppCallExpression" + | CppCall (FuncInternal _, _) -> "CppCallInternal" + | CppCall (FuncExtern _, _) -> "CppCallExtern" + | CppCall (FuncFromStaticFunction, _) -> "CppCallFromStaticFunction" + | CppNewNative _ -> "CppNewNative" + | CppAddressOf _ -> "CppAddressOf" + | CppDereference _ -> "CppDereference" + | CppFunctionAddress _ -> "CppFunctionAddress" + | CppArray _ -> "CppArray" + | CppCrement _ -> "CppCrement" + | CppSet _ -> "CppSet" + | CppModify _ -> "CppModify" + | CppBinop _ -> "CppBinop" + | CppCompare _ -> "CppCompare" + | CppNullCompare _ -> "CppNullCompare" + | CppObjectDecl _ -> "CppObjectDecl" + | CppPosition _ -> "CppPosition" + | CppArrayDecl _ -> "CppArrayDecl" + | CppUnop _ -> "CppUnop" + | CppVarDecl _ -> "CppVarDecl" + | CppBlock _ -> "CppBlock" + | CppFor _ -> "CppFor" + | CppIf _ -> "CppIf" + | CppWhile _ -> "CppWhile" + | CppIntSwitch _ -> "CppIntSwitch" + | CppSwitch _ -> "CppSwitch" + | CppTry _ -> "CppTry" + | CppBreak -> "CppBreak" + | CppContinue -> "CppContinue" + | CppClassOf _ -> "CppClassOf" + | CppGoto _ -> "CppGoto" + | CppReturn _ -> "CppReturn" + | CppThrow _ -> "CppThrow" + | CppEnumParameter _ -> "CppEnumParameter" + | CppTCast _ -> "CppTCast" + | CppCast _ -> "CppCast" + | CppCastStatic _ -> "CppCastStatic" + | CppCastScalar _ -> "CppCastScalar" + | CppCastVariant _ -> "CppCastVariant" + | CppCastObjC _ -> "CppCastObjC" + | CppCastObjCBlock _ -> "CppCastObjCBlock" + | CppCastProtocol _ -> "CppCastProtocol" + | CppCastNative _ -> "CppCastNative" + +and tcpp_to_string_suffix suffix tcpp = + match tcpp with + | TCppDynamic -> " ::Dynamic" + | TCppUnchanged -> " ::Dynamic/*Unchanged*/" + | TCppObject -> " ::Dynamic" + | TCppObjectPtr -> " ::hx::Object *" + | TCppReference t -> tcpp_to_string t ^ " &" + | TCppStruct t -> "cpp::Struct< " ^ tcpp_to_string t ^ " >" + | TCppStar (t, const) -> + (if const then "const " else "") ^ tcpp_to_string t ^ " *" + | TCppVoid -> "void" + | TCppVoidStar -> "void *" + | TCppRest _ -> "vaarg_list" + | TCppVarArg -> "vararg" + | TCppAutoCast -> "::cpp::AutoCast" + | TCppVariant -> "::cpp::Variant" + | TCppEnum enum -> " ::" ^ join_class_path_remap enum.e_path "::" ^ suffix + | TCppScalar scalar -> scalar + | TCppString -> "::String" + | TCppFastIterator it -> + "::cpp::FastIterator" ^ suffix ^ "< " ^ tcpp_to_string it ^ " >" + | TCppPointer (ptrType, valueType) -> + "::cpp::" ^ ptrType ^ "< " ^ tcpp_to_string valueType ^ " >" + | TCppRawPointer (constName, valueType) -> + constName ^ tcpp_to_string valueType ^ "*" + | TCppFunction (argTypes, retType, abi) -> + let args = String.concat "," (List.map tcpp_to_string argTypes) in + "::cpp::Function< " ^ tcpp_to_string retType ^ " " ^ abi ^ " (" ^ args + ^ ") >" + | TCppObjCBlock (argTypes, retType) -> + tcpp_objc_block_struct argTypes retType ^ "::t" + | TCppDynamicArray -> "::cpp::VirtualArray" ^ suffix + | TCppObjectArray _ -> "::Array" ^ suffix ^ "< ::Dynamic>" + | TCppWrapped _ -> " ::Dynamic" + | TCppScalarArray value -> + "::Array" ^ suffix ^ "< " ^ tcpp_to_string value ^ " >" + | TCppObjC klass -> + let path = join_class_path_remap klass.cl_path "::" in + if has_class_flag klass CInterface then "id < " ^ path ^ ">" + else path ^ " *" + | TCppProtocol interface -> + let path = + match get_meta_string interface.cl_meta Meta.ObjcProtocol with + | Some p -> p + | None -> join_class_path_remap interface.cl_path "::" + in + "id < " ^ path ^ ">" + | TCppNativePointer klass -> + let name = join_class_path_remap klass.cl_path "::" in + if suffix = "_obj" then name else "::hx::Native< " ^ name ^ "* >" + | TCppInst (klass, p) -> + cpp_class_path_of klass p ^ if is_native_class klass then "" else suffix + | TCppInterface klass when suffix = "_obj" -> + cpp_class_path_of klass [] ^ suffix + | TCppInterface _ -> "::Dynamic" + | TCppClass -> "::hx::Class" ^ suffix + | TCppGlobal -> "::Dynamic" + | TCppNull -> " ::Dynamic" + | TCppCode _ -> "Code" + +and tcpp_objc_block_struct argTypes retType = + let args = String.concat "," (List.map tcpp_to_string argTypes) in + let ret = tcpp_to_string retType in + let suffix = string_of_int (List.length argTypes) in + if ret = "void" then + if List.length argTypes = 0 then "::hx::TObjcBlockVoidVoid" + else "::hx::TObjcBlockVoidArgs" ^ suffix ^ "< " ^ args ^ " >" + else if List.length argTypes = 0 then "::hx::TObjcBlockRetVoid< " ^ ret ^ " >" + else "::hx::TObjcBlockRetArgs" ^ suffix ^ "< " ^ ret ^ "," ^ args ^ " >" + +and tcpp_to_string tcpp = tcpp_to_string_suffix "" tcpp + +and cpp_class_path_of klass params = + match get_meta_string klass.cl_meta Meta.Native with + | Some s -> + let typeParams = + match params with + | [] -> "" + | _ -> "< " ^ String.concat "," (List.map tcpp_to_string params) ^ " >" + in + " " ^ join_class_path_remap klass.cl_path "::" ^ typeParams + | None -> " ::" ^ join_class_path_remap klass.cl_path "::" + +(* Get a string to represent a type. + The "suffix" will be nothing or "_obj", depending if we want the name of the + pointer class or the pointee (_obj class *) +let rec class_string klass suffix params remap = + let type_string = type_string_remap remap in + let join_class_path_remap = if remap then join_class_path_remap else join_class_path in + (match klass.cl_path with + (* Array class *) + | ([],"Array") when is_dynamic_array_param (List.hd params) -> + "cpp::ArrayBase" ^ suffix + (*"cpp::VirtualArray" ^ suffix*) + | ([],"Array") -> (snd klass.cl_path) ^ suffix ^ "< " ^ (String.concat "," + (List.map array_element_type params) ) ^ " >" + (* FastIterator class *) + | (["cpp"],"FastIterator") -> "::cpp::FastIterator" ^ suffix ^ "< " ^ (String.concat "," + (List.map type_string params) ) ^ " >" + | (["cpp"],"Pointer") + | (["cpp"],"ConstPointer") -> + "::cpp::Pointer< " ^ (String.concat "," (List.map type_string params) ) ^ " >" + | (["cpp"],"RawPointer") -> + " " ^ (String.concat "," (List.map type_string params) ) ^ " * " + | (["cpp"],"RawConstPointer") -> + " const " ^ (String.concat "," (List.map type_string params) ) ^ " * " + | (["cpp"],"Function") -> + "::cpp::Function< " ^ (cpp_function_signature_params params) ^ " >" + | _ when is_dynamic_type_param klass.cl_kind -> "Dynamic" + | ([],"#Int") -> "/* # */int" + | (["cpp"],"UInt8") -> "unsigned char" + | ([],"Class") -> "::hx::Class" + | ([],"EnumValue") -> "Dynamic" + | ([],"Null") -> (match params with + | [t] -> + (match follow t with + | TAbstract ({ a_path = [],"Int" },_) + | TAbstract ({ a_path = [],"Float" },_) + | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" + | TAbstract ({ a_path = ["cpp"],"UInt8" },_) -> "Dynamic" + | t when type_has_meta_key Meta.NotNull t -> "Dynamic" + | _ -> "/*NULL*/" ^ (type_string t) ) + | _ -> die "" __LOC__); + (* Objective-C class *) + | path when is_objc_type (TInst(klass,[])) -> + let str = join_class_path_remap klass.cl_path "::" in + if suffix = "_obj" then + str + else if (has_class_flag klass CInterface) then + "id < " ^ str ^ ">" + else + str ^ " *" + (* Native interface - use pointer *) + | _ when (has_class_flag klass CInterface) && is_native_gen_class klass -> + (join_class_path_remap klass.cl_path "::") ^ " *" + (* Normal class *) + | _ when is_native_class klass -> + let class_params = match params with + | [] -> "" + | _ -> "< " ^ (String.concat "," (List.map type_string params)) ^ " >" in + (join_class_path_remap klass.cl_path "::") ^ class_params + | _ -> + let globalNamespace = match get_meta_string klass.cl_meta Meta.Native with + | Some s -> s + | None -> "::" in + globalNamespace ^ (join_class_path_remap klass.cl_path "::") ^ suffix) + +and type_has_meta_key key haxe_type = + match follow haxe_type with + | TInst (klass,_) -> Meta.has key klass.cl_meta + | TType (type_def,_) -> Meta.has key type_def.t_meta + | TEnum (enum_def,_) -> Meta.has key enum_def.e_meta + | _ -> false + +and type_string_suff suffix haxe_type remap = + let type_string = type_string_remap remap in + let join_class_path_remap = if remap then join_class_path_remap else join_class_path in + (match haxe_type with + | TMono r -> (match r.tm_type with None -> "Dynamic" ^ suffix | Some t -> type_string_suff suffix t remap) + | TAbstract ({ a_path = ([],"Void") },[]) -> "Void" + | TAbstract ({ a_path = ([],"Bool") },[]) -> "bool" + | TAbstract ({ a_path = ([],"Float") },[]) -> "Float" + | TAbstract ({ a_path = ([],"Int") },[]) -> "int" + | TAbstract ({ a_path = (["cpp"],"UInt8") },[]) -> "unsigned char" + | TAbstract( { a_path = ([], "EnumValue") }, _ ) -> "Dynamic" + | TAbstract ({ a_path = ([],"Null") }, [t]) -> + (match follow t with + | TAbstract ({ a_path = [],"Int" },_) + | TAbstract ({ a_path = [],"Float" },_) + | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" ^ suffix + | t when type_has_meta_key Meta.NotNull t -> "Dynamic" ^ suffix + | _ -> type_string_suff suffix t remap) + | TEnum (enum,_) -> (cpp_enum_path_of enum) ^ suffix + | TInst (klass,params) -> (class_string klass suffix params remap) + | TType (type_def,params) -> + (match type_def.t_path with + | [] , "Array" -> + (match params with + | [t] when (type_string (follow t) ) = "Dynamic" -> "Dynamic" + | [t] -> "Array< " ^ (type_string (follow t) ) ^ " >" + | _ -> die "" __LOC__) + | ["cpp"] , "FastIterator" -> + (match params with + | [t] -> "::cpp::FastIterator< " ^ (type_string (follow t) ) ^ " >" + | _ -> die "" __LOC__) + | ["cpp"] , "Pointer" + | ["cpp"] , "ConstPointer" -> + (match params with + | [t] -> "::cpp::Pointer< " ^ (type_string (follow t) ) ^ " >" + | _ -> die "" __LOC__) + | ["cpp"] , "RawPointer" -> + (match params with + | [t] -> " " ^ (type_string (follow t) ) ^ " *" + | _ -> die "" __LOC__) + | ["cpp"] , "RawConstPointer" -> + (match params with + | [t] -> "const " ^ (type_string (follow t) ) ^ " *" + | _ -> die "" __LOC__) + | ["cpp"] , "Function" -> + "::cpp::Function< " ^ (cpp_function_signature_params params ) ^ " >" + | _ -> type_string_suff suffix (apply_typedef type_def params) remap + ) + | TFun (args,haxe_type) -> "Dynamic" ^ suffix + | TAnon a -> "Dynamic" + (* + (match !(a.a_status) with + | ClassStatics c -> type_string_suff suffix (TInst (c,List.map snd c.cl_params)) + | EnumStatics e -> type_string_suff suffix (TEnum (e,List.map snd e.e_params)) + | _ -> "Dynamic" ^ suffix ) + *) + | TDynamic haxe_type -> "Dynamic" ^ suffix + | TLazy func -> type_string_suff suffix (lazy_type func) remap + | TAbstract (abs,pl) when abs.a_impl <> None -> + type_string_suff suffix (Abstract.get_underlying_type abs pl) remap + | TAbstract (abs,pl) -> + "::" ^ (join_class_path_remap abs.a_path "::") ^ suffix + ) + +and type_string_remap remap haxe_type = + type_string_suff "" haxe_type remap + +and type_string haxe_type = + type_string_suff "" haxe_type true + +and cpp_enum_path_of enum = + let globalNamespace = + match get_meta_string enum.e_meta Meta.Native with + | Some s -> s + | None -> "::" in + globalNamespace ^ (join_class_path_remap enum.e_path "::") + +and array_element_type haxe_type = + match type_string haxe_type with + | x when cant_be_null haxe_type -> x + | x when is_interface_type (follow haxe_type) -> x + | "::String" -> "::String" + | _ -> "::Dynamic" + +and cpp_function_signature tfun abi = + match follow tfun with + | TFun(args,ret) -> (type_string ret) ^ " " ^ abi ^ "(" ^ (gen_tfun_interface_arg_list args) ^ ")" + | _ -> "void *" + +and cpp_function_signature_params params = match params with + | [t; abi] -> (match follow abi with + | TInst (klass,_) -> cpp_function_signature t (get_meta_string klass.cl_meta Meta.Abi |> Option.default "") + | _ -> print_endline (type_string abi); + die "" __LOC__ ) + | _ -> + print_endline ("Params:" ^ (String.concat "," (List.map type_string params) )); + die "" __LOC__; + +and gen_interface_arg_type_name name opt typ = + let type_str = (type_string typ) in + (* type_str may have already converted Null to Dynamic because of NotNull tag ... *) + (if (opt && (cant_be_null typ) && type_str<>"Dynamic" ) then + "::hx::Null< " ^ type_str ^ " > " + else + type_str ) ^ " " ^ (keyword_remap name) + +and gen_tfun_interface_arg_list args = + String.concat "," (List.map (fun (name,opt,typ) -> gen_interface_arg_type_name name opt typ) args) + +and cant_be_null haxe_type = + is_numeric haxe_type || (type_has_meta_key Meta.NotNull haxe_type ) + +let is_cpp_scalar cpp_type = + match cpp_type with + | TCppScalar(_) -> true + | _ -> false + +let is_cpp_array_implementer cppType = + match cppType with + | TCppInst ({ cl_array_access = Some _ }, _) + | TCppInterface ({ cl_array_access = Some _ }) -> + true + | _ -> false + +let rec cpp_is_struct_access t = + match t with + | TCppFunction _ -> true + | TCppStruct _-> false + | TCppInst (class_def, _) -> Meta.has Meta.StructAccess class_def.cl_meta + | TCppReference (r) -> cpp_is_struct_access r + | _ -> false + +let rec cpp_is_native_array_access t = + match t with + | TCppStruct s -> cpp_is_native_array_access s + | TCppReference s -> cpp_is_native_array_access s + | TCppInst ({ cl_array_access = Some _ } as klass, _) when is_extern_class klass && Meta.has Meta.NativeArrayAccess klass.cl_meta -> true + | _ -> false + +let cpp_is_dynamic_type = function + | TCppDynamic | TCppObject | TCppVariant | TCppWrapped _ | TCppGlobal | TCppNull + | TCppInterface _ + -> true + | _ -> false + +let is_object_element member_type = + match member_type with + | TCppInst (x, _) + | TCppInterface x + -> not (is_extern_class x) + | TCppDynamic + | TCppObject + | TCppObjectPtr + | TCppEnum _ + | TCppString + | TCppFunction _ + | TCppDynamicArray + | TCppObjectArray _ + | TCppWrapped _ + | TCppScalarArray _ + | TCppClass + -> true + | _ -> false + +let cpp_variant_type_of t = match t with + | TCppDynamic + | TCppUnchanged + | TCppObject + | TCppObjectPtr + | TCppReference _ + | TCppStruct _ + | TCppStar _ + | TCppVoid + | TCppFastIterator _ + | TCppDynamicArray + | TCppObjectArray _ + | TCppScalarArray _ + | TCppWrapped _ + | TCppObjC _ + | TCppObjCBlock _ + | TCppRest _ + | TCppInst _ + | TCppInterface _ + | TCppProtocol _ + | TCppCode _ + | TCppClass + | TCppGlobal + | TCppNull + | TCppEnum _ -> TCppDynamic + | TCppString -> TCppString + | TCppFunction _ + | TCppNativePointer _ + | TCppPointer _ + | TCppRawPointer _ + | TCppAutoCast + | TCppVarArg + | TCppVoidStar -> TCppVoidStar + | TCppScalar "Int" + | TCppScalar "bool" + | TCppScalar "Float" -> t + | TCppScalar "::cpp::Int64" -> TCppScalar("Int64") + | TCppScalar "double" + | TCppScalar "float" -> TCppScalar("Float") + | TCppScalar _ -> TCppScalar("int") + | TCppVariant -> TCppVariant + +let cpp_cast_variant_type_of t = match t with + | TCppObjectArray _ + | TCppScalarArray _ + | TCppDynamicArray + | TCppClass + | TCppEnum _ + | TCppInst _ -> t + | _ -> cpp_variant_type_of t + +let enum_getter_type t = + match cpp_variant_type_of t with + | TCppString -> "String" + | TCppScalar "int" -> "Int" + | TCppScalar "bool" -> "Bool" + | TCppScalar x -> x + | _ -> "Object" \ No newline at end of file diff --git a/src/generators/cpp/cppContext.ml b/src/generators/cpp/cppContext.ml new file mode 100644 index 00000000000..958f26f8467 --- /dev/null +++ b/src/generators/cpp/cppContext.ml @@ -0,0 +1,101 @@ +open Extlib_leftovers +open Ast +open Gctx +open Type +open Error +open Globals +open CppAstTools + +(* CPP code generation context *) +(* + ctx_debug_level + 0 = no debug + 1 = function + line debug via macros, which can be activated at cpp compile-time + 2 = include macros for HXCPP_DEBUGGER + 3 = annotate source with additional info about AST and types + 4 = console output at haxe compile-time + + normal = 1 +*) +type context = { + ctx_common : Gctx.t; + mutable ctx_debug_level : int; + (* cached as required *) + mutable ctx_file_info : (string, string) PMap.t ref; + ctx_type_ids : (string, Int32.t) Hashtbl.t; + (* Per file *) + ctx_output : string -> unit; + ctx_writer : CppSourceWriter.source_writer; + ctx_file_id : int ref; + ctx_is_header : bool; + ctx_interface_slot : (string, int) Hashtbl.t ref; + ctx_interface_slot_count : int ref; + (* This is for returning from the child nodes of TSwitch && TTry *) + mutable ctx_real_this_ptr : bool; + mutable ctx_class_member_types : (string, string) Hashtbl.t; +} + +let new_context common_ctx debug file_info member_types = + let null_file = + new CppSourceWriter.source_writer common_ctx ignore ignore (fun () -> ()) + in + let has_def def = Gctx.defined_value_safe common_ctx def <> "" in + let result = + { + ctx_common = common_ctx; + ctx_writer = null_file; + ctx_file_id = ref (-1); + ctx_type_ids = Hashtbl.create 0; + ctx_is_header = false; + ctx_output = null_file#write; + ctx_interface_slot = ref (Hashtbl.create 0); + ctx_interface_slot_count = ref 2; + ctx_debug_level = + (if has_def Define.AnnotateSource then 3 + else if has_def Define.HxcppDebugger then 2 + else debug); + ctx_real_this_ptr = true; + ctx_class_member_types = member_types; + ctx_file_info = file_info; + } + in + result + +let file_context ctx writer debug header = + { + ctx with + ctx_writer = writer; + ctx_output = writer#write; + ctx_is_header = header; + ctx_file_id = ref (-1); + } + +(* todo - is this how it's done? *) + +let pmap_keys pmap = + let key_list = ref [] in + PMap.iter (fun key _ -> key_list := key :: !key_list ) pmap; + !key_list + +let pmap_values pmap = + let value_list = ref [] in + PMap.iter (fun _ value -> value_list := value :: !value_list ) pmap; + !value_list + +(* The Hashtbl structure seems a little odd - but here is a helper function *) +let hash_iterate hash visitor = + let result = ref [] in + Hashtbl.iter (fun key value -> result := (visitor key value) :: !result ) hash; + !result + +let hash_keys hash = + let key_list = ref [] in + Hashtbl.iter (fun key value -> key_list := key :: !key_list ) hash; + !key_list + +let is_gc_element ctx member_type = + Gctx.defined ctx.ctx_common Define.HxcppGcGenerational && (is_object_element member_type) + +let strip_file ctx file = match Gctx.defined ctx Define.AbsolutePath with + | true -> Path.get_full_path file + | false -> ctx.class_paths#relative_path file \ No newline at end of file diff --git a/src/generators/cpp/cppExprUtils.ml b/src/generators/cpp/cppExprUtils.ml new file mode 100644 index 00000000000..4ee8a3f2f3e --- /dev/null +++ b/src/generators/cpp/cppExprUtils.ml @@ -0,0 +1,23 @@ +open Extlib_leftovers +open Ast +open Type +open Error +open Globals + +let rec remove_parens expression = + match expression.eexpr with + | TParenthesis e -> remove_parens e + | TMeta(_,e) -> remove_parens e + | _ -> expression + +let rec remove_parens_cast expression = + match expression.eexpr with + | TParenthesis e -> remove_parens_cast e + | TMeta(_,e) -> remove_parens_cast e + | TCast ( e,None) -> remove_parens_cast e + | _ -> expression + +let is_static_access obj = + match (remove_parens obj).eexpr with + | TTypeExpr _ -> true + | _ -> false \ No newline at end of file diff --git a/src/generators/cpp/cppRetyper.ml b/src/generators/cpp/cppRetyper.ml new file mode 100644 index 00000000000..b04927ed9b2 --- /dev/null +++ b/src/generators/cpp/cppRetyper.ml @@ -0,0 +1,1433 @@ +open Extlib_leftovers +open Ast +open Type +open Error +open Globals +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppContext + +let rec cpp_type_of stack haxe_type = + if List.exists (fast_eq haxe_type) stack then TCppDynamic + else + let stack = haxe_type :: stack in + match haxe_type with + | TMono r -> ( + match r.tm_type with + | None -> TCppDynamic + | Some t -> cpp_type_of stack t) + | TEnum (enum, params) -> TCppEnum enum + | TInst ({ cl_path = [], "Array"; cl_kind = KTypeParameter _ }, _) -> + TCppObject + | TInst ({ cl_kind = KTypeParameter _ }, _) -> TCppDynamic + | TInst (klass, params) -> cpp_instance_type stack klass params + | TAbstract (abs, pl) when not (Meta.has Meta.CoreType abs.a_meta) -> + cpp_type_from_path stack abs.a_path pl (fun () -> + cpp_type_of stack + (Abstract.get_underlying_type ~return_first:true abs pl)) + | TAbstract (a, params) -> + cpp_type_from_path stack a.a_path params (fun () -> + if is_scalar_abstract a then + match get_meta_string a.a_meta Meta.Native with + | Some s -> TCppScalar s + | None -> TCppScalar (join_class_path a.a_path "::") + else TCppDynamic) + | TType (type_def, params) -> + cpp_type_from_path stack type_def.t_path params (fun () -> + cpp_type_of stack (apply_typedef type_def params)) + | TFun _ -> TCppObject + | TAnon _ -> TCppObject + | TDynamic _ -> TCppDynamic + | TLazy func -> cpp_type_of stack (lazy_type func) + +and cpp_type_from_path stack path params default = + match (path, params) with + | ([], "Void"), _ -> TCppVoid + | ([], "void"), _ -> TCppVoid (* for old code with @:void *) + | ([], "Bool"), _ -> TCppScalar "bool" + | ([], "Float"), _ -> TCppScalar "Float" + | ([], "Int"), _ -> TCppScalar "int" + | ([], "EnumValue"), _ -> TCppObject + | ([], "Class"), _ -> TCppClass + | ([], "Enum"), _ -> TCppClass + | ([], "Single"), _ -> TCppScalar "float" + | ([ "cpp" ], "Char"), _ -> TCppScalar "char" + | ([ "cpp" ], "Object"), _ -> TCppObjectPtr + | ([ "cpp" ], "Float32"), _ -> TCppScalar "float" + | ([ "cpp" ], "Float64"), _ -> TCppScalar "double" + | ([ "cpp" ], "Int8"), _ -> TCppScalar "signed char" + | ([ "cpp" ], "Int16"), _ -> TCppScalar "short" + | ([ "cpp" ], "Int32"), _ -> TCppScalar "int" + | ([ "cpp" ], "Int64"), _ -> TCppScalar "::cpp::Int64" + | ([ "cpp" ], "UInt8"), _ -> TCppScalar "unsigned char" + | ([ "cpp" ], "UInt16"), _ -> TCppScalar "unsigned short" + | ([ "cpp" ], "UInt32"), _ -> TCppScalar "unsigned int" + | ([ "cpp" ], "UInt64"), _ -> TCppScalar "::cpp::UInt64" + | ([ "cpp" ], "VarArg"), _ -> TCppVarArg + | ([ "cpp" ], "AutoCast"), _ -> TCppAutoCast + | ([], "String"), [] -> TCppString + (* Things with type parameters hxcpp knows about ... *) + | ([ "cpp" ], "FastIterator"), [ p ] -> TCppFastIterator (cpp_type_of stack p) + | ([ "cpp" ], "Pointer"), [ p ] -> TCppPointer ("Pointer", cpp_type_of stack p) + | ([ "cpp" ], "ConstPointer"), [ p ] -> + TCppPointer ("ConstPointer", cpp_type_of stack p) + | ([ "cpp" ], "RawPointer"), [ p ] -> TCppRawPointer ("", cpp_type_of stack p) + | ([ "cpp" ], "RawConstPointer"), [ p ] -> + TCppRawPointer ("const ", cpp_type_of stack p) + | ([ "cpp" ], "Function"), [ function_type; abi ] -> + cpp_function_type_of stack function_type abi + | ([ "cpp" ], "Callable"), [ function_type ] + | ([ "cpp" ], "CallableData"), [ function_type ] -> + cpp_function_type_of_string stack function_type "" + | ("cpp" :: [ "objc" ], "ObjcBlock"), [ function_type ] -> + let args, ret = cpp_function_type_of_args_ret stack function_type in + TCppObjCBlock (args, ret) + | ([ "cpp" ], "Rest"), [ rest ] -> TCppRest (cpp_type_of stack rest) + | ("cpp" :: [ "objc" ], "Protocol"), [ interface_type ] -> ( + match follow interface_type with + | TInst (klass, []) when has_class_flag klass CInterface -> + TCppProtocol klass + (* TODO - get the line number here *) + | _ -> + print_endline "cpp.objc.Protocol must refer to an interface"; + die "" __LOC__) + | ([ "cpp" ], "Reference"), [ param ] -> + TCppReference (cpp_type_of stack param) + | ([ "cpp" ], "Struct"), [ param ] -> TCppStruct (cpp_type_of stack param) + | ([ "cpp" ], "Star"), [ param ] -> + TCppStar (cpp_type_of_pointer stack param, false) + | ([ "cpp" ], "ConstStar"), [ param ] -> + TCppStar (cpp_type_of_pointer stack param, true) + | ([], "Array"), [ p ] -> ( + let arrayOf = cpp_type_of stack p in + match arrayOf with + | TCppVoid (* ? *) | TCppDynamic -> TCppDynamicArray + | TCppObject | TCppObjectPtr | TCppReference _ | TCppStruct _ | TCppStar _ + | TCppEnum _ | TCppInst _ | TCppInterface _ | TCppProtocol _ | TCppClass + | TCppDynamicArray | TCppObjectArray _ | TCppScalarArray _ -> + TCppObjectArray arrayOf + | _ -> TCppScalarArray arrayOf) + | ([], "Null"), [ p ] -> cpp_type_of_null stack p + | _ -> default () + +and cpp_type_of_null stack p = + let baseType = cpp_type_of stack p in + if type_has_meta_key Meta.NotNull p || is_cpp_scalar baseType then TCppObject + else baseType + +and cpp_type_of_pointer stack p = + match p with + | TAbstract ({ a_path = [], "Null" }, [ t ]) -> cpp_type_of stack t + | x -> cpp_type_of stack x + +(* Optional types are Dynamic if they norally could not be null *) +and cpp_fun_arg_type_of stack tvar opt = + match opt with + | Some _ -> cpp_type_of_null stack tvar.t_type + | _ -> cpp_type_of stack tvar.t_type + +and cpp_tfun_arg_type_of stack opt t = + if opt then cpp_type_of_null stack t else cpp_type_of stack t + +and cpp_function_type_of stack function_type abi = + let abi = + match follow abi with + | TInst (klass1, _) -> + get_meta_string klass1.cl_meta Meta.Abi |> Option.default "" + | _ -> die "" __LOC__ + in + cpp_function_type_of_string stack function_type abi + +and cpp_function_type_of_string stack function_type abi_string = + let args, ret = cpp_function_type_of_args_ret stack function_type in + TCppFunction (args, ret, abi_string) + +and cpp_function_type_of_args_ret stack function_type = + match follow function_type with + | TFun (args, ret) -> + (* Optional types are Dynamic if they norally could not be null *) + let cpp_arg_type_of (_, optional, haxe_type) = + if optional then cpp_type_of_null stack haxe_type + else cpp_type_of stack haxe_type + in + (List.map cpp_arg_type_of args, cpp_type_of stack ret) + | _ -> + (* ? *) + ([ TCppVoid ], TCppVoid) + +and cpp_instance_type stack klass params = + cpp_type_from_path stack klass.cl_path params (fun () -> + if is_objc_class klass then TCppObjC klass + else if has_class_flag klass CInterface && is_native_gen_class klass then + TCppNativePointer klass + else if has_class_flag klass CInterface then TCppInterface klass + else if + has_class_flag klass CExtern && not (is_internal_class klass.cl_path) + then + let tcpp_params = List.map (cpp_type_of stack) params in + TCppInst (klass, tcpp_params) + else + let tcpp_params = List.map (cpp_type_of stack) params in + TCppInst (klass, tcpp_params)) + +let cpp_type_of = cpp_type_of [] +let cpp_type_from_path = cpp_type_from_path [] +let cpp_type_of_null = cpp_type_of_null [] +let cpp_type_of_pointer = cpp_type_of_pointer [] +let cpp_tfun_arg_type_of = cpp_tfun_arg_type_of [] +let cpp_function_type_of = cpp_function_type_of [] +let cpp_function_type_of_string = cpp_function_type_of_string [] +let cpp_function_type_of_args_ret = cpp_function_type_of_args_ret [] +let cpp_instance_type = cpp_instance_type [] + +let expression ctx request_type function_args function_type expression_tree forInjection = + let rev_closures = ref [] in + let closureId = ref 0 in + let declarations = ref (Hashtbl.create 0) in + let undeclared = ref (Hashtbl.create 0) in + let uses_this = ref None in + let gc_stack = ref false in + let injection = ref forInjection in + let this_real = ref (if ctx.ctx_real_this_ptr then ThisReal else ThisDynamic) in + let file_id = ctx.ctx_file_id in + let function_return_type = ref (cpp_type_of function_type) in + let loop_stack = ref [] in + let forCppia = Gctx.defined ctx.ctx_common Define.Cppia in + let alloc_file_id () = + incr file_id; + !file_id + in + let begin_loop () = + loop_stack := (alloc_file_id (), ref false) :: !loop_stack; + fun () -> + match !loop_stack with + | (label_id, used) :: tl -> + loop_stack := tl; + if !used then label_id else -1 + | [] -> abort "Invalid inernal loop handling" expression_tree.epos + in + + (* '__trace' is at the top-level *) + Hashtbl.add !declarations "__trace" (); + List.iter (fun arg -> Hashtbl.add !declarations arg.v_name ()) function_args; + + (* Helper functions *) + + let cpp_const_type cval = + match cval with + | TInt i -> (CppInt i, TCppScalar "int") + | TBool b -> (CppBool b, TCppScalar "bool") + | TFloat f -> (CppFloat (Texpr.replace_separators f ""), TCppScalar "Float") + | TString s -> (CppString s, TCppString) + | _ -> + (* TNull, TThis & TSuper should already be handled *) + (CppNull, TCppNull) + in + + let cpp_return_type haxe_type = + match haxe_type with TFun (_, ret) -> cpp_type_of ret | _ -> TCppDynamic + in + + let cpp_member_return_type member = cpp_return_type member.cf_type in + + let is_cpp_objc_type cpptype = + match cpptype with TCppObjC _ -> true | _ -> false + in + + let cpp_is_real_array obj = + match obj.cpptype with + | TCppScalarArray _ | TCppObjectArray _ -> true + | _ -> false + in + + let rec to_lvalue value = + match value.cppexpr with + | CppVar (VarClosure var as varloc) + when is_gc_element ctx (cpp_type_of var.v_type) -> + (CppVarRef varloc, true) + | CppVar (VarThis (member, _) as varloc) + when is_gc_element ctx (cpp_type_of member.cf_type) -> + (CppVarRef varloc, true) + | CppVar (VarInstance (obj, member, _, "->") as varloc) + when is_gc_element ctx (cpp_type_of member.cf_type) -> + (CppVarRef varloc, true) + | CppVar varloc -> (CppVarRef varloc, false) + | CppArray arrayloc -> + ( CppArrayRef arrayloc, + match arrayloc with + | ArrayObject (arrayObj, index, _) when is_gc_element ctx TCppDynamic + -> + true + | ArrayTyped (arrayObj, index, t) when is_gc_element ctx t -> true + | _ -> false ) + | CppDynamicField (expr, name) -> (CppDynamicRef (expr, name), false) + | CppTCast (cppExpr, _) + | CppCast (cppExpr, _) + | CppCastStatic (cppExpr, _) + | CppCastObjC (cppExpr, _) + | CppCastObjCBlock (cppExpr, _, _) + | CppCastScalar (cppExpr, _) -> + to_lvalue cppExpr + | CppCastVariant cppExpr -> to_lvalue cppExpr + | CppExtern (name, isGlobal) -> (CppExternRef (name, isGlobal), false) + | _ -> + abort + ("Could not convert expression to l-value (" ^ s_tcpp value.cppexpr + ^ ")") + value.cpppos + in + + let is_array_splice_call obj member = + match (obj.cpptype, member.cf_name) with + | TCppScalarArray _, "splice" | TCppObjectArray _, "splice" -> true + | _, _ -> false + in + + let is_map_get_call obj member = + member.cf_name = "get" + && + match obj.cpptype with + | TCppInst ({ cl_path = [ "cpp" ], "Int64Map" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "IntMap" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "StringMap" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "ObjectMap" }, _) -> true + | _ -> false + in + + let is_map_set_call obj member = + member.cf_name = "set" + && + match obj.cpptype with + | TCppInst ({ cl_path = [ "cpp" ], "Int64Map" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "IntMap" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "StringMap" }, _) -> true + | TCppInst ({ cl_path = [ "haxe"; "ds" ], "ObjectMap" }, _) -> true + | _ -> false + in + + let is_array_concat_call obj member = + match (obj.cpptype, member.cf_name) with + | TCppScalarArray _, "concat" | TCppObjectArray _, "concat" -> true + | _, _ -> false + in + + let cpp_can_static_cast funcType inferredType = + match funcType with + | TCppReference _ | TCppStar _ | TCppStruct _ -> false + | _ -> ( + match inferredType with + | TCppInst (cls, _) when is_extern_class cls -> false + | TCppEnum e when is_extern_enum e -> false + | TCppInst _ | TCppClass | TCppEnum _ -> + tcpp_to_string funcType <> tcpp_to_string inferredType + | _ -> false) + in + + let cpp_is_templated_call ctx member = + Meta.has Meta.TemplatedCall member.cf_meta + in + + let is_complex_compare = function + | TCppScalar _ -> false + | TCppString -> false + | _ -> true + in + + let is_pointer_compare = function + | TCppObjectArray _ | TCppScalarArray _ | TCppDynamicArray | TCppClass + | TCppEnum _ -> + true + | _ -> false + in + + let is_instance_compare = function + | TCppInterface _ | TCppInst _ -> true + | _ -> false + in + + let cpp_append_block block expr = + match block.cppexpr with + | CppBlock (expr_list, closures, gc_stack) -> + { + block with + cppexpr = CppBlock (expr_list @ [ expr ], closures, gc_stack); + } + | _ -> abort "Internal error appending expression" block.cpppos + in + + let rec const_int_of expr = + match expr.eexpr with + | TConst TInt x -> x + | TConst TBool x -> Int32.of_int (if x then 1 else 0) + | TParenthesis e -> const_int_of e + | _ -> raise Not_found + in + + (* Core Retyping *) + let rec retype return_type expr = + let cpp_type_of t = cpp_type_of t in + let mk_cppexpr newExpr newType = + { cppexpr = newExpr; cpptype = newType; cpppos = expr.epos } + in + let retype_function_args args arg_types = + let rec map_pair args types result = + match (args, types) with + | args, [ TCppRest rest ] -> + List.rev (List.map (retype rest) args) @ result + | [], [] -> result + | a :: arest, t :: trest -> map_pair arest trest (retype t a :: result) + | _, [] -> abort "Too many args" expr.epos + | [], _ -> abort "Too many types" expr.epos + in + List.rev (map_pair args arg_types []) + in + + let retypedExpr, retypedType = + match expr.eexpr with + | TEnumParameter (enumObj, enumField, enumIndex) -> + let retypedObj = retype TCppDynamic enumObj in + ( CppEnumParameter (retypedObj, enumField, enumIndex), + cpp_cast_variant_type_of + (cpp_type_of (get_nth_type enumField enumIndex)) ) + | TEnumIndex enumObj -> + let retypedObj = retype TCppDynamic enumObj in + (CppEnumIndex retypedObj, TCppScalar "int") + | TConst TThis -> + uses_this := Some !this_real; + ( CppThis !this_real, + if !this_real = ThisDynamic then TCppDynamic + else cpp_type_of expr.etype ) + | TConst TSuper -> + uses_this := Some !this_real; + ( CppSuper !this_real, + if !this_real = ThisDynamic then TCppDynamic + else cpp_type_of expr.etype ) + | TConst TNull when is_objc_type expr.etype -> (CppNil, TCppNull) + | TConst x -> cpp_const_type x + | TIdent "__global__" -> + (* functions/vars will appear to be members of the virtual global object *) + (CppClassOf (([], ""), false), TCppGlobal) + | TLocal tvar -> + let name = tvar.v_name in + if Hashtbl.mem !declarations name then + (*print_endline ("Using existing tvar " ^ tvar.v_name);*) + (CppVar (VarLocal tvar), cpp_type_of tvar.v_type) + else ( + (*print_endline ("Missing tvar " ^ tvar.v_name);*) + Hashtbl.replace !undeclared name tvar; + if has_var_flag tvar VCaptured then + (CppVar (VarClosure tvar), cpp_type_of tvar.v_type) + else (CppExtern (name, false), cpp_type_of tvar.v_type)) + | TIdent name -> (CppExtern (name, false), return_type) + | TBreak -> ( + if forCppia then (CppBreak, TCppVoid) + else + match !loop_stack with + | [] -> (CppBreak, TCppVoid) + | (label_id, used) :: _ -> + used := true; + (CppGoto label_id, TCppVoid)) + | TContinue -> (CppContinue, TCppVoid) + | TThrow e1 -> (CppThrow (retype TCppDynamic e1), TCppVoid) + | TMeta ((Meta.Fixed, _, _), e) -> ( + let cppType = retype return_type e in + match cppType.cppexpr with + | CppObjectDecl (def, false) -> + (CppObjectDecl (def, true), cppType.cpptype) + | _ -> (cppType.cppexpr, cppType.cpptype)) + | TMeta (_, e) | TParenthesis e -> + let cppType = retype return_type e in + (cppType.cppexpr, cppType.cpptype) + | TField (obj, field) -> ( + match field with + | FInstance (clazz, params, member) + | FClosure (Some (clazz, params), member) -> ( + let funcReturn = cpp_member_return_type member in + let clazzType = cpp_instance_type clazz params in + let retypedObj = retype clazzType obj in + let exprType = cpp_type_of member.cf_type in + let is_objc = is_cpp_objc_type retypedObj.cpptype in + + if retypedObj.cpptype = TCppNull then (CppNullAccess, TCppDynamic) + else if + retypedObj.cpptype = TCppDynamic + && not (has_class_flag clazz CInterface) + then + if is_internal_member member.cf_name then + ( CppFunction + (FuncInstance (retypedObj, InstPtr, member), funcReturn), + exprType ) + else (CppDynamicField (retypedObj, member.cf_name), TCppVariant) + else if cpp_is_struct_access retypedObj.cpptype then + match retypedObj.cppexpr with + | CppThis ThisReal -> + (CppVar (VarThis (member, retypedObj.cpptype)), exprType) + | CppSuper this -> + ( CppFunction + ( FuncSuper (this, retypedObj.cpptype, member), + funcReturn ), + exprType ) + | _ -> + if is_var_field member then + ( CppVar + (VarInstance + (retypedObj, member, tcpp_to_string clazzType, ".")), + exprType ) + else + ( CppFunction + ( FuncInstance (retypedObj, InstStruct, member), + funcReturn ), + exprType ) + else if is_var_field member then + let exprType = + match (retypedObj.cpptype, exprType) with + | TCppPointer (_, t), TCppDynamic + | ( TCppRawPointer (_, t), + TCppDynamic + (* the 'type parameter' will show up as Dynamic *) ) -> + t + | _ -> exprType + in + + match retypedObj.cppexpr with + | CppThis ThisReal -> + (CppVar (VarThis (member, retypedObj.cpptype)), exprType) + | _ -> ( + match (retypedObj.cpptype, member.cf_name) with + (* Special variable remapping ... *) + | TCppDynamicArray, "length" when not forCppia -> + ( CppCall + (FuncInternal (retypedObj, "get_length", "->"), []), + exprType ) + | TCppInterface _, _ | TCppDynamic, _ -> + ( CppDynamicField (retypedObj, member.cf_name), + TCppVariant ) + | TCppObjC _, _ -> + ( CppVar + (VarInstance + ( retypedObj, + member, + tcpp_to_string clazzType, + "." )), + exprType ) + | _ -> + let operator = + if + cpp_is_struct_access retypedObj.cpptype + || retypedObj.cpptype = TCppString + then "." + else "->" + in + ( CppVar + (VarInstance + ( retypedObj, + member, + tcpp_to_string clazzType, + operator )), + exprType )) + else if + has_class_flag clazz CInterface + && not is_objc (* Use instance call for objc interfaces *) + then + ( CppFunction + (FuncInterface (retypedObj, clazz, member), funcReturn), + exprType ) + else + let isArrayObj = + match retypedObj.cpptype with + | TCppDynamicArray | TCppObjectArray _ | TCppScalarArray _ -> + true + | _ -> false + in + (* Special array return values *) + let funcReturn = + if isArrayObj then + match member.cf_name with + | "map" -> TCppDynamicArray + | "splice" | "slice" | "concat" | "copy" | "filter" -> + retypedObj.cpptype + | _ -> funcReturn + else + match (retypedObj.cpptype, funcReturn) with + | TCppPointer (_, t), TCppDynamic + | ( TCppRawPointer (_, t), + TCppDynamic + (* the 'type parameter' will show up as Dynamic *) ) -> + t + | _ -> funcReturn + in + match retypedObj.cppexpr with + | CppThis ThisReal -> + ( CppFunction + (FuncThis (member, retypedObj.cpptype), funcReturn), + exprType ) + | CppSuper this -> + ( CppFunction + ( FuncSuper (this, retypedObj.cpptype, member), + funcReturn ), + exprType ) + | _ -> + ( CppFunction + ( FuncInstance + ( retypedObj, + (if is_objc then InstObjC else InstPtr), + member ), + funcReturn ), + exprType )) + | FStatic (_, ({ cf_name = "nativeFromStaticFunction" } as member)) -> + let funcReturn = cpp_member_return_type member in + let exprType = cpp_type_of member.cf_type in + (CppFunction (FuncFromStaticFunction, funcReturn), exprType) + | FStatic (clazz, member) -> + let funcReturn = cpp_member_return_type member in + let exprType = cpp_type_of member.cf_type in + let objC = is_objc_class clazz in + if is_var_field member then + (CppVar (VarStatic (clazz, objC, member)), exprType) + else + ( CppFunction (FuncStatic (clazz, objC, member), funcReturn), + exprType ) + | FClosure (None, field) | FAnon field -> + let obj = retype TCppDynamic obj in + let fieldName = field.cf_name in + if obj.cpptype = TCppGlobal then + (CppExtern (fieldName, true), cpp_type_of expr.etype) + else if obj.cpptype = TCppNull then (CppNullAccess, TCppDynamic) + else if is_internal_member fieldName then + let cppType = cpp_return_type expr.etype in + if obj.cpptype = TCppString then + ( CppFunction (FuncInternal (obj, fieldName, "."), cppType), + cppType ) + else + ( CppFunction (FuncInternal (obj, fieldName, "->"), cppType), + cppType ) + else (CppDynamicField (obj, field.cf_name), TCppVariant) + | FDynamic fieldName -> + let obj = retype TCppDynamic obj in + if obj.cpptype = TCppNull then (CppNullAccess, TCppDynamic) + else if fieldName = "cca" && obj.cpptype = TCppString then + ( CppFunction (FuncInternal (obj, "cca", "."), TCppScalar "int"), + TCppDynamic ) + else if fieldName = "__s" && obj.cpptype = TCppString then + ( CppVar (VarInternal (obj, ".", "utf8_str()")), + TCppRawPointer ("const ", TCppScalar "char") ) + else if fieldName = "__Index" then + (CppEnumIndex obj, TCppScalar "int") + else if is_internal_member fieldName || cpp_is_real_array obj then + let cppType = cpp_return_type expr.etype in + if obj.cpptype = TCppString then + ( CppFunction (FuncInternal (obj, fieldName, "."), cppType), + cppType ) + else + ( CppFunction (FuncInternal (obj, fieldName, "->"), cppType), + cppType ) + else if obj.cpptype = TCppGlobal then + (CppExtern (fieldName, true), cpp_type_of expr.etype) + else if obj.cpptype = TCppClass then + match obj.cppexpr with + | CppClassOf (path, _) -> + ( CppExtern + ( join_class_path_remap path "::" ^ "_obj::" ^ fieldName, + true ), + cpp_type_of expr.etype ) + | _ -> + ( CppVar (VarInternal (obj, "->", fieldName)), + cpp_type_of expr.etype ) + else (CppDynamicField (obj, fieldName), TCppVariant) + | FEnum (enum, enum_field) -> + (CppEnumField (enum, enum_field), TCppEnum enum)) + | TCall ({ eexpr = TIdent "__cpp__" }, arg_list) -> + let cppExpr = + match arg_list with + | [ { eexpr = TConst (TString code) } ] -> CppCode (code, []) + | { eexpr = TConst (TString code) } :: remaining -> + let retypedArgs = + List.map + (fun arg -> retype (TCppCode (cpp_type_of arg.etype)) arg) + remaining + in + CppCode (code, retypedArgs) + | _ -> abort "__cpp__'s first argument must be a string" expr.epos + in + (cppExpr, TCppCode (cpp_type_of expr.etype)) + | TCall (func, args) -> ( + let retypedFunc = retype TCppUnchanged func in + match retypedFunc.cpptype with + | TCppNull -> (CppNullAccess, TCppDynamic) + | TCppFunction (argTypes, retType, _) -> + let retypedArgs = retype_function_args args argTypes in + (CppCall (FuncExpression retypedFunc, retypedArgs), retType) + | TCppObjCBlock (argTypes, retType) -> + let retypedArgs = retype_function_args args argTypes in + (CppCall (FuncExpression retypedFunc, retypedArgs), retType) + | _ -> ( + let cppType = cpp_type_of expr.etype in + match retypedFunc.cppexpr with + | CppFunction (FuncFromStaticFunction, returnType) -> ( + let retypedArgs = List.map (retype TCppDynamic) args in + match retypedArgs with + | [ + { + cppexpr = + CppFunction + (FuncStatic (clazz, false, member), funcReturn); + }; + ] -> + (CppFunctionAddress (clazz, member), funcReturn) + | _ -> + abort + "cpp.Function.fromStaticFunction must be called on \ + static function" + expr.epos) + | CppEnumIndex _ -> + (* Not actually a TCall...*) + (retypedFunc.cppexpr, retypedFunc.cpptype) + | CppFunction (FuncInstance (obj, InstPtr, member), _) + when (not forCppia) && return_type = TCppVoid + && is_array_splice_call obj member -> + let retypedArgs = List.map (retype TCppDynamic) args in + ( CppCall + ( FuncInstance + (obj, InstPtr, { member with cf_name = "removeRange" }), + retypedArgs ), + TCppVoid ) + | CppFunction (FuncInstance (obj, InstPtr, member), _) + when is_array_concat_call obj member -> + let retypedArgs = List.map (retype obj.cpptype) args in + ( CppCall (FuncInstance (obj, InstPtr, member), retypedArgs), + return_type ) + | CppFunction (FuncStatic (obj, false, member), _) + when member.cf_name = "::hx::AddressOf" -> + let arg = retype TCppUnchanged (List.hd args) in + let rawType = + match arg.cpptype with TCppReference x -> x | x -> x + in + (CppAddressOf arg, TCppRawPointer ("", rawType)) + | CppFunction (FuncStatic (obj, false, member), _) + when member.cf_name = "::hx::StarOf" -> + let arg = retype TCppUnchanged (List.hd args) in + let rawType = + match arg.cpptype with TCppReference x -> x | x -> x + in + (CppAddressOf arg, TCppStar (rawType, false)) + | CppFunction (FuncStatic (obj, false, member), _) + when member.cf_name = "::hx::Dereference" -> + let arg = retype TCppUnchanged (List.hd args) in + let rawType = + match arg.cpptype with TCppStar (x, _) -> x | x -> x + in + (CppDereference arg, TCppReference rawType) + | CppFunction (FuncStatic (obj, false, member), _) + when member.cf_name = "_hx_create_array_length" -> ( + let retypedArgs = List.map (retype TCppDynamic) args in + (* gc_stack - not needed yet *) + match return_type with + | TCppObjectArray _ | TCppScalarArray _ -> + (CppCall (FuncNew return_type, retypedArgs), return_type) + | _ -> + ( CppCall (FuncNew TCppDynamicArray, retypedArgs), + return_type )) + | CppFunction (FuncStatic (obj, false, member), returnType) + when cpp_is_templated_call ctx member -> ( + let retypedArgs = List.map (retype TCppDynamic) args in + match retypedArgs with + | { cppexpr = CppClassOf (path, native) } :: rest -> + ( CppCall (FuncTemplate (obj, member, path, native), rest), + returnType ) + | _ -> + abort + "First parameter of template function must be a Class" + retypedFunc.cpppos) + | CppFunction (FuncInstance (obj, InstPtr, member), _) + when is_map_get_call obj member -> + let retypedArgs = List.map (retype TCppDynamic) args in + let fname, cppType = + match return_type with + | TCppVoid | TCppScalar "bool" -> + ( (if forCppia then "getBool" else "get_bool"), + return_type ) + | TCppScalar "int" -> + ((if forCppia then "getInt" else "get_int"), return_type) + | TCppScalar "::cpp::Int64" -> + ( (if forCppia then "getInt64" else "get_int64"), + return_type ) + | TCppScalar "Float" -> + ( (if forCppia then "getFloat" else "get_float"), + return_type ) + | TCppString -> + ( (if forCppia then "getString" else "get_string"), + return_type ) + | _ -> ("get", TCppDynamic) + in + let func = + FuncInstance (obj, InstPtr, { member with cf_name = fname }) + in + (* + if cpp_can_static_cast cppType return_type then begin + let call = mk_cppexpr (CppCall(func,retypedArgs)) cppType in + CppCastStatic(call, cppType), cppType + end else + *) + (CppCall (func, retypedArgs), cppType) + | CppFunction (FuncInstance (obj, InstPtr, member), _) + when forCppia && is_map_set_call obj member -> + let retypedArgs = List.map (retype TCppDynamic) args in + let fname = + match retypedArgs with + | [ _; { cpptype = TCppScalar "bool" } ] -> "setBool" + | [ _; { cpptype = TCppScalar "int" } ] -> "setInt" + | [ _; { cpptype = TCppScalar "::cpp::Int64" } ] -> + "setInt64" + | [ _; { cpptype = TCppScalar "Float" } ] -> "setFloat" + | [ _; { cpptype = TCppString } ] -> "setString" + | _ -> "set" + in + let func = + FuncInstance (obj, InstPtr, { member with cf_name = fname }) + in + (CppCall (func, retypedArgs), cppType) + | CppFunction + ((FuncInstance (obj, InstPtr, member) as func), returnType) + when cpp_can_static_cast returnType cppType -> + let retypedArgs = List.map (retype TCppDynamic) args in + let call = + mk_cppexpr (CppCall (func, retypedArgs)) returnType + in + (CppCastStatic (call, cppType), cppType) + (* + let error_printer file line = Printf.sprintf "%s:%d:" file line in + let epos = Lexer.get_error_pos error_printer expr.epos in + print_endline ( "fixed override " ^ member.cf_name ^ " @ " ^ epos ^ " " ^ (tcpp_to_string returnType) ^ "->" ^ (ctx_type_string ctx expr.etype) ); + CppCall(func,retypedArgs), returnType + *) + (* Other functions ... *) + | CppFunction + ( (FuncInstance + (_, InstStruct, { cf_type = TFun (arg_types, _) }) as + func), + return_type ) -> + (* For struct access classes use the types of the arguments instead of the function argument types *) + (* In the case of generic extern classes a TFun arg type could be `MyClass.T` instead of the real type *) + let map_args func_arg passed_arg = + let name, opt, _ = func_arg in + (name, opt, passed_arg.etype) + in + let real_types = List.map2 map_args arg_types args in + let arg_types = + List.map + (fun (_, opt, t) -> cpp_tfun_arg_type_of opt t) + real_types + in + let retypedArgs = retype_function_args args arg_types in + (CppCall (func, retypedArgs), return_type) + | CppFunction + ( (FuncInstance (_, _, { cf_type = TFun (arg_types, _) }) as + func), + returnType ) + | CppFunction + ( (FuncStatic (_, _, { cf_type = TFun (arg_types, _) }) as func), + returnType ) + | CppFunction + ( (FuncThis ({ cf_type = TFun (arg_types, _) }, _) as func), + returnType ) -> + let arg_types = + List.map + (fun (_, opt, t) -> cpp_tfun_arg_type_of opt t) + arg_types + in + (* retype args specifically (not just CppDynamic) *) + let retypedArgs = retype_function_args args arg_types in + (CppCall (func, retypedArgs), returnType) + | CppFunction (func, returnType) -> + let retypedArgs = List.map (retype TCppDynamic) args in + (CppCall (func, retypedArgs), returnType) + | CppEnumField (enum, field) -> + (* TODO - proper re-typing *) + let retypedArgs = List.map (retype TCppDynamic) args in + ( CppCall (FuncEnumConstruct (enum, field), retypedArgs), + cppType ) + | CppSuper _ -> + (* TODO - proper re-typing *) + let retypedArgs = List.map (retype TCppDynamic) args in + ( CppCall (FuncSuperConstruct retypedFunc.cpptype, retypedArgs), + TCppVoid ) + | CppDynamicField (expr, name) -> ( + let retypedArgs = List.map (retype TCppDynamic) args in + (* Special function calls *) + match (expr.cpptype, name) with + | TCppGlobal, _ -> + let retypedArgs = List.map (retype TCppUnchanged) args in + (CppCall (FuncExtern (name, true), retypedArgs), cppType) + | TCppString, _ -> + ( CppCall (FuncInternal (expr, name, "."), retypedArgs), + cppType ) + | _, "__Tag" -> + ( CppCall + (FuncInternal (expr, "_hx_getTag", "->"), retypedArgs), + cppType ) + | _, name when is_internal_member name -> + ( CppCall (FuncInternal (expr, name, "->"), retypedArgs), + cppType ) + | _ -> + (* not special *) + ( CppCall (FuncExpression retypedFunc, retypedArgs), + TCppDynamic )) + | CppExtern (name, isGlobal) -> + let retypedArgs = List.map (retype TCppUnchanged) args in + (CppCall (FuncExtern (name, isGlobal), retypedArgs), cppType) + | _ -> + let retypedArgs = List.map (retype TCppDynamic) args in + ( CppCall (FuncExpression retypedFunc, retypedArgs), + TCppDynamic ))) + | TNew (class_def, params, args) -> + let constructor_type = + match + OverloadResolution.maybe_resolve_constructor_overload class_def + params args + with + | None -> abort "Could not find overload" expr.epos + | Some (_, constructor, _) -> constructor.cf_type + in + let arg_types, _ = cpp_function_type_of_args_ret constructor_type in + let retypedArgs = retype_function_args args arg_types in + let created_type = cpp_type_of expr.etype in + (gc_stack := + !gc_stack + || + match created_type with + | TCppInst (t, _) -> not (is_native_class t) + | _ -> false); + (CppCall (FuncNew created_type, retypedArgs), created_type) + | TFunction func -> + let old_this_real = !this_real in + this_real := ThisFake; + (* TODO - this_dynamic ? *) + let old_undeclared = Hashtbl.copy !undeclared in + let old_declarations = Hashtbl.copy !declarations in + let old_uses_this = !uses_this in + let old_gc_stack = !gc_stack in + let old_return_type = !function_return_type in + let ret = cpp_type_of func.tf_type in + function_return_type := ret; + uses_this := None; + undeclared := Hashtbl.create 0; + declarations := Hashtbl.create 0; + List.iter + (fun (tvar, _) -> Hashtbl.add !declarations tvar.v_name ()) + func.tf_args; + let cppExpr = retype TCppVoid (mk_block func.tf_expr) in + let result = + { + close_expr = cppExpr; + close_id = !closureId; + close_undeclared = !undeclared; + close_type = ret; + close_args = func.tf_args; + close_this = !uses_this; + } + in + incr closureId; + declarations := old_declarations; + undeclared := old_undeclared; + Hashtbl.iter + (fun name tvar -> + if not (Hashtbl.mem !declarations name) then + Hashtbl.replace !undeclared name tvar) + result.close_undeclared; + function_return_type := old_return_type; + this_real := old_this_real; + uses_this := + if !uses_this != None then Some old_this_real else old_uses_this; + gc_stack := old_gc_stack; + rev_closures := result :: !rev_closures; + (CppClosure result, TCppDynamic) + | TArray (e1, e2) -> + let arrayExpr, elemType = + match cpp_is_native_array_access (cpp_type_of e1.etype) with + | true -> + let retypedObj = retype TCppUnchanged e1 in + let retypedIdx = retype (TCppScalar "int") e2 in + ( CppArray (ArrayRawPointer (retypedObj, retypedIdx)), + cpp_type_of expr.etype ) + | false -> ( + let retypedObj = retype TCppDynamic e1 in + let retypedIdx = retype (TCppScalar "int") e2 in + match retypedObj.cpptype with + | TCppScalarArray scalar -> + ( CppArray (ArrayTyped (retypedObj, retypedIdx, scalar)), + scalar ) + | TCppPointer (_, elem) -> + (CppArray (ArrayPointer (retypedObj, retypedIdx)), elem) + | TCppRawPointer (_, elem) -> + (CppArray (ArrayRawPointer (retypedObj, retypedIdx)), elem) + | TCppObjectArray TCppDynamic -> + ( CppArray + (ArrayObject (retypedObj, retypedIdx, TCppDynamic)), + TCppDynamic ) + | TCppObjectArray elem -> + (CppArray (ArrayObject (retypedObj, retypedIdx, elem)), elem) + | TCppInst (({ cl_array_access = Some _ } as klass), _) -> + ( CppArray (ArrayImplements (klass, retypedObj, retypedIdx)), + cpp_type_of expr.etype ) + | TCppDynamicArray -> + ( CppArray (ArrayVirtual (retypedObj, retypedIdx)), + TCppDynamic ) + | _ -> + ( CppArray (ArrayDynamic (retypedObj, retypedIdx)), + TCppDynamic )) + in + let returnType = cpp_type_of expr.etype in + if cpp_can_static_cast elemType returnType then + ( CppCastStatic (mk_cppexpr arrayExpr returnType, returnType), + returnType ) + else (arrayExpr, elemType) + | TTypeExpr module_type -> + (* If we try and use the coreType / runtimeValue cpp.Int64 abstract with Class then we get a class decl of the abstract *) + (* as that abstract has functions in its declaration *) + (* Intercept it and replace it with the path of the actual int64 type so the generated cpp is correct *) + let path = + match module_type with + | TClassDecl { cl_path = [ "cpp"; "_Int64" ], "Int64_Impl_" } -> + ([ "cpp" ], "Int64") + | _ -> t_path module_type + in + (CppClassOf (path, is_native_gen_module module_type), TCppClass) + | TBinop (op, left, right) -> ( + let binOpType = + match op with + | OpDiv -> TCppScalar "Float" + | OpBoolAnd | OpBoolOr -> TCppScalar "bool" + | OpAnd | OpOr | OpXor | OpShl | OpShr | OpUShr -> TCppScalar "int" + | OpAssign -> (retype TCppUnchanged left).cpptype + | OpMult | OpSub -> cpp_type_of expr.etype + | _ -> TCppUnchanged + in + let e1 = retype binOpType left in + let e2 = retype binOpType right in + + let complex = + is_complex_compare e1.cpptype || is_complex_compare e2.cpptype + in + let pointer = + is_pointer_compare e1.cpptype || is_pointer_compare e2.cpptype + in + let instance = + is_instance_compare e1.cpptype || is_instance_compare e2.cpptype + in + let e1_null = e1.cpptype = TCppNull in + let e2_null = e2.cpptype = TCppNull in + let reference = + match op with + | OpAssign -> + let lvalue, gc = to_lvalue e1 in + if gc then gc_stack := true; + CppSet (lvalue, e2) + | OpAssignOp op -> + let lvalue, gc = to_lvalue e1 in + if gc then gc_stack := true; + CppModify (op, lvalue, e2) + | OpEq when e1_null && e2_null -> CppBool true + | OpGte when e1_null && e2_null -> CppBool true + | OpLte when e1_null && e2_null -> CppBool true + | OpNotEq when e1_null && e2_null -> CppBool false + | _ when e1_null && e2_null -> CppBool false + | OpEq when e1_null -> CppNullCompare ("IsNull", e2) + | OpGte when e1_null -> CppNullCompare ("IsNull", e2) + | OpLte when e1_null -> CppNullCompare ("IsNull", e2) + | OpNotEq when e1_null -> CppNullCompare ("IsNotNull", e2) + | OpEq when e2_null -> CppNullCompare ("IsNull", e1) + | OpGte when e2_null -> CppNullCompare ("IsNull", e1) + | OpLte when e2_null -> CppNullCompare ("IsNull", e1) + | OpNotEq when e2_null -> CppNullCompare ("IsNotNull", e1) + | OpEq when instance -> CppCompare ("IsInstanceEq", e1, e2, op) + | OpNotEq when instance -> CppCompare ("IsInstanceNotEq", e1, e2, op) + | OpEq when pointer -> CppCompare ("IsPointerEq", e1, e2, op) + | OpNotEq when pointer -> CppCompare ("IsPointerNotEq", e1, e2, op) + | OpEq when complex -> CppCompare ("IsEq", e1, e2, op) + | OpNotEq when complex -> CppCompare ("IsNotEq", e1, e2, op) + | OpGte when complex -> CppCompare ("IsGreaterEq", e1, e2, op) + | OpLte when complex -> CppCompare ("IsLessEq", e1, e2, op) + | OpGt when complex -> CppCompare ("IsGreater", e1, e2, op) + | OpLt when complex -> CppCompare ("IsLess", e1, e2, op) + | _ -> CppBinop (op, e1, e2) + in + match (op, e1.cpptype, e2.cpptype) with + (* Variant + Variant = Variant *) + | OpAdd, _, TCppVariant | OpAdd, TCppVariant, _ -> + (reference, TCppVariant) + | _, _, _ -> (reference, cpp_type_of expr.etype)) + | TUnop (op, pre, e1) -> + let targetType = + match op with + | Not -> TCppScalar "bool" + | NegBits -> TCppScalar "int" + | _ -> cpp_type_of e1.etype + in + + let e1 = retype targetType e1 in + let reference = + match op with + | Increment -> + let lvalue, gc = to_lvalue e1 in + if gc then gc_stack := true; + CppCrement (CppIncrement, pre, lvalue) + | Decrement -> + let lvalue, gc = to_lvalue e1 in + if gc then gc_stack := true; + CppCrement (CppDecrement, pre, lvalue) + | Neg -> CppUnop (CppNeg, e1) + | Not -> CppUnop (CppNot, e1) + | NegBits -> CppUnop (CppNegBits, e1) + | Spread -> die ~p:expr.epos "Unexpected spread operator" __LOC__ + in + (reference, cpp_type_of expr.etype) + | TFor (v, init, block) -> + let old_declarations = Hashtbl.copy !declarations in + Hashtbl.add !declarations v.v_name (); + let init = retype (cpp_type_of v.v_type) init in + let block = retype TCppVoid (mk_block block) in + declarations := old_declarations; + (CppFor (v, init, block), TCppVoid) + | TWhile (e1, e2, flag) -> + let condition = retype (TCppScalar "bool") e1 in + let close = begin_loop () in + let block = retype TCppVoid (mk_block e2) in + (CppWhile (condition, block, flag, close ()), TCppVoid) + | TArrayDecl el -> + let retypedEls = List.map (retype TCppDynamic) el in + (CppArrayDecl retypedEls, cpp_type_of expr.etype) + | TBlock expr_list -> + let inject = !injection in + injection := false; + if return_type <> TCppVoid && not forCppia then + print_endline + ("Value from a block not handled " ^ expr.epos.pfile ^ " " + ^ string_of_int (Lexer.get_error_line expr.epos)); + + let old_declarations = Hashtbl.copy !declarations in + let old_closures = !rev_closures in + rev_closures := []; + let local_closures = ref [] in + let remaining = ref (List.length expr_list) in + let cppExprs = + List.map + (fun expr -> + let targetType = + if inject && !remaining = 1 then cpp_type_of expr.etype + else TCppVoid + in + decr remaining; + let result = retype targetType expr in + local_closures := !rev_closures @ !local_closures; + rev_closures := []; + result) + expr_list + in + declarations := old_declarations; + rev_closures := old_closures; + + (CppBlock (cppExprs, List.rev !local_closures, !gc_stack), TCppVoid) + | TObjectDecl + [ + (("fileName", _, _), { eexpr = TConst (TString file) }); + (("lineNumber", _, _), { eexpr = TConst (TInt line) }); + (("className", _, _), { eexpr = TConst (TString class_name) }); + (("methodName", _, _), { eexpr = TConst (TString meth) }); + ] -> + (CppPosition (file, line, class_name, meth), TCppDynamic) + | TObjectDecl el -> ( + let retypedEls = + List.map (fun ((v, _, _), e) -> (v, retype TCppDynamic e)) el + in + match return_type with + | TCppVoid -> (CppObjectDecl (retypedEls, false), TCppVoid) + | _ -> (CppObjectDecl (retypedEls, false), TCppDynamic)) + | TVar (v, eo) -> + let varType = cpp_type_of v.v_type in + let init = + match eo with None -> None | Some e -> Some (retype varType e) + in + Hashtbl.add !declarations v.v_name (); + (CppVarDecl (v, init), varType) + | TIf (ec, e1, e2) -> + let ec = retype (TCppScalar "bool") ec in + let blockify = + if return_type != TCppVoid then fun e -> e else mk_block + in + let e1 = retype return_type (blockify e1) in + let e2 = + match e2 with + | None -> None + | Some e -> Some (retype return_type (blockify e)) + in + ( CppIf (ec, e1, e2), + if return_type = TCppVoid then TCppVoid else cpp_type_of expr.etype + ) + (* Switch internal return - wrap whole thing in block *) + | TSwitch + { + switch_subject = condition; + switch_cases = cases; + switch_default = def; + } -> ( + if return_type <> TCppVoid then + abort "Value from a switch not handled" expr.epos; + + let conditionType = cpp_type_of condition.etype in + let condition = retype conditionType condition in + let cppDef = + match def with + | None -> None + | Some e -> Some (retype TCppVoid (mk_block e)) + in + if forCppia then + let cases = + List.map + (fun { case_patterns = el; case_expr = e2 } -> + let cppBlock = retype TCppVoid (mk_block e2) in + (List.map (retype conditionType) el, cppBlock)) + cases + in + (CppSwitch (condition, conditionType, cases, cppDef, -1), TCppVoid) + else + try + (match conditionType with + | TCppScalar "int" | TCppScalar "bool" -> () + | _ -> raise Not_found); + let cases = + List.map + (fun { case_patterns = el; case_expr = e2 } -> + (List.map const_int_of el, retype TCppVoid (mk_block e2))) + cases + in + (CppIntSwitch (condition, cases, cppDef), TCppVoid) + with Not_found -> + let label = alloc_file_id () in + (* do something better maybe ... *) + let cases = + List.map + (fun { case_patterns = el; case_expr = e2 } -> + let cppBlock = retype TCppVoid (mk_block e2) in + let gotoExpr = + { + cppexpr = CppGoto label; + cpptype = TCppVoid; + cpppos = e2.epos; + } + in + let cppBlock = cpp_append_block cppBlock gotoExpr in + (List.map (retype conditionType) el, cppBlock)) + cases + in + ( CppSwitch (condition, conditionType, cases, cppDef, label), + TCppVoid )) + | TTry (try_block, catches) -> + (* TTry internal return - wrap whole thing in block ? *) + if return_type <> TCppVoid then + abort "Value from a try-block not handled" expr.epos; + let cppBlock = retype TCppVoid try_block in + let cppCatches = + List.map + (fun (tvar, catch_block) -> + let old_declarations = Hashtbl.copy !declarations in + Hashtbl.add !declarations tvar.v_name (); + let cppCatchBlock = retype TCppVoid catch_block in + declarations := old_declarations; + (tvar, cppCatchBlock)) + catches + in + (CppTry (cppBlock, cppCatches), TCppVoid) + | TReturn eo -> + ( CppReturn + (match eo with + | None -> None + | Some e -> Some (retype !function_return_type e)), + TCppVoid ) + | TCast (base, None) -> ( + (* Use auto-cast rules *) + let return_type = cpp_type_of expr.etype in + let baseCpp = retype return_type base in + let baseStr = tcpp_to_string baseCpp.cpptype in + let returnStr = tcpp_to_string return_type in + if baseStr = returnStr then + (baseCpp.cppexpr, baseCpp.cpptype (* nothing to do *)) + else + match return_type with + | TCppObjC k -> (CppCastObjC (baseCpp, k), return_type) + | TCppPointer (_, _) + | TCppRawPointer (_, _) + | TCppStar _ | TCppInst _ -> + (CppCast (baseCpp, return_type), return_type) + | TCppString -> (CppCastScalar (baseCpp, "::String"), return_type) + | TCppCode t when baseStr <> tcpp_to_string t -> + (CppCast (baseCpp, t), t) + | TCppNativePointer klass -> (CppCastNative baseCpp, return_type) + | TCppObjCBlock (args, ret) -> + (CppCastObjCBlock (baseCpp, args, ret), return_type) + | TCppProtocol p -> (CppCastProtocol (baseCpp, p), return_type) + | TCppDynamic when baseCpp.cpptype = TCppClass -> + (CppCast (baseCpp, TCppDynamic), TCppDynamic) + | _ -> (baseCpp.cppexpr, baseCpp.cpptype (* use autocasting rules *)) + ) + | TCast (base, Some t) -> ( + let baseCpp = retype (cpp_type_of base.etype) base in + let baseStr = tcpp_to_string baseCpp.cpptype in + let default_return_type = + if return_type = TCppUnchanged then cpp_type_of expr.etype + else return_type + in + let return_type = + cpp_type_from_path (t_path t) [] (fun () -> default_return_type) + in + let returnStr = tcpp_to_string return_type in + + if baseStr = returnStr then + (baseCpp.cppexpr, baseCpp.cpptype (* nothing to do *)) + else + match return_type with + | TCppNativePointer klass -> (CppCastNative baseCpp, return_type) + | TCppVoid -> + (CppTCast (baseCpp, cpp_type_of expr.etype), return_type) + | TCppDynamic -> (baseCpp.cppexpr, baseCpp.cpptype) + | _ -> (CppTCast (baseCpp, return_type), return_type)) + in + let cppExpr = mk_cppexpr retypedExpr retypedType in + + (* Autocast rules... *) + if return_type = TCppVoid then mk_cppexpr retypedExpr TCppVoid + else if return_type = TCppVarArg then + match cpp_variant_type_of cppExpr.cpptype with + | TCppVoidStar | TCppScalar _ -> cppExpr + | TCppString -> + mk_cppexpr + (CppVar (VarInternal (cppExpr, ".", "raw_ptr()"))) + (TCppPointer ("ConstPointer", TCppScalar "char")) + | TCppDynamic -> mk_cppexpr (CppCastNative cppExpr) TCppVoidStar + | _ -> + let toDynamic = + mk_cppexpr (CppCast (cppExpr, TCppDynamic)) TCppDynamic + in + mk_cppexpr (CppCastNative toDynamic) TCppVoidStar + else if + cppExpr.cpptype = TCppVariant + || cppExpr.cpptype = TCppDynamic + || cppExpr.cpptype == TCppObject + then + match return_type with + | TCppUnchanged -> cppExpr + | TCppInst (t, _) when Meta.has Meta.StructAccess t.cl_meta -> + let structType = TCppStruct (TCppInst (t, [])) in + let structCast = + mk_cppexpr (CppCast (cppExpr, structType)) structType + in + mk_cppexpr (CppCast (structCast, TCppInst (t, []))) (TCppInst (t, [])) + | TCppObjectArray _ | TCppScalarArray _ | TCppNativePointer _ + | TCppDynamicArray | TCppObjectPtr | TCppVarArg | TCppInst _ -> + mk_cppexpr (CppCast (cppExpr, return_type)) return_type + | TCppObjC k -> mk_cppexpr (CppCastObjC (cppExpr, k)) return_type + | TCppObjCBlock (ret, args) -> + mk_cppexpr (CppCastObjCBlock (cppExpr, ret, args)) return_type + | TCppScalar scalar -> + mk_cppexpr (CppCastScalar (cppExpr, scalar)) return_type + | TCppString -> + mk_cppexpr (CppCastScalar (cppExpr, "::String")) return_type + | TCppInterface _ when cppExpr.cpptype = TCppVariant -> + mk_cppexpr (CppCastVariant cppExpr) return_type + | TCppDynamic when cppExpr.cpptype = TCppVariant -> + mk_cppexpr (CppCastVariant cppExpr) return_type + | TCppStar (t, const) -> + let ptrType = + TCppPointer ((if const then "ConstPointer" else "Pointer"), t) + in + let ptrCast = mk_cppexpr (CppCast (cppExpr, ptrType)) ptrType in + mk_cppexpr + (CppCast (ptrCast, TCppStar (t, const))) + (TCppStar (t, const)) + | _ -> cppExpr + else + match (cppExpr.cpptype, return_type) with + | _, TCppUnchanged -> cppExpr + (* + Using the 'typedef hack', where we use typedef X = T, allows the + haxe compiler to use these types interchangeably. We then work + out the correct way to convert between them when one is expected, but another provided. + + TCppFunction: these do not really interact with the haxe function type, T + Since they are implemented with cpp::Function, conversion to/from Dynamic should happen automatically + CallableData = T; + FunctionData = T; + + TCppObjCBlock can move in and out of Dyanmic + ObjcBlock = T; + + TCppProtocol can move in and out of Dyanmic, via delegate creation + Protocol = T; + + Explicitly wrapped type - already interacts well with Dynamic and T + Struct = T; + + TCppStar, TCppStruct, TCppReference - for interacting with native code + Star = T; + ConstStar = T; + Reference = T; + T may be an extern class, with @:structAccess - in which case + Dynamic interaction must be handled explicitly + These types, plus Dynamic can be used interchangeably by haxe + Derived/inherited types may also be mixed in + *) + | TCppAutoCast, _ | TCppObjC _, TCppDynamic | TCppObjCBlock _, TCppDynamic + -> + mk_cppexpr (CppCast (cppExpr, return_type)) return_type + (* Infer type from right-hand-side for pointer or reference to Dynamic *) + | TCppReference TCppDynamic, TCppReference _ -> cppExpr + | TCppReference TCppDynamic, t -> mk_cppexpr retypedExpr (TCppReference t) + | TCppStar (TCppDynamic, _), TCppStar (_, _) -> cppExpr + | TCppStar (TCppDynamic, const), t -> + mk_cppexpr retypedExpr (TCppStar (t, const)) + | TCppStar (t, const), TCppDynamic -> + let ptrType = + TCppPointer ((if const then "ConstPointer" else "Pointer"), t) + in + let ptrCast = mk_cppexpr (CppCast (cppExpr, ptrType)) ptrType in + mk_cppexpr (CppCast (ptrCast, TCppDynamic)) TCppDynamic + | TCppStar (t, const), TCppReference _ + | TCppStar (t, const), TCppInst _ + | TCppStar (t, const), TCppStruct _ -> + mk_cppexpr (CppDereference cppExpr) return_type + | TCppInst (t, _), TCppStar _ + when is_native_class t + && + match cppExpr.cppexpr with + | CppCall (FuncNew _, _) -> true + | _ -> false -> + mk_cppexpr (CppNewNative cppExpr) return_type + | TCppInst _, TCppStar (p, const) | TCppStruct _, TCppStar (p, const) -> + mk_cppexpr (CppAddressOf cppExpr) return_type + | TCppObjectPtr, TCppObjectPtr -> cppExpr + | TCppObjectPtr, _ -> + mk_cppexpr (CppCast (cppExpr, TCppDynamic)) TCppDynamic + | TCppProtocol _, TCppProtocol _ -> cppExpr + | t, TCppProtocol protocol -> + mk_cppexpr (CppCastProtocol (cppExpr, protocol)) return_type + | TCppInst (t, _), TCppDynamic when Meta.has Meta.StructAccess t.cl_meta + -> + let structType = TCppStruct (TCppInst (t, [])) in + let structCast = + mk_cppexpr (CppCast (cppExpr, structType)) structType + in + mk_cppexpr (CppCast (structCast, TCppDynamic)) TCppDynamic + | _, TCppObjectPtr -> + mk_cppexpr (CppCast (cppExpr, TCppObjectPtr)) TCppObjectPtr + | TCppDynamicArray, TCppScalarArray _ + | TCppDynamicArray, TCppObjectArray _ + | TCppScalarArray _, TCppDynamicArray + | TCppObjectArray _, TCppDynamicArray + when forCppia -> + mk_cppexpr (CppCast (cppExpr, return_type)) return_type + | TCppScalar from, TCppScalar too when from <> too -> + mk_cppexpr (CppCastScalar (cppExpr, too)) return_type + | _ -> cppExpr + in + retype request_type expression_tree diff --git a/src/generators/cpp/cppSourceWriter.ml b/src/generators/cpp/cppSourceWriter.ml new file mode 100644 index 00000000000..874d63782a5 --- /dev/null +++ b/src/generators/cpp/cppSourceWriter.ml @@ -0,0 +1,188 @@ +open Extlib_leftovers +open Ast +open Gctx +open Type +open Error +open Globals +open CppStrings +open CppAstTools +open CppTypeUtils + +(* + Code for generating source files. + It manages creating diretories, indents, blocks and only modifying files + when the content changes. +*) + +let get_include_prefix common_ctx with_slash = + try + Gctx.defined_value common_ctx Define.IncludePrefix ^ if with_slash then "/" else "" + with Not_found -> "" + +let should_prefix_include = function + | x when is_internal_class x -> false + | [], "hxMath" -> true + | _ -> false + +let verbatim_include file = + match String.sub file 0 1 with + | "@" -> "@import " ^ String.sub file 1 (String.length file - 1) ^ ";\n" + | _ -> "#include \"" ^ file ^ "\"\n" + +let guarded_include file = + let guard_name = "INCLUDED_" ^ hash64 file in + "#ifndef " ^ guard_name ^ "\n" ^ "#define " ^ guard_name ^ "\n" ^ verbatim_include file ^ "#endif\n" + +let source_file_extension common_ctx = + (* no need to -D file_extension if -D objc is defined *) + if Gctx.defined common_ctx Define.Objc then ".mm" + else + try + "." ^ Gctx.defined_value common_ctx Define.FileExtension + with Not_found -> ".cpp" + +class source_writer common_ctx write_header_func write_func close_func = + object (this) + val indent_str = "\t" + val mutable indent = "" + val mutable indents = [] + val mutable just_finished_block = false + val mutable headerLines = Hashtbl.create 0 + + method close = + close_func (); + () + + method write x = + write_func x; + just_finished_block <- false + + method write_h x = + write_header_func x; + () + + method write_h_unique x = + if not (Hashtbl.mem headerLines x) then ( + Hashtbl.add headerLines x (); + this#write_h x) + + method indent_one = this#write indent_str + + method push_indent = + indents <- indent_str :: indents; + indent <- String.concat "" indents + + method pop_indent = + match indents with + | h :: tail -> + indents <- tail; + indent <- String.concat "" indents + | [] -> indent <- "/*?*/" + + method write_i x = this#write (indent ^ x) + method get_indent = indent + + method begin_block = + this#write "{\n"; + this#push_indent + + method end_block = + this#pop_indent; + this#write_i "}\n"; + just_finished_block <- true + + method end_block_line = + this#pop_indent; + this#write_i "}"; + just_finished_block <- true + + method terminate_line = + this#write (if just_finished_block then "" else ";\n") + + method add_big_closures = + this#write_h_unique "#include \n" + + method add_include class_path = + match class_path with + | [ "@verbatim" ], file -> this#write_h_unique (guarded_include file) + | _ -> + let prefix = + if should_prefix_include class_path then "" + else get_include_prefix common_ctx true + in + this#write_h + ("#ifndef INCLUDED_" ^ join_class_path class_path "_" ^ "\n"); + this#write_h + ("#include <" ^ prefix ^ join_class_path class_path "/" ^ ".h>\n"); + this#write_h "#endif\n" + end + +let read_whole_file chan = Std.input_all chan + +(* + The cached_source_writer will not write to the file if it has not changed, + thus allowing the makefile dependencies to work correctly +*) +let cached_source_writer common_ctx filename = + let header = Buffer.create 0 in + let add_header str = Buffer.add_string header str in + let buffer = Buffer.create 0 in + let add_buf str = Buffer.add_string buffer str in + let close () = + Buffer.add_buffer header buffer; + let contents = Buffer.contents header in + let same = + try + let in_file = open_in filename in + let old_contents = read_whole_file in_file in + close_in in_file; + contents = old_contents + with _ -> false + in + if not same then ( + let out_file = open_out filename in + output_string out_file contents; + close_out out_file) + in + new source_writer common_ctx add_header add_buf close + +let new_source_file common_ctx base_dir sub_dir extension class_path = + let include_prefix = get_include_prefix common_ctx true in + let full_dir = + if sub_dir = "include" && include_prefix <> "" then ( + let dir = + match fst class_path with + | [] -> base_dir ^ "/include/" ^ get_include_prefix common_ctx false + | path -> + base_dir ^ "/include/" ^ include_prefix ^ String.concat "/" path + in + Path.mkdir_recursive base_dir + ([ "include"; include_prefix ] @ fst class_path); + dir) + else ( + Path.mkdir_recursive base_dir (sub_dir :: fst class_path); + base_dir ^ "/" ^ sub_dir ^ "/" ^ String.concat "/" (fst class_path)) + in + let file = + cached_source_writer common_ctx (full_dir ^ "/" ^ snd class_path ^ extension) + in + Gctx.map_source_header common_ctx.defines (fun s -> + file#write_h (Printf.sprintf "// %s\n" s)); + file + +let new_cpp_file common_ctx base_dir = + new_source_file common_ctx base_dir "src" (source_file_extension common_ctx) + +let new_header_file common_ctx base_dir = + new_source_file common_ctx base_dir "include" ".h" + +let new_placed_cpp_file common_ctx class_path = + let base_dir = common_ctx.file in + + if (Gctx.defined common_ctx Define.Vcproj ) then begin + Path.mkdir_recursive base_dir ("src"::[]); + cached_source_writer common_ctx + ( base_dir ^ "/src/" ^ ( String.concat "-" (fst class_path) ) ^ "-" ^ + (snd class_path) ^ (source_file_extension common_ctx) ) + end else + new_cpp_file common_ctx common_ctx.file class_path \ No newline at end of file diff --git a/src/generators/cpp/cppStrings.ml b/src/generators/cpp/cppStrings.ml new file mode 100644 index 00000000000..99a8d76ef54 --- /dev/null +++ b/src/generators/cpp/cppStrings.ml @@ -0,0 +1,131 @@ +open Extlib_leftovers +open Globals + +let gen_hash32 seed str = + let h = ref (Int32.of_int seed) in + let cycle = Int32.of_int 223 in + for i = 0 to String.length str - 1 do + h := + Int32.add (Int32.mul !h cycle) + (Int32.of_int (int_of_char (String.unsafe_get str i))) + done; + !h + +let hash64 s = String.sub (Digest.to_hex (Digest.string s)) 0 16 +let gen_hash seed str = Printf.sprintf "0x%08lx" (gen_hash32 seed str) +let gen_hash_small seed str = Printf.sprintf "%08lx" (gen_hash32 seed str) + +let gen_qstring_hash str = + let h = gen_hash32 0 str in + Printf.sprintf "%02lx,%02lx,%02lx,%02lx" + (Int32.shift_right_logical (Int32.shift_left h 24) 24) + (Int32.shift_right_logical (Int32.shift_left h 16) 24) + (Int32.shift_right_logical (Int32.shift_left h 8) 24) + (Int32.shift_right_logical h 24) + +let gen_wqstring_hash str = + let h = gen_hash32 0 str in + Printf.sprintf "%04lx,%04lx" + (Int32.shift_right_logical (Int32.shift_left h 16) 16) + (Int32.shift_right_logical h 16) + +let special_to_hex s = + let l = String.length s in + let b = Buffer.create 0 in + for i = 0 to l - 1 do + match Char.code (String.unsafe_get s i) with + | c when c > 127 || c < 32 -> + Buffer.add_string b (Printf.sprintf "\\x%02x\"\"" c) + | c -> Buffer.add_char b (Char.chr c) + done; + Buffer.contents b + +let strq ctx s = + let has_utf8_chars s = + let result = ref false in + for i = 0 to String.length s - 1 do + result := !result || Char.code (String.unsafe_get s i) > 127 + done; + !result + in + + let gen_str macro gen s = + let rec split s plus = + let escaped = StringHelper.s_escape ~hex:false s in + let hexed = special_to_hex escaped in + if String.length hexed <= 16000 then + plus ^ " HX_CSTRING(\"" ^ hexed ^ "\")" + else + let len = String.length s in + let half = len lsr 1 in + split (String.sub s 0 half) plus + ^ split (String.sub s half (len - half)) "+" + in + let escaped = StringHelper.s_escape ~hex:false s in + let hexed = special_to_hex escaped in + if String.length hexed <= 16000 then + macro ^ "(\"" ^ hexed ^ "\"," ^ gen s ^ ")" + else "(" ^ split s "" ^ ")" + in + + if Gctx.defined ctx Define.HxcppSmartStings && has_utf8_chars s then ( + let b = Buffer.create 0 in + + let add ichar = + match ichar with + | 92 (* \ *) -> Buffer.add_string b "\\\\" + | 39 (* ' *) -> Buffer.add_string b "\\\'" + | 34 -> Buffer.add_string b "\\\"" + | 13 (* \r *) -> Buffer.add_string b "\\r" + | 10 (* \n *) -> Buffer.add_string b "\\n" + | 9 (* \t *) -> Buffer.add_string b "\\t" + | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> + Buffer.add_string b (Printf.sprintf "\\u%04x" c) + | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\U%08x" c) + | c -> Buffer.add_char b (Char.chr c) + in + UTF8.iter (fun c -> add (UCharExt.code c)) s; + "HX_W(u\"" ^ Buffer.contents b ^ "\"," ^ gen_wqstring_hash s ^ ")") + else gen_str "HX_" gen_qstring_hash s + +let escape_command s = + let b = Buffer.create 0 in + String.iter + (fun ch -> + if ch == '"' || ch == '\\' then Buffer.add_string b "\\"; + Buffer.add_char b ch) + s; + Buffer.contents b + +let const_char_star s = + let escaped = StringHelper.s_escape ~hex:false s in + "\"" ^ special_to_hex escaped ^ "\"" + +let make_path_absolute path pos = + try + if (String.sub path 0 2) = "./" then begin + let base = if (Filename.is_relative pos.pfile) then + Filename.concat (Sys.getcwd()) pos.pfile + else + pos.pfile + in + Path.normalize_path (Filename.concat (Filename.dirname base) (String.sub path 2 ((String.length path) -2))) + end else + path + with Invalid_argument _ -> path + +let path_of_string path = + ["@verbatim"], path + +let get_all_meta_string_path meta_list key = + let extract_path pos expr = + match expr with + | Ast.EConst (Ast.String (name, _)), _ -> make_path_absolute name pos + | _ -> "" + in + let extract_meta meta = + match meta with + | k, exprs, pos when k = key -> Some (extract_path pos (List.hd exprs)) + | _ -> None + in + ExtList.List.filter_map extract_meta meta_list \ No newline at end of file diff --git a/src/generators/cpp/cppTypeUtils.ml b/src/generators/cpp/cppTypeUtils.ml new file mode 100644 index 00000000000..d11fcb6712e --- /dev/null +++ b/src/generators/cpp/cppTypeUtils.ml @@ -0,0 +1,357 @@ +(* Various helper functions to run checks on haxe classes and various other ast types *) +(* functions in here operate on standard haxe ast types, not gencpp ast types *) + +open Extlib_leftovers +open Ast +open Type +open Error +open Globals + +let follow = Abstract.follow_with_abstracts + +let is_native_gen_class class_def = + Meta.has Meta.NativeGen class_def.cl_meta || + match class_def.cl_kind with + | KAbstractImpl abstract_def -> Meta.has Meta.NativeGen abstract_def.a_meta + | _ -> false + +let is_native_gen_module = function + | TClassDecl class_def -> is_native_gen_class class_def + | _ -> false + +let is_extern_class class_def = + has_class_flag class_def CExtern || + Meta.has Meta.Extern class_def.cl_meta || + match class_def.cl_kind with + | KAbstractImpl abstract_def -> Meta.has Meta.Extern abstract_def.a_meta + | _ -> false + +let is_extern_enum enum_def = + has_enum_flag enum_def EnExtern || Meta.has Meta.Extern enum_def.e_meta + +(* The internal classes are implemented by the core hxcpp system, so the cpp classes should not be generated *) +let is_internal_class = function + | [], "Int" + | [], "Void" + | [], "String" + | [], "Null" + | [], "Float" + | [], "Array" + | [], "Class" + | [], "Enum" + | [], "Bool" + | [], "Dynamic" + | [], "ArrayAccess" + | [], "Math" + | [], "Single" + | [ "cpp" ], "FastIterator" + | [ "cpp" ], "Pointer" + | [ "cpp" ], "ConstPointer" + | [ "cpp" ], "RawPointer" + | [ "cpp" ], "RawConstPointer" + | [ "cpp" ], "Function" + | [ "cpp" ], "VirtualArray" + | [ "cpp" ], "Int8" + | [ "cpp" ], "UInt8" + | [ "cpp" ], "Char" + | [ "cpp" ], "Int16" + | [ "cpp" ], "UInt16" + | [ "cpp" ], "Int32" + | [ "cpp" ], "UInt32" + | [ "cpp" ], "Int64" + | [ "cpp" ], "UInt64" + | [ "cpp" ], "Float32" + | [ "cpp" ], "Float64" -> + true + | _ -> + false + +let is_native_class class_def = + (is_extern_class class_def || is_native_gen_class class_def) && not (is_internal_class class_def.cl_path) + +let is_interface_type t = + match follow t with + | TInst (klass,params) -> (has_class_flag klass CInterface) + | _ -> false + +let rec is_objc_type t = + match t with + | TInst(cl,_) -> (has_class_flag cl CExtern) && Meta.has Meta.Objc cl.cl_meta + | TType(td,_) -> (Meta.has Meta.Objc td.t_meta) + | TAbstract (a,_) -> (Meta.has Meta.Objc a.a_meta) + | TMono r -> (match r.tm_type with | Some t -> is_objc_type t | _ -> false) + | TLazy f -> is_objc_type (lazy_type f) + | _ -> false + +let is_objc_type t = + match t with + | TInst(cl,_) -> (has_class_flag cl CExtern) && Meta.has Meta.Objc cl.cl_meta + | TType(td,_) -> (Meta.has Meta.Objc td.t_meta) + | TAbstract (a,_) -> (Meta.has Meta.Objc a.a_meta) + | TMono r -> (match r.tm_type with | Some t -> is_objc_type t | _ -> false) + | TLazy f -> is_objc_type (lazy_type f) + | _ -> false + +let is_dynamic_type_param class_kind = + match class_kind with + | KTypeParameter _ -> true + | _ -> false + +let is_dynamic_array_param t = + match follow t with + | TAbstract ({ a_path = ([],"Dynamic") },[]) -> true + | TInst (klass, params) -> + (match klass with + | { cl_path = ([], "Array") } + | { cl_path = ([], "Class") } + | { cl_path = (["cpp"], "FastIterator") } + | { cl_path = (["cpp"], "RawPointer") } + | { cl_path = (["cpp"], "ConstRawPointer") } + | { cl_path = (["cpp"], "Pointer") } + | { cl_path = (["cpp"], "ConstPointer") } + | { cl_path = (["cpp"], "Function") } -> false + | { cl_kind = KTypeParameter _ } -> true + | _ -> false) + | _ -> false + +let is_numeric t = + match follow t with + | TAbstract({ a_path = ([], "Int") }, []) + | TAbstract({ a_path = ([], "Float") }, []) + | TAbstract({ a_path = ([], "Single") }, []) + | TAbstract({ a_path = (["cpp"], "Char") }, []) + | TAbstract({ a_path = (["cpp"], "Float32") }, []) + | TAbstract({ a_path = (["cpp"], "Float64") }, []) + | TAbstract({ a_path = (["cpp"], "Int8") }, []) + | TAbstract({ a_path = (["cpp"], "Int16") }, []) + | TAbstract({ a_path = (["cpp"], "Int32") }, []) + | TAbstract({ a_path = (["cpp"], "Int64") }, []) + | TAbstract({ a_path = (["cpp"], "UInt8") }, []) + | TAbstract({ a_path = (["cpp"], "UInt16") }, []) + | TAbstract({ a_path = (["cpp"], "UInt32") }, []) + | TAbstract({ a_path = (["cpp"], "UInt64") }, []) + -> true + | _ + -> false + +let is_cpp_function_instance t = + match follow t with + | TInst ({ cl_path = (["cpp"], "Function") }, _) -> true + | _ -> false + +let is_objc_class klass = + has_class_flag klass CExtern && Meta.has Meta.Objc klass.cl_meta + +let is_var_field field = + match field.cf_kind with + | Var _ + | Method MethDynamic -> true + | _ -> false + +let is_pointer haxe_type includeRaw = + match follow haxe_type with + | TInst (klass,params) -> + (match klass.cl_path with + | ["cpp"] , "Pointer" + | ["cpp"] , "ConstPointer" + | ["cpp"] , "Function" -> true + | ["cpp"] , "RawPointer" when includeRaw -> true + | ["cpp"] , "RawConstPointer" when includeRaw -> true + | _ -> false ) + | TType (type_def,params) -> + (match type_def.t_path with + | ["cpp"] , "Pointer" + | ["cpp"] , "ConstPointer" + | ["cpp"] , "Function" -> true + | ["cpp"] , "RawPointer" when includeRaw -> true + | ["cpp"] , "RawConstPointer" when includeRaw -> true + | _ -> false ) + | _ -> false + ;; + +let is_array haxe_type = + match follow haxe_type with + | TInst ({ cl_path = ([], "Array") }, params) + | TType ({ t_path = ([], "Array") }, params) -> + not (is_dynamic_array_param (List.hd params)) + | _ -> false + +let is_array_or_dyn_array haxe_type = + match follow haxe_type with + | TInst ({ cl_path = ([], "Array") }, _) + | TType ({ t_path = ([], "Array")}, _) -> true + | _ -> false + +let is_array_implementer haxe_type = + match follow haxe_type with + | TInst ({ cl_array_access = Some _ }, _) -> true + | _ -> false + +let rec has_rtti_interface c interface = + List.exists (function (t,pl) -> + (snd t.cl_path) = interface && (match fst t.cl_path with | ["cpp";"rtti"] -> true | _ -> false ) + ) c.cl_implements || + (match c.cl_super with None -> false | Some (c,_) -> has_rtti_interface c interface) + +let has_field_integer_lookup class_def = + has_rtti_interface class_def "FieldIntegerLookup" + +let has_field_integer_numeric_lookup class_def = + has_rtti_interface class_def "FieldNumericIntegerLookup" + +let should_implement_field x = is_physical_field x + +let is_scalar_abstract abstract_def = + Meta.has Meta.Scalar abstract_def.a_meta && Meta.has Meta.CoreType abstract_def.a_meta + +let is_real_function field = + match field.cf_kind with + | Method MethNormal | Method MethInline-> true + | _ -> false + +let get_nth_type field index = + match follow field.ef_type with + | TFun (args,_) -> + let rec nth l index = match l with + | [] -> raise Not_found + | (_,_,t)::rest -> + if index = 0 then t + else nth rest (index-1) + in + nth args index + | _ -> raise Not_found + +let is_dynamic_haxe_method f = + match f.cf_expr, f.cf_kind with + | Some { eexpr = TFunction _ }, (Var _ | Method MethDynamic) -> true + | _ -> false + +let has_dynamic_member_functions class_def = + List.fold_left (fun result field -> + match field.cf_expr with + | Some { eexpr = TFunction function_def } when is_dynamic_haxe_method field -> true + | _ -> result ) false class_def.cl_ordered_fields + +let has_field_init field = + match field.cf_expr with + (* Function field *) + | Some { eexpr = TFunction function_def } -> is_dynamic_haxe_method field + (* Data field *) + | Some _ -> true + | _ -> false + +let is_data_member field = + match field.cf_kind with + | Var _ | Method MethDynamic -> true + | _ -> false + +let is_override field = + has_class_field_flag field CfOverride + +let rec unreflective_type t = + match follow t with + | TInst (klass,_) -> Meta.has Meta.Unreflective klass.cl_meta + | TFun (args,ret) -> + List.fold_left (fun result (_,_,t) -> result || (unreflective_type t)) (unreflective_type ret) args; + | _ -> false + +let reflective class_def field = not ( + (Meta.has Meta.NativeGen class_def.cl_meta) || + (Meta.has Meta.Unreflective class_def.cl_meta) || + (Meta.has Meta.Unreflective field.cf_meta) || + unreflective_type field.cf_type) + +let has_init_field class_def = + match TClass.get_cl_init class_def with + | Some _ -> true + | _ -> false + +let is_abstract_impl class_def = match class_def.cl_kind with + | KAbstractImpl _ -> true + | _ -> false + +let variable_field field = + match field.cf_expr with + | Some { eexpr = TFunction function_def } -> is_dynamic_haxe_method field + | None when has_class_field_flag field CfAbstract -> false + | _ -> true + +let is_readable class_def field = + match field.cf_kind with + | Var { v_read = AccNever } when not (is_physical_field field) -> false + | Var { v_read = AccInline } -> false + | Var _ when is_abstract_impl class_def -> false + | _ -> true + +let is_writable class_def field = + match field.cf_kind with + | Var { v_write = AccNever } when not (is_physical_field field) -> false + | Var { v_read = AccInline } -> false + | Var _ when is_abstract_impl class_def -> false + | _ -> true + +let statics_except_meta class_def = (List.filter (fun static -> static.cf_name <> "__meta__" && static.cf_name <> "__rtti") class_def.cl_ordered_statics);; + +let has_set_member_field class_def = + let reflect_fields = List.filter (reflective class_def) (class_def.cl_ordered_fields) in + let reflect_writable = List.filter (is_writable class_def) reflect_fields in + List.exists variable_field reflect_writable + +let has_set_static_field class_def = + let reflect_fields = List.filter (reflective class_def) (statics_except_meta class_def) in + let reflect_writable = List.filter (is_writable class_def) reflect_fields in + List.exists variable_field reflect_writable + +let has_get_fields class_def = + let is_data_field field = (match follow field.cf_type with | TFun _ -> false | _ -> true) in + List.exists is_data_field class_def.cl_ordered_fields + +let has_get_member_field class_def = + let reflect_fields = List.filter (reflective class_def) (class_def.cl_ordered_fields) in + List.exists (is_readable class_def) reflect_fields + +let has_get_static_field class_def = + let reflect_fields = List.filter (reflective class_def) (statics_except_meta class_def) in + List.exists (is_readable class_def) reflect_fields + +let has_compare_field class_def = + List.exists (fun f -> f.cf_name="__compare") class_def.cl_ordered_fields + +let has_boot_field class_def = + match TClass.get_cl_init class_def with + | None -> List.exists has_field_init (List.filter should_implement_field class_def.cl_ordered_statics) + | _ -> true + +(* + Functions are added in reverse order (oldest on right), then list is reversed because this is easier in ocaml + The order is important because cppia looks up functions by index +*) +let current_virtual_functions_rev clazz base_functions = + List.fold_left (fun result elem -> match follow elem.cf_type, elem.cf_kind with + | _, Method MethDynamic -> result + | TFun (args,return_type), Method _ -> + if (is_override elem ) then + if List.exists (fun (e,a,r) -> e.cf_name=elem.cf_name ) result then + result + else + (elem,args,return_type) :: result + else + (elem,args,return_type) :: result + | _,_ -> result + ) base_functions clazz.cl_ordered_fields + +let all_virtual_functions clazz = + let rec all_virtual_functions_rec clazz = + current_virtual_functions_rev clazz (match clazz.cl_super with + | Some def -> all_virtual_functions_rec (fst def) + | _ -> [] + ) + in + List.rev (all_virtual_functions_rec clazz) + +let class_name class_def = + let (_, class_path) = class_def.cl_path in + let nativeGen = Meta.has Meta.NativeGen class_def.cl_meta in + class_path ^ if nativeGen then "" else "_obj" + +let class_pointer class_def = "::hx::ObjectPtr< " ^ class_name class_def ^ " >" \ No newline at end of file diff --git a/src/generators/cpp/gen/cppCppia.ml b/src/generators/cpp/gen/cppCppia.ml new file mode 100644 index 00000000000..08eb43d1108 --- /dev/null +++ b/src/generators/cpp/gen/cppCppia.ml @@ -0,0 +1,1930 @@ +open Extlib_leftovers +open Ast +open Type +open Error +open Globals +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext + +let cpp_type_of = CppRetyper.cpp_type_of + +let script_type t optional = if optional then begin + match type_string t with + | "::String" -> "String" + | _ -> "Object" + end else match type_string t with + | "bool" -> "Int" + | "int" | "::cpp::Int32" -> "Int" + | "Float" -> "Float" + | "::String" -> "String" + | "Null" -> "Void" + | "Void" -> "Void" + | "float" | "::cpp::Float32" | "::cpp::Float64" -> "Float" + | "::cpp::Int64" | "::cpp::UInt64" -> "Object" + | _ -> "Object" + +let script_signature t optional = match script_type t optional with + | "Bool" -> "b" + | "Int" -> "i" + | "Float" -> "f" + | "String" -> "s" + | "Void" -> "v" + | "void" -> "v" + | _ -> "o" + +let script_size_type t optional = match script_type t optional with + | "Object" -> "void *" + | "Int" -> "int" + | "Bool" -> "bool" + | x -> x + +let rec script_type_string haxe_type = + match haxe_type with + | TAbstract ({ a_path = [], "Null" }, [ t ]) -> ( + match follow t with + | TAbstract ({ a_path = [], "Int" }, _) + | TAbstract ({ a_path = [], "Float" }, _) + | TAbstract ({ a_path = [], "Bool" }, _) -> + "Dynamic" + | _ -> script_type_string t) + | TInst ({ cl_path = [], "Null" }, [ t ]) -> ( + match follow t with + | TAbstract ({ a_path = [], "Int" }, _) + | TAbstract ({ a_path = [], "Float" }, _) + | TAbstract ({ a_path = [], "Bool" }, _) -> + "Dynamic" + | _ -> script_type_string t) + | _ -> ( + match follow haxe_type with + | TType ({ t_path = [], "Array" }, params) -> "Array" + | TInst ({ cl_path = [], "Array" }, params) -> ( + match params with + | [ t ] -> ( + match type_string_suff "" t false with + | "int" -> "Array.int" + | "Float" -> "Array.Float" + | "bool" -> "Array.bool" + | "::String" -> "Array.String" + | "unsigned char" -> "Array.unsigned char" + | "::cpp::UInt8" -> "Array.unsigned char" + | "Dynamic" -> "Array.Any" + | _ -> "Array.Object") + | _ -> "Array.Object") + | TAbstract (abs, pl) when abs.a_impl <> None -> + script_type_string (Abstract.get_underlying_type abs pl) + | _ -> type_string_suff "" haxe_type false) + +let rec script_cpptype_string cppType = + match cppType with + | TCppDynamic | TCppUnchanged | TCppWrapped _ | TCppObject -> "Dynamic" + | TCppObjectPtr -> ".*.hx.Object*" + | TCppReference t -> ".ref." ^ script_cpptype_string t + | TCppStruct t -> ".struct." ^ script_cpptype_string t + | TCppStar (t, _) -> "*." ^ script_cpptype_string t + | TCppVoid -> "void" + | TCppVoidStar -> "*.void" + | TCppRest _ -> "vaarg_list" + | TCppVarArg -> "vararg" + | TCppAutoCast -> ".cpp.AutoCast" + | TCppVariant -> ".cpp.Variant" + | TCppEnum enum -> join_class_path enum.e_path "." + | TCppScalar scalar -> scalar + | TCppString -> "String" + | TCppFastIterator it -> "cpp.FastIterator." ^ script_cpptype_string it + | TCppPointer (_, valueType) -> + "cpp.Pointer." ^ script_cpptype_string valueType + | TCppRawPointer (_, valueType) -> + "cpp.RawPointer." ^ script_cpptype_string valueType + | TCppFunction _ -> "cpp.Function" + | TCppObjCBlock _ -> "cpp.ObjCBlock" + | TCppDynamicArray -> "Array.Any" + | TCppObjectArray _ -> "Array.Object" + | TCppScalarArray value -> "Array." ^ script_cpptype_string value + | TCppObjC _ -> "cpp.ObjC" + | TCppProtocol _ -> "cpp.ObjC.Protocol" + | TCppNativePointer klass -> + "cpp.Pointer." ^ join_class_path klass.cl_path "." + | TCppInterface klass -> join_class_path klass.cl_path "." + | TCppInst (klass, _) -> join_class_path klass.cl_path "." + | TCppClass -> "Class" + | TCppGlobal -> "?global" + | TCppNull -> "null" + | TCppCode _ -> "Dynamic" + +type array_of = + | ArrayInterface of int + | ArrayData of string + | ArrayObject + | ArrayAny + | ArrayNone + +let is_template_type t = false + +type cppia_op = + | IaFunction + | IaVar + | IaToInterface + | IaToDynArray + | IaToDataArray + | IaToInterfaceArray + | IaFun + | IaCast + | IaTCast + | IaBlock + | IaBreak + | IaContinue + | IaIsNull + | IaNotNull + | IaSet + | IaCall + | IaCallGlobal + | IaCallStatic + | IaCallMember + | IaCallSuper + | IaCallThis + | IaCallSuperNew + | IaCreateEnum + | IaADef + | IaIf + | IaIfElse + | IaFStatic + | IaFName + | IaFThisInst + | IaFLink + | IaFThisName + | IaFEnum + | IaThrow + | IaArrayI + | IaPlusPlus + | IaPlusPlusPost + | IaMinusMinus + | IaMinusMinusPost + | IaNeg + | IaBitNot + | IaLogicNot + | IaTVars + | IaVarDecl + | IaVarDeclI + | IaNew + | IaReturn + | IaRetVal + | IaPosInfo + | IaObjDef + | IaClassOf + | IaWhile + | IaFor + | IaEnumI + | IaSwitch + | IaTry + | IaImplDynamic + | IaConstInt + | IaConstFloat + | IaConstString + | IaConstFalse + | IaConstTrue + | IaConstNull + | IaConsThis + | IaConstSuper + | IaCastInt + | IaCastBool + | IaInterface + | IaClass + | IaAccessNormal + | IaAccessNot + | IaAccessResolve + | IaAccessCall + | IaEnum + | IaInline + | IaMain + | IaNoMain + | IaResources + | IaReso + | IaNoCast + | IaAccessCallNative + | IaBinOp of Ast.binop + +let cppia_op_info = function + | IaFunction -> ("FUNCTION", 1) + | IaVar -> ("VAR", 2) + | IaToInterface -> ("TOINTERFACE", 3) + | IaToDynArray -> ("TODYNARRAY", 4) + | IaToDataArray -> ("TODATAARRAY", 5) + | IaToInterfaceArray -> ("TOINTERFACEARRAY", 6) + | IaFun -> ("FUN", 7) + | IaCast -> ("CAST", 8) + | IaBlock -> ("BLOCK", 9) + | IaBreak -> ("BREAK", 10) + | IaContinue -> ("CONTINUE", 11) + | IaIsNull -> ("ISNULL", 12) + | IaNotNull -> ("NOTNULL", 13) + | IaSet -> ("SET", 14) + | IaCall -> ("CALL", 15) + | IaCallGlobal -> ("CALLGLOBAL", 16) + | IaCallStatic -> ("CALLSTATIC", 17) + | IaCallMember -> ("CALLMEMBER", 18) + | IaCallSuper -> ("CALLSUPER", 19) + | IaCallThis -> ("CALLTHIS", 20) + | IaCallSuperNew -> ("CALLSUPERNEW", 21) + | IaCreateEnum -> ("CREATEENUM", 22) + | IaADef -> ("ADEF", 23) + | IaIf -> ("IF", 24) + | IaIfElse -> ("IFELSE", 25) + | IaFName -> ("FNAME", 27) + | IaFStatic -> ("FSTATIC", 28) + | IaFThisInst -> ("FTHISINST", 29) + | IaFLink -> ("FLINK", 30) + | IaFThisName -> ("FTHISNAME", 31) + | IaFEnum -> ("FENUM", 32) + | IaThrow -> ("THROW", 33) + | IaArrayI -> ("ARRAYI", 34) + | IaPlusPlus -> ("++", 35) + | IaPlusPlusPost -> ("+++", 36) + | IaMinusMinus -> ("--", 37) + | IaMinusMinusPost -> ("---", 38) + | IaNeg -> ("NEG", 39) + | IaBitNot -> ("~", 40) + | IaLogicNot -> ("!", 41) + | IaTVars -> ("TVARS", 42) + | IaVarDecl -> ("VARDECL", 43) + | IaVarDeclI -> ("VARDECLI", 44) + | IaNew -> ("NEW", 45) + | IaReturn -> ("RETURN", 46) + | IaRetVal -> ("RETVAL", 47) + | IaPosInfo -> ("POSINFO", 48) + | IaObjDef -> ("OBJDEF", 49) + | IaClassOf -> ("CLASSOF", 50) + | IaWhile -> ("WHILE", 51) + | IaFor -> ("FOR", 52) + | IaEnumI -> ("ENUMI", 53) + | IaSwitch -> ("SWITCH", 54) + | IaTry -> ("TRY", 55) + | IaImplDynamic -> ("IMPLDYNAMIC", 56) + | IaConstInt -> ("i", 57) + | IaConstFloat -> ("f", 58) + | IaConstString -> ("s", 59) + | IaConstFalse -> ("false", 60) + | IaConstTrue -> ("true", 61) + | IaConstNull -> ("NULL", 62) + | IaConsThis -> ("THIS", 63) + | IaConstSuper -> ("SUPER", 64) + | IaCastInt -> ("CASTINT", 65) + | IaCastBool -> ("CASTBOOL", 66) + | IaInterface -> ("INTERFACE", 67) + | IaClass -> ("CLASS", 68) + | IaAccessNormal -> ("N", 69) + | IaAccessNot -> ("n", 70) + | IaAccessResolve -> ("R", 71) + | IaAccessCall -> ("C", 72) + | IaEnum -> ("ENUM", 73) + | IaInline -> ("INLINE", 74) + | IaMain -> ("MAIN", 75) + | IaNoMain -> ("NOMAIN", 76) + | IaResources -> ("RESOURCES", 77) + | IaReso -> ("RESO", 78) + | IaNoCast -> ("NOCAST", 79) + | IaAccessCallNative -> ("V", 80) + | IaBinOp OpAdd -> ("+", 101) + | IaBinOp OpMult -> ("*", 102) + | IaBinOp OpDiv -> ("/", 103) + | IaBinOp OpSub -> ("-", 104) + | IaBinOp OpAssign -> ("=", 105) + | IaBinOp OpEq -> ("==", 106) + | IaBinOp OpNotEq -> ("!=", 107) + | IaBinOp OpGte -> (">=", 108) + | IaBinOp OpLte -> ("<=", 109) + | IaBinOp OpGt -> (">", 110) + | IaBinOp OpLt -> ("<", 111) + | IaBinOp OpAnd -> ("&", 112) + | IaBinOp OpOr -> ("|", 113) + | IaBinOp OpXor -> ("^", 114) + | IaBinOp OpBoolAnd -> ("&&", 115) + | IaBinOp OpBoolOr -> ("||", 116) + | IaBinOp OpShr -> (">>", 117) + | IaBinOp OpUShr -> (">>>", 118) + | IaBinOp OpShl -> ("<<", 119) + | IaBinOp OpMod -> ("%", 120) + | IaBinOp OpInterval -> ("...", 121) + | IaBinOp OpArrow -> ("=>", 122) + | IaBinOp OpIn -> (" in ", 123) + | IaBinOp OpNullCoal -> ("??", 124) + | IaBinOp (OpAssignOp OpAdd) -> ("+=", 201) + | IaBinOp (OpAssignOp OpMult) -> ("*=", 202) + | IaBinOp (OpAssignOp OpDiv) -> ("/=", 203) + | IaBinOp (OpAssignOp OpSub) -> ("-=", 204) + | IaBinOp (OpAssignOp OpAnd) -> ("&=", 212) + | IaBinOp (OpAssignOp OpOr) -> ("|=", 213) + | IaBinOp (OpAssignOp OpXor) -> ("^=", 214) + | IaBinOp (OpAssignOp OpBoolAnd) -> ("&&=", 215) + | IaBinOp (OpAssignOp OpBoolOr) -> ("||=", 216) + | IaBinOp (OpAssignOp OpShr) -> (">>=", 217) + | IaBinOp (OpAssignOp OpUShr) -> (">>>=", 218) + | IaBinOp (OpAssignOp OpShl) -> ("<<=", 219) + | IaBinOp (OpAssignOp OpMod) -> ("%=", 220) + | IaBinOp (OpAssignOp OpIn) + | IaBinOp (OpAssignOp OpNullCoal) + | IaBinOp (OpAssignOp OpInterval) + | IaBinOp (OpAssignOp OpAssign) + | IaBinOp (OpAssignOp OpEq) + | IaBinOp (OpAssignOp OpNotEq) + | IaBinOp (OpAssignOp OpGte) + | IaBinOp (OpAssignOp OpLte) + | IaBinOp (OpAssignOp OpGt) + | IaBinOp (OpAssignOp OpLt) + | IaBinOp (OpAssignOp (OpAssignOp _)) + | IaBinOp (OpAssignOp OpArrow) -> + die "" __LOC__ + | IaTCast -> ("TCAST", 221) + +let follow = Abstract.follow_with_abstracts + +let is_matching_interface_type t0 t1 = + match (follow t0, follow t1) with + | TInst (k0, _), TInst (k1, _) -> k0 == k1 + | _ -> false + +let rec is_null expr = + match expr.eexpr with + | TConst TNull -> true + | TParenthesis expr | TMeta (_, expr) -> is_null expr + | TCast (e, None) -> is_null e + | _ -> false + +let is_virtual_array expr = type_string expr.etype = "cpp::VirtualArray" + +let is_this expression = + match (remove_parens expression).eexpr with + | TConst TThis -> true + | _ -> false + +let is_super expression = + match (remove_parens expression).eexpr with + | TConst TSuper -> true + | _ -> false + +let is_native_pointer expr = + let t = type_string expr.etype in + let l = String.length t in + l > 1 && String.sub t (l - 1) 1 = "*" + +let is_extern_class_instance obj = + match follow obj.etype with + | TInst (klass, params) -> has_class_flag klass CExtern + | _ -> false + +let rec is_dynamic_in_cpp ctx expr = + let expr_type = + type_string + (match follow expr.etype with TFun (args, ret) -> ret | _ -> expr.etype) + in + if expr_type = "Dynamic" || expr_type = "cpp::ArrayBase" then true + else + let result = + match expr.eexpr with + | TEnumParameter (obj, _, index) -> true (* TODO? *) + | TField (obj, field) -> + is_dynamic_member_lookup_in_cpp ctx obj field + || is_dynamic_member_return_in_cpp ctx obj field + | TArray (obj, index) -> is_dynamic_in_cpp ctx obj || is_virtual_array obj + | TTypeExpr _ -> false + | TCall (func, args) -> ( + let is_IaCall = + match (remove_parens_cast func).eexpr with + | TField ({ eexpr = TIdent "__global__" }, field) -> false + | TField (obj, FStatic (class_def, field)) + when is_real_function field -> + false + | TField (obj, FInstance (_, _, field)) + when is_this obj && is_real_function field -> + false + | TField (obj, FInstance (_, _, field)) when is_super obj -> false + | TField (obj, FInstance (_, _, field)) + when field.cf_name = "_hx_getIndex" -> + false + | TField (obj, FInstance (_, _, field)) + when field.cf_name = "__Index" + || (not (is_dynamic_in_cppia ctx obj)) + && is_real_function field -> + false + | TField (obj, FDynamic name) + when is_internal_member name + || (type_string obj.etype = "::String" && name = "cca") -> + false + | TConst TSuper -> false + | TField (_, FEnum (enum, field)) -> false + | _ -> true + in + if is_IaCall then true + else + match follow func.etype with + | TFun (args, ret) -> is_dynamic_in_cpp ctx func + | _ -> true) + | TParenthesis expr | TMeta (_, expr) -> is_dynamic_in_cpp ctx expr + | TCast (e, None) -> type_string expr.etype = "Dynamic" + | TIdent "__global__" -> false + | TConst TNull -> true + | _ -> false (* others ? *) + in + result + +and is_dynamic_member_lookup_in_cpp (ctx : context) field_object field = + let member = field_name field in + if is_internal_member member then false + else if is_native_pointer field_object then false + else if is_pointer field_object.etype true then false + else if match field_object.eexpr with TTypeExpr _ -> true | _ -> false then + false + else if is_dynamic_in_cpp ctx field_object then true + else if is_array field_object.etype then false + else + let tstr = type_string field_object.etype in + match tstr with + (* Internal classes have no dynamic members *) + | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math" + | "::ArrayAccess" -> + false + | "Dynamic" -> true + | name -> + let full_name = name ^ "." ^ member in + if Hashtbl.mem ctx.ctx_class_member_types full_name then false + else not (is_extern_class_instance field_object) + +and is_dynamic_member_return_in_cpp ctx field_object field = + let member = field_name field in + if is_array field_object.etype then false + else if is_pointer field_object.etype true then false + else if is_internal_member member then false + else + match field_object.eexpr with + | TTypeExpr t -> ( + let full_name = + "::" ^ join_class_path_remap (t_path t) "::" ^ "." ^ member + in + try + let mem_type = Hashtbl.find ctx.ctx_class_member_types full_name in + mem_type = "Dynamic" + || mem_type = "cpp::ArrayBase" + || mem_type = "cpp::VirtualArray" + with Not_found -> true) + | _ -> ( + let tstr = type_string field_object.etype in + match tstr with + (* Internal classes have no dynamic members *) + | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math" + | "::ArrayAccess" -> + false + | "Dynamic" | "cpp::ArrayBase" | "cpp::VirtualArray" -> true + | name -> ( + let full_name = name ^ "." ^ member in + try + let mem_type = + Hashtbl.find ctx.ctx_class_member_types full_name + in + mem_type = "Dynamic" + || mem_type = "cpp::ArrayBase" + || mem_type = "cpp::VirtualArray" + with Not_found -> true)) + +and is_dynamic_in_cppia ctx expr = + match expr.eexpr with + | TCast (_, None) -> true + | _ -> is_dynamic_in_cpp ctx expr + +class script_writer ctx filename asciiOut = + object (this) + val debug = asciiOut + + val doComment = + asciiOut && Gctx.defined ctx.ctx_common Define.AnnotateSource + + val indent_str = if asciiOut then "\t" else "" + val mutable indent = "" + val mutable indents = [] + val mutable just_finished_block = false + val mutable classCount = 0 + val mutable return_type = TMono (Monomorph.create ()) + val buffer = Buffer.create 0 + val identTable = Hashtbl.create 0 + val fileTable = Hashtbl.create 0 + val identBuffer = Buffer.create 0 + val cppiaAst = not (Gctx.defined ctx.ctx_common Define.NoCppiaAst) + + method stringId name = + try Hashtbl.find identTable name + with Not_found -> + let size = Hashtbl.length identTable in + Hashtbl.add identTable name size; + Buffer.add_string identBuffer + (string_of_int (String.length name) ^ " " ^ name ^ "\n"); + size + + method incClasses = classCount <- classCount + 1 + method stringText name = string_of_int (this#stringId name) ^ " " + val typeTable = Hashtbl.create 0 + val typeBuffer = Buffer.create 0 + + method typeId name = + let name = if name = "::hx::Class" then "::Class" else name in + try Hashtbl.find typeTable name + with Not_found -> + let size = Hashtbl.length typeTable in + Hashtbl.add typeTable name size; + Buffer.add_string typeBuffer + (string_of_int (String.length name) ^ " " ^ name ^ "\n"); + size + + method write str = + (if asciiOut then Buffer.add_string buffer str + else + let push i = Buffer.add_char buffer (Char.chr i) in + let pushI32 i = + push (Int32.to_int (Int32.logand i (Int32.of_int 255))) + in + List.iter + (fun i -> + if + Int32.compare i Int32.zero >= 0 + && Int32.compare i (Int32.of_int 254) < 0 + then pushI32 i + else if + Int32.compare i Int32.zero >= 0 + && Int32.compare i (Int32.of_int 65536) < 0 + then ( + push 254; + pushI32 i; + pushI32 (Int32.shift_right i 8)) + else ( + push 255; + pushI32 i; + pushI32 (Int32.shift_right i 8); + pushI32 (Int32.shift_right i 16); + pushI32 (Int32.shift_right i 24))) + (List.map Int32.of_string (Str.split (Str.regexp "[\n\t ]+") str))); + just_finished_block <- false + + method comment text = if doComment then this#write ("# " ^ text ^ "\n") + method commentOf text = if doComment then " # " ^ text else "" + method typeTextString typeName = string_of_int (this#typeId typeName) ^ " " + + method typeText typeT = + let tname = + if cppiaAst then script_cpptype_string (cpp_type_of typeT) + else script_type_string typeT + in + string_of_int (this#typeId tname) ^ " " + + method astType cppType = + string_of_int (this#typeId (script_cpptype_string cppType)) ^ " " + + method writeType typeT = this#write (this#typeText typeT) + + method toCppType etype = + string_of_int (this#typeId (script_cpptype_string (cpp_type_of etype))) + ^ " " + + method boolText value = if value then "1" else "0" + method writeBool value = this#write (if value then "1 " else "0 ") + method staticText value = if value then "1" else "0" + method writeData str = Buffer.add_string buffer str + method wint ival = this#write (string_of_int ival ^ " ") + method ident name = this#wint (this#stringId name) + + method cppInstText clazz = + match clazz.cl_path with + | [], "Array" -> this#typeTextString "Array" + | x -> this#typeTextString (join_class_path x ".") + + method instText clazz = + match clazz.cl_path with + | [], "Array" -> string_of_int (this#typeId "Array< ::Dynamic >") ^ " " + | _ -> this#typeText (TInst (clazz, [])) + + method instName clazz = + this#write + (if cppiaAst then this#cppInstText clazz else this#instText clazz) + + method enumText e = this#typeText (TEnum (e, [])) + + method close = + let out_file = open_out_bin filename in + output_string out_file (if asciiOut then "CPPIA\n" else "CPPIB\n"); + let idents = Buffer.contents identBuffer in + output_string out_file (string_of_int (Hashtbl.length identTable) ^ "\n"); + output_string out_file idents; + let types = Buffer.contents typeBuffer in + output_string out_file (string_of_int (Hashtbl.length typeTable) ^ "\n"); + output_string out_file types; + output_string out_file (string_of_int classCount ^ "\n"); + let contents = Buffer.contents buffer in + output_string out_file contents; + close_out out_file + + method fileId file = + try Hashtbl.find fileTable file + with Not_found -> + let stripped_file = strip_file ctx.ctx_common file in + let result = this#stringId stripped_file in + Hashtbl.add fileTable file result; + result + + method constText c = + match c with + | TInt i -> this#op IaConstInt ^ Printf.sprintf "%ld " i + | TFloat f -> + this#op IaConstFloat ^ this#stringText (Texpr.replace_separators f "") + | TString s -> this#op IaConstString ^ this#stringText s + | TBool true -> this#op IaConstTrue + | TBool false -> this#op IaConstFalse + | TNull -> this#op IaConstNull + | TThis -> this#op IaConsThis + | TSuper -> this#op IaConstSuper + + method get_array_type t = + match follow t with + | TInst ({ cl_path = [], "Array" }, [ param ]) -> ( + let typeName = type_string_suff "" param false in + match typeName with + | "::String" -> ArrayData "String" + | "int" | "Float" | "bool" | "String" | "unsigned char" + | "::cpp::UInt8" -> + ArrayData typeName + | "cpp::ArrayBase" | "cpp::VirtualArray" | "Dynamic" -> ArrayAny + | _ when is_interface_type param -> + ArrayInterface (this#typeId (script_type_string param)) + | _ -> ArrayObject) + | TAbstract (abs, pl) when abs.a_impl <> None -> + this#get_array_type (Abstract.get_underlying_type abs pl) + | _ -> ArrayNone + + method pushReturn inType = + let oldReturnType = return_type in + return_type <- inType; + fun () -> return_type <- oldReturnType + + method fileText file = string_of_int (this#fileId file) + method indent_one = this#write indent_str + + method push_indent = + indents <- indent_str :: indents; + indent <- String.concat "" indents + + method pop_indent = + match indents with + | h :: tail -> + indents <- tail; + indent <- String.concat "" indents + | [] -> indent <- "/*?*/" + + method write_i x = this#write (indent ^ x) + method get_indent = indent + method begin_expr = this#push_indent + + method end_expr = + if not just_finished_block then this#write "\n"; + this#pop_indent; + just_finished_block <- true + + method op x = + match cppia_op_info x with + | name, index -> (if debug then name else string_of_int index) ^ " " + + method writeOp o = this#write (this#op o) + method writeOpLine o = this#write (this#op o ^ "\n") + + method voidFunc isStatic isDynamic funcName fieldExpression = + this#comment funcName; + this#write + (this#op IaFunction ^ this#staticText isStatic ^ " " + ^ this#boolText isDynamic ^ " " ^ this#stringText funcName ^ " "); + this#write (this#typeTextString "Void" ^ "0\n"); + this#gen_expression fieldExpression + + method func isStatic isDynamic funcName ret args isInterface fieldExpression + abstractPos = + this#comment funcName; + this#write + (this#op IaFunction ^ this#staticText isStatic ^ " " + ^ this#boolText isDynamic ^ " " ^ this#stringText funcName ^ " "); + this#write (this#typeText ret ^ string_of_int (List.length args) ^ " "); + List.iter + (fun (name, opt, typ) -> + this#write + (this#stringText name ^ this#boolText opt ^ " " ^ this#typeText typ + ^ " ")) + args; + this#write "\n"; + if not isInterface then + match fieldExpression with + | Some ({ eexpr = TFunction function_def } as e) -> + if cppiaAst then ( + let args = List.map fst function_def.tf_args in + let cppExpr = + CppRetyper.expression ctx TCppVoid args function_def.tf_type + function_def.tf_expr false + in + this#begin_expr; + this#writePos function_def.tf_expr; + this#write + (this#op IaFun + ^ this#typeText function_def.tf_type + ^ string_of_int (List.length args) + ^ "\n"); + let close = this#gen_func_args function_def.tf_args in + this#gen_expression_tree cppExpr; + this#end_expr; + close ()) + else this#gen_expression e + | _ -> + (* Abstract function - dummp implementation that (should) not get called *) + this#begin_expr; + this#wpos abstractPos; + this#writeOpLine IaReturn; + this#end_expr + + method var readAcc writeAcc isExtern isStatic name varType varExpr = + this#write + (this#op IaVar ^ this#staticText isStatic ^ " " ^ this#op readAcc + ^ this#op writeAcc ^ this#boolText isExtern ^ " " ^ this#stringText name + ^ this#typeText varType + ^ (match varExpr with Some _ -> "1" | _ -> "0") + ^ if doComment then " # " ^ name ^ "\n" else "\n"); + match varExpr with + | Some expression -> + if cppiaAst then + let varType = cpp_type_of expression.etype in + let cppExpr = + CppRetyper.expression ctx varType [] t_dynamic expression false + in + this#gen_expression_tree cppExpr + else this#gen_expression expression + | _ -> () + + method implDynamic = this#writeOpLine IaImplDynamic + + method writeVar v = + this#ident v.v_name; + this#wint v.v_id; + this#writeBool (has_var_flag v VCaptured); + this#writeType v.v_type + + method writeList prefix len = + this#write (prefix ^ " " ^ string_of_int len ^ "\n") + + method wpos p = + if debug then + this#write + (this#fileText p.pfile ^ "\t" + ^ string_of_int (Lexer.get_error_line p) + ^ indent) + + method writePos expr = this#wpos expr.epos + method writeCppPos expr = this#wpos expr.cpppos + + method checkCast toType expr forceCast fromGenExpression = + let write_cast text = + if not fromGenExpression then this#writePos expr; + this#write (text ^ "\n"); + this#begin_expr; + this#gen_expression expr; + this#end_expr; + true + in + let was_cast = + if is_interface_type toType then + if is_dynamic_in_cppia ctx expr then + write_cast + (this#op IaToInterface ^ this#typeText toType ^ " " + ^ this#typeTextString "Dynamic") + else if not (is_matching_interface_type toType expr.etype) then + write_cast + (this#op IaToInterface ^ this#typeText toType ^ " " + ^ this#typeText expr.etype) + else false + else + let get_array_expr_type expr = + if is_dynamic_in_cppia ctx expr then ArrayNone + else this#get_array_type expr.etype + in + match (this#get_array_type toType, get_array_expr_type expr) with + | ArrayAny, _ -> false + | ArrayObject, ArrayData _ -> write_cast (this#op IaToDynArray) + | ArrayObject, ArrayObject -> false + | ArrayObject, ArrayNone | ArrayObject, ArrayAny -> + write_cast + (this#op IaToDataArray ^ this#typeTextString "Array.Object") + | ArrayData t, ArrayNone + | ArrayData t, ArrayObject + | ArrayData t, ArrayAny -> + write_cast + (this#op IaToDataArray ^ this#typeTextString ("Array." ^ t)) + | ArrayInterface t, ArrayNone | ArrayInterface t, ArrayAny -> + write_cast (this#op IaToInterfaceArray ^ string_of_int t) + | _, _ -> + (* a0,a1 -> + let arrayString a = + match a with + | ArrayNone -> "ArrayNone" + | ArrayAny -> "ArrayAny" + | ArrayObject -> "ArrayObject" + | ArrayData _ -> "ArrayData" + | ArrayInterface _ -> "ArrayInterface" + in + this#write ("NOCAST " ^ (arrayString a0) ^ "=" ^ (arrayString a1)); *) + false + in + + if not was_cast then ( + (if forceCast then + let op = + match type_string expr.etype with + | "int" -> IaCastInt + | "bool" -> IaCastBool + | _ when is_interface_type toType -> IaNoCast + | _ -> IaCast + in + this#writeOpLine op); + this#gen_expression expr) + + method gen_func_args args = + let gen_inits = ref [] in + List.iter + (fun (arg, init) -> + this#write (indent ^ indent_str); + this#writeVar arg; + match init with + | Some { eexpr = TConst TNull } -> this#write "0\n" + | Some const -> + let argType = cpp_type_of const.etype in + if is_cpp_scalar argType || argType == TCppString then ( + this#write "1 "; + this#gen_expression_only const; + this#write "\n") + else ( + gen_inits := (arg, const) :: !gen_inits; + this#write "0\n") + | _ -> this#write "0\n") + args; + + if List.length !gen_inits == 0 then fun () -> () + else ( + this#begin_expr; + this#writePos (snd (List.hd !gen_inits)); + this#writeList (this#op IaBlock) (List.length !gen_inits + 1); + List.iter + (fun (arg, const) -> + let start_expr () = + this#begin_expr; + this#writePos const + in + let local_var () = + this#begin_expr; + this#writePos const; + this#write + (this#op IaVar ^ string_of_int arg.v_id + ^ this#commentOf arg.v_name); + this#end_expr + in + + start_expr (); + this#writeOpLine IaIf; + start_expr (); + this#writeOpLine IaIsNull; + local_var (); + this#end_expr; + start_expr (); + this#writeOpLine IaSet; + local_var (); + this#gen_expression const; + this#end_expr; + this#begin_expr) + !gen_inits; + fun () -> this#end_expr) + + method gen_expression expr = + this#begin_expr; + this#writePos expr; + this#gen_expression_only expr; + this#end_expr + + method gen_expression_only expr = + (* { *) + let expression = remove_parens expr in + match expression.eexpr with + | TFunction function_def -> + this#write + (this#op IaFun + ^ this#typeText function_def.tf_type + ^ string_of_int (List.length function_def.tf_args) + ^ "\n"); + let close = this#gen_func_args function_def.tf_args in + let pop = this#pushReturn function_def.tf_type in + this#gen_expression function_def.tf_expr; + pop (); + close () + | TBlock expr_list -> + this#writeList (this#op IaBlock) (List.length expr_list); + List.iter this#gen_expression expr_list + | TConst const -> this#write (this#constText const) + | TBreak -> this#writeOp IaBreak + | TContinue -> this#writeOp IaContinue + | TBinop (op, e1, e2) when op = OpAssign -> + this#writeOpLine IaSet; + this#gen_expression e1; + this#checkCast e1.etype e2 false false + | TBinop (OpEq, e1, { eexpr = TConst TNull }) -> + this#writeOpLine IaIsNull; + this#gen_expression e1 + | TBinop (OpNotEq, e1, { eexpr = TConst TNull }) -> + this#writeOpLine IaNotNull; + this#gen_expression e1 + | TBinop (OpEq, { eexpr = TConst TNull }, e1) -> + this#writeOpLine IaIsNull; + this#gen_expression e1 + | TBinop (OpNotEq, { eexpr = TConst TNull }, e1) -> + this#writeOpLine IaNotNull; + this#gen_expression e1 + | TBinop (op, e1, e2) -> + this#writeOpLine (IaBinOp op); + this#gen_expression e1; + this#gen_expression e2 + | TThrow e -> + this#writeOpLine IaThrow; + this#gen_expression e + | TArrayDecl expr_list -> + this#write + (this#op IaADef + ^ this#typeText expression.etype + ^ " " + ^ string_of_int (List.length expr_list) + ^ "\n"); + List.iter this#gen_expression expr_list + | TIf (e, e1, e2) -> ( + match e2 with + | None -> + this#writeOpLine IaIf; + this#gen_expression e; + this#gen_expression e1 + | Some elze -> + this#writeOpLine IaIfElse; + this#gen_expression e; + this#gen_expression e1; + this#gen_expression elze) + | TCall (func, arg_list) -> ( + let argN = string_of_int (List.length arg_list) ^ " " in + let gen_call () = + (match (remove_parens_cast func).eexpr with + | TField ({ eexpr = TIdent "__global__" }, field) -> + this#write + (this#op IaCallGlobal + ^ this#stringText (field_name field) + ^ argN + ^ this#commentOf (field_name field) + ^ "\n") + | TField (obj, FStatic (class_def, field)) + when is_real_function field -> + this#write + (this#op IaCallStatic ^ this#instText class_def ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf + (join_class_path class_def.cl_path "." + ^ "." ^ field.cf_name) + ^ "\n") + | TField (obj, FInstance (_, _, field)) + when is_this obj && is_real_function field -> + this#write + (this#op IaCallThis ^ this#typeText obj.etype ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf field.cf_name + ^ "\n") + | TField (obj, FInstance (_, _, field)) when is_super obj -> + this#write + (this#op IaCallSuper ^ this#typeText obj.etype ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf field.cf_name + ^ "\n") + (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *) + | TField (obj, FInstance (_, _, field)) + when field.cf_name = "_hx_getIndex" + && script_type_string obj.etype = "::hx::EnumBase" -> + this#write + (this#op IaCallMember + ^ this#typeTextString "::hx::EnumBase" + ^ " " ^ this#stringText "__Index" ^ argN + ^ this#commentOf "Enum index" + ^ "\n"); + this#gen_expression obj + | TField (obj, FInstance (_, _, field)) + when field.cf_name = "__Index" + || (not (is_dynamic_in_cppia ctx obj)) + && is_real_function field -> + this#write + (this#op IaCallMember ^ this#typeText obj.etype ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf field.cf_name + ^ "\n"); + this#gen_expression obj + | TField (obj, FDynamic name) + when is_internal_member name + || (type_string obj.etype = "::String" && name = "cca") -> + this#write + (this#op IaCallMember ^ this#typeText obj.etype ^ " " + ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n"); + this#gen_expression obj + | TConst TSuper -> + this#write + (this#op IaCallSuperNew ^ this#typeText func.etype ^ " " + ^ argN ^ "\n") + | TField (_, FEnum (enum, field)) -> + this#write + (this#op IaCreateEnum ^ this#enumText enum ^ " " + ^ this#stringText field.ef_name + ^ argN + ^ this#commentOf field.ef_name + ^ "\n") + | _ -> + this#write (this#op IaCall ^ argN ^ "\n"); + this#gen_expression func); + let matched_args = + match func.etype with + | TFun (args, _) -> ( + try + List.iter2 + (fun (_, _, protoT) arg -> + this#checkCast protoT arg false false) + args arg_list; + true + with Invalid_argument _ -> + (*print_endline "Bad count?";*) false) + | _ -> false + in + if not matched_args then List.iter this#gen_expression arg_list + in + match (remove_parens_cast func).eexpr with + | TField (obj, field) + when is_array_or_dyn_array obj.etype && field_name field = "map" + -> ( + match this#get_array_type expression.etype with + | ArrayData t -> + this#write + (this#op IaToDataArray + ^ this#typeTextString ("Array." ^ t) + ^ "\n"); + this#begin_expr; + this#writePos func; + gen_call (); + this#end_expr + | ArrayInterface t -> + this#write + (this#op IaToInterfaceArray ^ string_of_int t ^ "\n"); + this#begin_expr; + this#writePos func; + gen_call (); + this#end_expr + | _ -> gen_call ()) + | _ -> gen_call ()) + | TField (obj, acc) -> ( + let objType = + if is_dynamic_in_cppia ctx obj then "Dynamic" + else script_type_string obj.etype + in + let typeText = + if is_dynamic_in_cppia ctx obj then this#typeTextString "Dynamic" + else this#typeText obj.etype + in + match acc with + | FDynamic name -> + this#write + (this#op IaFName ^ typeText ^ " " ^ this#stringText name + ^ this#commentOf name ^ "\n"); + this#gen_expression obj + | FStatic (class_def, field) -> + this#write + (this#op IaFStatic ^ this#instText class_def ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name) + | FInstance (_, _, field) when is_this obj -> + this#write + (this#op IaFThisInst ^ typeText ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name) + | FInstance (_, _, field) -> + this#write + (this#op IaFLink ^ typeText ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf (objType ^ "." ^ field.cf_name) + ^ "\n"); + this#gen_expression obj + | FClosure (_, field) when is_this obj -> + this#write + (this#op IaFThisName ^ typeText ^ " " + ^ this#stringText field.cf_name + ^ "\n") + | FAnon field when is_this obj -> + this#write + (this#op IaFThisName ^ typeText ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name + ^ "\n") + | FClosure (_, field) | FAnon field -> + this#write + (this#op IaFName ^ typeText ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name + ^ "\n"); + this#gen_expression obj + | FEnum (enum, field) -> + this#write + (this#op IaFEnum ^ this#enumText enum ^ " " + ^ this#stringText field.ef_name + ^ this#commentOf field.ef_name)) + | TArray (e1, e2) -> + this#write (this#op IaArrayI ^ this#typeText e1.etype ^ "\n"); + this#gen_expression e1; + this#gen_expression e2 + | TUnop (op, flag, e) -> + this#writeOpLine + (match (op, flag) with + | Increment, Prefix -> IaPlusPlus + | Increment, _ -> IaPlusPlusPost + | Decrement, Prefix -> IaMinusMinus + | Decrement, _ -> IaMinusMinusPost + | Not, _ -> IaLogicNot + | Neg, _ -> IaNeg + | Spread, _ -> die ~p:e.epos "Unexpected spread operator" __LOC__ + | NegBits, _ -> IaBitNot); + this#gen_expression e + (* TODO - lval op-assign local/member/array *) + | TLocal var -> + this#write + (this#op IaVar ^ string_of_int var.v_id ^ this#commentOf var.v_name) + | TVar (tvar, optional_init) -> ( + this#write + (this#op IaTVars ^ string_of_int 1 + ^ this#commentOf (tvar.v_name ^ ":" ^ script_type_string tvar.v_type) + ^ "\n"); + this#write ("\t\t" ^ indent); + match optional_init with + | None -> + this#writeOp IaVarDecl; + this#writeVar tvar + | Some init -> + this#writeOp IaVarDeclI; + let init = remove_parens init in + this#writeVar tvar; + this#write (" " ^ this#typeText init.etype); + this#write "\n"; + this#checkCast tvar.v_type init false false) + | TNew (clazz, params, arg_list) -> ( + this#write + (this#op IaNew + ^ this#typeText (TInst (clazz, params)) + ^ string_of_int (List.length arg_list) + ^ "\n"); + try + match + OverloadResolution.maybe_resolve_constructor_overload clazz params + arg_list + with + | Some (_, { cf_type = TFun (args, _) }, _) -> + List.iter2 + (fun (_, _, protoT) arg -> + this#checkCast protoT arg false false) + args arg_list + | _ -> raise (Invalid_argument "") + with Invalid_argument _ -> List.iter this#gen_expression arg_list) + | TReturn optval -> ( + match optval with + | None -> this#writeOpLine IaReturn + | Some value -> + this#write (this#op IaRetVal ^ this#typeText value.etype ^ "\n"); + this#checkCast return_type value false false) + | TObjectDecl + [ + (("fileName", _, _), { eexpr = TConst (TString file) }); + (("lineNumber", _, _), { eexpr = TConst (TInt line) }); + (("className", _, _), { eexpr = TConst (TString class_name) }); + (("methodName", _, _), { eexpr = TConst (TString meth) }); + ] -> + this#write + (this#op IaPosInfo ^ this#stringText file + ^ Printf.sprintf "%ld" line ^ " " ^ this#stringText class_name ^ " " + ^ this#stringText meth) + | TObjectDecl values -> + this#write (this#op IaObjDef ^ string_of_int (List.length values)); + this#write " "; + List.iter + (fun ((name, _, _), _) -> this#write (this#stringText name)) + values; + this#write "\n"; + List.iter (fun (_, e) -> this#gen_expression e) values + | TTypeExpr type_expr -> + let klass = "::" ^ join_class_path (t_path type_expr) "::" in + this#write (this#op IaClassOf ^ string_of_int (this#typeId klass)) + | TWhile (e1, e2, flag) -> + this#write + (this#op IaWhile ^ (if flag = NormalWhile then "1" else "0") ^ "\n"); + this#gen_expression e1; + this#gen_expression e2 + | TFor (tvar, init, loop) -> + this#writeOp IaFor; + this#writeVar tvar; + this#write "\n"; + this#gen_expression init; + this#gen_expression loop + | TEnumParameter (expr, ef, i) -> + let enum = + match follow ef.ef_type with + | TEnum (en, _) | TFun (_, TEnum (en, _)) -> en + | _ -> die "" __LOC__ + in + this#write + (this#op IaEnumI + ^ this#typeText (TEnum (enum, [])) + ^ string_of_int i ^ "\n"); + this#gen_expression expr + | TEnumIndex expr -> + this#write + (this#op IaCallMember + ^ this#typeTextString "::hx::EnumBase" + ^ " " ^ this#stringText "__Index" ^ "0" + ^ this#commentOf "Enum index" + ^ "\n"); + this#gen_expression expr + | TSwitch + { + switch_subject = condition; + switch_cases = cases; + switch_default = optional_default; + } -> ( + this#write + (this#op IaSwitch + ^ string_of_int (List.length cases) + ^ " " + ^ (match optional_default with None -> "0" | Some _ -> "1") + ^ "\n"); + this#gen_expression condition; + List.iter + (fun { case_patterns = cases_list; case_expr = expression } -> + this#writeList ("\t\t\t" ^ indent) (List.length cases_list); + List.iter (fun value -> this#gen_expression value) cases_list; + this#gen_expression expression) + cases; + match optional_default with + | None -> () + | Some expr -> this#gen_expression expr) + | TTry (e, catches) -> + this#writeList (this#op IaTry) (List.length catches); + this#gen_expression e; + List.iter + (fun (tvar, catch_expr) -> + this#write ("\t\t\t" ^ indent); + this#writeVar tvar; + this#write "\n"; + this#gen_expression catch_expr) + catches + | TCast (cast, Some (TClassDecl t)) -> + this#write (this#op IaTCast ^ this#typeText (TInst (t, [])) ^ "\n"); + this#gen_expression cast + | TCast (cast, _) -> this#checkCast expression.etype cast true true + | TParenthesis _ -> abort "Unexpected parens" expression.epos + | TMeta (_, _) -> abort "Unexpected meta" expression.epos + | TIdent _ -> abort "Unexpected ident" expression.epos + + (* } *) + method gen_expression_tree expression_tree = + (* { *) + let rec gen_expression expression = + this#begin_expr; + this#writeCppPos expression; + let rec match_expr expression = + match expression.cppexpr with + | CppBlock (exprs, closures, _) -> + this#writeList (this#op IaBlock) (List.length exprs); + List.iter gen_expression exprs + | CppVarDecl (var, init) -> ( + let name = CppGen.cpp_var_name_of var in + this#write + (this#op IaTVars ^ string_of_int 1 + ^ this#commentOf (name ^ ":" ^ script_type_string var.v_type) + ^ "\n"); + this#write ("\t\t" ^ indent); + match init with + | None -> + this#writeOp IaVarDecl; + this#writeVar var + | Some init -> + this#writeOp IaVarDeclI; + this#writeVar var; + this#write (" " ^ this#astType init.cpptype); + this#write "\n"; + gen_expression init) + | CppInt i -> this#write (this#op IaConstInt ^ Printf.sprintf "%ld " i) + | CppFloat float_as_string -> + this#write (this#op IaConstFloat ^ this#stringText float_as_string) + | CppString s -> this#write (this#op IaConstString ^ this#stringText s) + | CppBool false -> this#writeOp IaConstFalse + | CppBool true -> this#writeOp IaConstTrue + | CppNull -> this#writeOp IaConstNull + | CppNil -> abort "Nil not supported in cppia" expression.cpppos + | CppThis _ -> this#writeOp IaConsThis + | CppSuper _ -> this#writeOp IaConstSuper + | CppBreak -> this#writeOp IaBreak + | CppContinue -> this#writeOp IaContinue + | CppGoto label -> + abort "Goto not supported in cppia" expression.cpppos + | CppReturn None -> this#writeOpLine IaReturn + | CppReturn (Some value) -> + this#write (this#op IaRetVal ^ this#astType value.cpptype ^ "\n"); + gen_expression value + | CppWhile (condition, block, while_flag, _) -> + this#write + (this#op IaWhile + ^ (if while_flag = NormalWhile then "1" else "0") + ^ "\n"); + gen_expression condition; + gen_expression block + | CppIf (condition, block, None) -> + this#writeOpLine IaIf; + gen_expression condition; + gen_expression block + | CppIf (condition, block, Some elze) -> + this#writeOpLine IaIfElse; + gen_expression condition; + gen_expression block; + gen_expression elze + | CppBinop (op, left, right) -> + this#writeOpLine (IaBinOp op); + gen_expression left; + gen_expression right + | CppVar var -> gen_var_loc var + | CppExtern (name, _) -> + abort + ("Unexpected global '" ^ name ^ "' in cppia") + expression.cpppos + | CppSet (lvalue, rvalue) -> + this#writeOpLine IaSet; + gen_lvalue lvalue expression.cpppos; + gen_expression rvalue + | CppCall (func, args) -> + let argN = string_of_int (List.length args) ^ " " in + (match func with + | FuncThis (field, inst) -> + let name = field.cf_name in + this#write + (this#op IaCallThis ^ this#astType inst ^ " " + ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n") + | FuncInstance (expr, _, field) | FuncInterface (expr, _, field) + -> + this#write + (this#op IaCallMember ^ this#astType expr.cpptype ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf field.cf_name + ^ "\n"); + gen_expression expr + | FuncStatic (class_def, _, field) -> + this#write + (this#op IaCallStatic ^ this#cppInstText class_def ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf + (join_class_path class_def.cl_path "." + ^ "." ^ field.cf_name) + ^ "\n") + | FuncTemplate _ -> + abort "Templated function call not supported in cppia" + expression.cpppos + | FuncFromStaticFunction -> + abort "Unexpected FuncFromStaticFunction" expression.cpppos + | FuncEnumConstruct (enum, field) -> + this#write + (this#op IaCreateEnum ^ this#enumText enum ^ " " + ^ this#stringText field.ef_name + ^ argN + ^ this#commentOf field.ef_name + ^ "\n") + | FuncSuperConstruct (TCppInst (klass, _)) + when is_native_gen_class klass && is_native_class klass -> + abort "Unsupported super for native class constructor" + expression.cpppos + | FuncSuperConstruct childType -> + this#write + (this#op IaCallSuperNew ^ this#astType childType ^ " " + ^ argN ^ "\n") + | FuncSuper (_, TCppInst (klass, _), _) + when is_native_gen_class klass && is_native_class klass -> + abort "Unsupported super for native class method" + expression.cpppos + | FuncSuper (_, objType, field) -> + this#write + (this#op IaCallSuper ^ this#astType objType ^ " " + ^ this#stringText field.cf_name + ^ argN + ^ this#commentOf field.cf_name + ^ "\n") + | FuncExtern (name, _) -> + this#write + (this#op IaCallGlobal ^ this#stringText name ^ argN + ^ this#commentOf name ^ "\n") + | FuncNew newType -> + this#write (this#op IaNew ^ this#astType newType ^ argN ^ "\n") + | FuncInternal (obj, "cca", ".") when obj.cpptype = TCppString -> + this#write + (this#op IaCallMember ^ this#astType obj.cpptype ^ " " + ^ this#stringText "cca" ^ argN ^ this#commentOf "cca" ^ "\n" + ); + gen_expression obj + | FuncInternal (obj, name, join) -> + (* abort ("Internal function call '" ^ name ^ "' not supported in cppia") expression.cpppos; *) + this#write + (this#op IaCallMember ^ this#astType obj.cpptype ^ " " + ^ this#stringText name ^ argN ^ this#commentOf name ^ "\n"); + gen_expression obj + | FuncExpression expr -> + this#write (this#op IaCall ^ argN ^ "\n"); + gen_expression expr); + List.iter gen_expression args + | CppFunction (func, _) -> ( + match func with + | FuncThis (field, inst) -> + this#write + (this#op IaFThisName ^ this#astType inst ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf + (script_cpptype_string inst ^ "." ^ field.cf_name)) + | FuncInternal (expr, name, _) -> + this#write + (this#op IaFLink ^ this#astType expr.cpptype ^ " " + ^ this#stringText name + ^ this#commentOf + ("Internal " + ^ script_cpptype_string expr.cpptype + ^ "." ^ name) + ^ "\n"); + gen_expression expr + | FuncInstance (expr, _, field) | FuncInterface (expr, _, field) + -> + this#write + (this#op IaFName ^ this#astType expr.cpptype ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf + (script_cpptype_string expr.cpptype + ^ "." ^ field.cf_name) + ^ "\n"); + gen_expression expr + | FuncStatic (class_def, _, field) -> + this#write + (this#op IaFStatic ^ this#cppInstText class_def ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name) + | FuncExpression expr -> match_expr expr + | FuncExtern (name, _) -> + abort + ("Can't create extern " ^ name ^ " closure") + expression.cpppos + | FuncSuper _ | FuncSuperConstruct _ -> + abort "Can't create super closure" expression.cpppos + | FuncNew _ -> abort "Can't create new closure" expression.cpppos + | FuncEnumConstruct _ -> + abort "Enum constructor outside of CppCall" expression.cpppos + | FuncFromStaticFunction -> + abort "Can't create cpp.Function.fromStaticFunction closure" + expression.cpppos + | FuncTemplate _ -> + abort "Can't create template function closure" + expression.cpppos) + | CppPosition (file, line, class_name, meth) -> + this#write + (this#op IaPosInfo ^ this#stringText file + ^ Printf.sprintf "%ld" line ^ " " ^ this#stringText class_name + ^ " " ^ this#stringText meth) + | CppNullCompare ("IsNull", e) -> + this#writeOpLine IaIsNull; + gen_expression e + | CppNullCompare (_, e) -> + this#writeOpLine IaNotNull; + gen_expression e + | CppCompare (_, left, right, op) -> + this#writeOpLine (IaBinOp op); + gen_expression left; + gen_expression right + | CppArray arrayLoc -> gen_array arrayLoc expression.cpppos + | CppArrayDecl exprList -> + this#write + (this#op IaADef + ^ this#astType expression.cpptype + ^ " " + ^ string_of_int (List.length exprList) + ^ "\n"); + List.iter gen_expression exprList + | CppEnumField (enum, field) -> + this#write + (this#op IaFEnum ^ this#enumText enum ^ " " + ^ this#stringText field.ef_name + ^ this#commentOf field.ef_name) + | CppEnumIndex obj -> + (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *) + this#write + (this#op IaCallMember + ^ this#typeTextString "::hx::EnumBase" + ^ " " ^ this#stringText "__Index" ^ "0" + ^ this#commentOf "Enum index" + ^ "\n"); + gen_expression obj + | CppDynamicField (obj, name) -> + this#write + (this#op IaFName + ^ this#typeTextString "Dynamic" + ^ " " ^ this#stringText name ^ this#commentOf name ^ "\n"); + gen_expression obj + | CppClassOf (path, native) -> + let klass = join_class_path path "." in + this#write + (this#op IaClassOf ^ this#typeTextString klass + ^ this#commentOf klass) + | CppEnumParameter (obj, field, index) -> + this#write + (this#op IaEnumI + ^ this#typeTextString "Dynamic" + ^ string_of_int index ^ "\n"); + gen_expression obj + | CppClosure closure -> + this#write + (this#op IaFun + ^ this#astType closure.close_type + ^ string_of_int (List.length closure.close_args) + ^ "\n"); + let close = this#gen_func_args closure.close_args in + gen_expression closure.close_expr; + close () + | CppObjectDecl (values, isStruct) -> + this#write (this#op IaObjDef ^ string_of_int (List.length values)); + this#write " "; + List.iter + (fun (name, _) -> this#write (this#stringText name)) + values; + this#write "\n"; + List.iter (fun (_, e) -> gen_expression e) values + | CppCrement (incFlag, preFlag, lvalue) -> + let op = + match (incFlag, preFlag) with + | CppIncrement, Prefix -> IaPlusPlus + | CppIncrement, Postfix -> IaPlusPlusPost + | CppDecrement, Prefix -> IaMinusMinus + | CppDecrement, Postfix -> IaMinusMinusPost + in + this#writeOpLine op; + gen_lvalue lvalue expression.cpppos + | CppModify (op, lvalue, rvalue) -> + this#writeOpLine (IaBinOp (OpAssignOp op)); + gen_lvalue lvalue expression.cpppos; + gen_expression rvalue + | CppUnop (op, expr) -> + let op = + match op with + | CppNot -> IaLogicNot + | CppNeg -> IaNeg + | CppNegBits -> IaBitNot + in + this#writeOpLine op; + gen_expression expr + | CppThrow value -> + this#writeOpLine IaThrow; + gen_expression value + | CppTry (block, catches) -> + this#writeList (this#op IaTry) (List.length catches); + gen_expression block; + List.iter + (fun (tvar, catch_expr) -> + this#write ("\t\t\t" ^ indent); + this#writeVar tvar; + this#write "\n"; + gen_expression catch_expr) + catches + | CppIntSwitch _ -> + abort "CppIntSwitch not supported in cppia" expression.cpppos + | CppSwitch (condition, _, cases, optional_default, _) -> ( + this#write + (this#op IaSwitch + ^ string_of_int (List.length cases) + ^ " " + ^ (match optional_default with None -> "0" | Some _ -> "1") + ^ "\n"); + gen_expression condition; + List.iter + (fun (cases_list, expression) -> + this#writeList ("\t\t\t" ^ indent) (List.length cases_list); + List.iter (fun value -> gen_expression value) cases_list; + gen_expression expression) + cases; + match optional_default with + | None -> () + | Some expr -> gen_expression expr) + | CppTCast (expr, toType) -> + this#write (this#op IaTCast ^ this#astType toType ^ "\n"); + gen_expression expr + | CppCast (expr, toType) -> ( + match toType with + | TCppDynamicArray -> + this#write (this#op IaToDynArray ^ "\n"); + gen_expression expr + | TCppObjectArray _ -> + this#write + (this#op IaToDataArray + ^ this#typeTextString "Array.Object" + ^ "\n"); + gen_expression expr + | TCppScalarArray t -> + this#write + (this#op IaToDataArray + ^ this#typeTextString ("Array." ^ script_cpptype_string t) + ^ "\n"); + gen_expression expr + | _ -> match_expr expr) + | CppCastScalar (expr, "bool") -> + this#writeOpLine IaCastBool; + gen_expression expr + | CppCastScalar (expr, "int") -> + this#writeOpLine IaCastInt; + gen_expression expr + | CppCastScalar (expr, "Float") -> + this#write + (this#op IaTCast ^ this#astType (TCppScalar "Float") ^ "\n"); + gen_expression expr + | CppCastScalar (expr, _) -> match_expr expr + | CppCastVariant expr -> match_expr expr + | CppCastStatic (expr, _) -> match_expr expr + | CppNullAccess -> + this#writeOpLine IaThrow; + this#begin_expr; + this#writeCppPos expression; + this#write (this#op IaConstString ^ this#stringText "Null access"); + this#end_expr + | CppCode _ | CppFunctionAddress _ | CppNewNative _ | CppDereference _ + | CppAddressOf _ | CppFor _ | CppCastObjC _ | CppCastObjCBlock _ + | CppCastProtocol _ | CppCastNative _ -> + abort + ("Unsupported operation in cppia :" ^ s_tcpp expression.cppexpr) + expression.cpppos + (*| x -> print_endline ("Unknown cppexpr " ^ (s_tcpp x) );*) + in + + match_expr expression; + this#end_expr + and gen_array arrayLoc pos = + match arrayLoc with + | ArrayObject (arrayObj, index, _) | ArrayTyped (arrayObj, index, _) -> + this#write (this#op IaArrayI ^ this#astType arrayObj.cpptype ^ "\n"); + gen_expression arrayObj; + gen_expression index + | ArrayPointer (_, _) | ArrayRawPointer (_, _) -> + abort "Unvalid array access in cppia" pos + | ArrayVirtual (arrayObj, index) + | ArrayImplements (_, arrayObj, index) + | ArrayDynamic (arrayObj, index) -> + this#write (this#op IaArrayI ^ this#astType arrayObj.cpptype ^ "\n"); + gen_expression arrayObj; + gen_expression index + and gen_lvalue lvalue pos = + this#begin_expr; + this#wpos pos; + (match lvalue with + | CppVarRef varLoc -> gen_var_loc varLoc + | CppArrayRef arrayLoc -> gen_array arrayLoc pos + | CppExternRef (name, _) -> + abort ("Unsupported extern '" ^ name ^ "' in cppia") pos + | CppDynamicRef (expr, name) -> + let typeText = this#typeTextString "Dynamic" in + this#write + (this#op IaFName ^ typeText ^ " " ^ this#stringText name + ^ this#commentOf name ^ "\n"); + gen_expression expr); + this#end_expr + and gen_var_loc loc = + match loc with + | VarClosure var | VarLocal var -> + this#write + (this#op IaVar ^ string_of_int var.v_id + ^ this#commentOf var.v_name) + | VarStatic (class_def, _, field) -> + this#write + (this#op IaFStatic ^ this#cppInstText class_def ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name) + | VarThis (field, thisType) -> + this#write + (this#op IaFThisInst ^ this#astType thisType ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf field.cf_name) + | VarInstance (obj, field, _, _) | VarInterface (obj, field) -> + let objType = script_cpptype_string obj.cpptype in + this#write + (this#op IaFLink ^ this#astType obj.cpptype ^ " " + ^ this#stringText field.cf_name + ^ this#commentOf (objType ^ "." ^ field.cf_name) + ^ "\n"); + gen_expression obj + | VarInternal (obj, _, name) -> + let objType = script_cpptype_string obj.cpptype in + this#write + (this#op IaFLink ^ this#astType obj.cpptype ^ " " + ^ this#stringText name + ^ this#commentOf (objType ^ "." ^ name) + ^ "\n"); + gen_expression obj + (* + and get_array_type elem = + this#stringText (script_cpptype_string elem.cpptype); + *) + in + gen_expression expression_tree + end + +let generate_script_class common_ctx script class_def = + script#incClasses; + let classText = join_class_path class_def.cl_path "." in + script#comment ("Class " ^ classText); + script#writeOp + (if has_class_flag class_def CInterface then IaInterface else IaClass); + script#instName class_def; + (match class_def.cl_super with + | None -> script#ident "" + | Some (c, _) -> script#instName c); + script#wint (List.length class_def.cl_implements); + List.iter (fun (c, _) -> script#instName c) class_def.cl_implements; + script#write "\n"; + (* Looks like some map impl classes have their bodies discarded - not sure best way to filter *) + let non_dodgy_function allow_empty field = + has_class_flag class_def CInterface + || + match (field.cf_kind, field.cf_expr) with + | Var _, _ -> true + | Method MethDynamic, _ -> true + | Method MethNormal, None when allow_empty -> true + | Method _, Some _ -> true + | _ -> false + in + let ordered_statics = + List.filter (non_dodgy_function false) class_def.cl_ordered_statics + in + let ordered_fields = + List.filter (non_dodgy_function true) class_def.cl_ordered_fields + in + script#write + (string_of_int + (List.length ordered_fields + + List.length ordered_statics + + (match class_def.cl_constructor with Some _ -> 1 | _ -> 0) + + match TClass.get_cl_init class_def with Some _ -> 1 | _ -> 0) + ^ "\n"); + + let generate_field isStatic field = + match (field.cf_kind, follow field.cf_type) with + | Var { v_read = AccInline; v_write = AccNever }, _ -> + script#writeOpLine IaInline + | Var v, _ -> + let mode_code mode = + match mode with + | AccNormal | AccCtor -> IaAccessNormal + | AccNo -> IaAccessNot + | AccNever -> IaAccessNot + | AccCall -> + if + Meta.has Meta.NativeProperty class_def.cl_meta + || Meta.has Meta.NativeProperty field.cf_meta + || Gctx.defined common_ctx Define.ForceNativeProperty + then IaAccessCallNative + else IaAccessCall + | AccInline -> IaAccessNormal + | AccRequire (_, _) -> IaAccessNormal + in + let isExtern = not (is_physical_field field) in + script#var (mode_code v.v_read) (mode_code v.v_write) isExtern isStatic + field.cf_name field.cf_type field.cf_expr + | Method MethDynamic, TFun (args, ret) -> + script#func isStatic true field.cf_name ret args + (has_class_flag class_def CInterface) + field.cf_expr field.cf_pos + | Method _, TFun (args, ret) when field.cf_name = "new" -> + script#func true false "new" + (TInst (class_def, [])) + args false field.cf_expr field.cf_pos + | Method _, TFun (args, ret) -> + script#func isStatic false field.cf_name ret args + (has_class_flag class_def CInterface) + field.cf_expr field.cf_pos + | Method _, _ -> + print_endline + ("Unknown method type " + ^ join_class_path class_def.cl_path "." + ^ "." ^ field.cf_name) + in + (match class_def.cl_constructor with + | Some field -> generate_field true field + | _ -> ()); + (match TClass.get_cl_init class_def with + | Some expression -> script#voidFunc true false "__init__" expression + | _ -> ()); + + List.iter (generate_field false) ordered_fields; + List.iter (generate_field true) ordered_statics; + script#write "\n" + +let generate_script_enum script enum_def meta = + script#incClasses; + let sorted_items = + List.sort + (fun f1 f2 -> f1.ef_index - f2.ef_index) + (pmap_values enum_def.e_constrs) + in + script#writeList + (script#op IaEnum ^ script#enumText enum_def) + (List.length sorted_items); + + List.iter + (fun constructor -> + let name = script#stringText constructor.ef_name in + match constructor.ef_type with + | TFun (args, _) -> + script#write (name ^ " " ^ string_of_int (List.length args)); + List.iter + (fun (arg, _, t) -> + script#write + (" " ^ script#stringText arg ^ " " ^ script#typeText t)) + args; + script#write "\n" + | _ -> script#write (name ^ " 0\n")) + sorted_items; + + match meta with + | Some expr -> + script#write "1\n"; + script#gen_expression expr + | _ -> + script#write "0\n"; + script#write "\n" + +let generate_cppia ctx = + let common_ctx = ctx.ctx_common in + let debug = ctx.ctx_debug_level in + Path.mkdir_from_path common_ctx.file; + let script = new script_writer ctx common_ctx.file common_ctx.debug in + ignore (script#stringId ""); + ignore (script#typeId ""); + + List.iter + (fun object_def -> + match object_def with + | TClassDecl class_def when has_class_flag class_def CExtern -> + () (*if (gen_externs) then gen_extern_class common_ctx class_def;*) + | TClassDecl class_def -> + let is_internal = is_internal_class class_def.cl_path in + if is_internal || Meta.has Meta.Macro class_def.cl_meta then ( + if debug >= 4 then + print_endline + (" internal class " ^ join_class_path class_def.cl_path ".")) + else generate_script_class common_ctx script class_def + | TEnumDecl enum_def when has_enum_flag enum_def EnExtern -> () + | TEnumDecl enum_def -> + let is_internal = is_internal_class enum_def.e_path in + if is_internal then ( + if debug >= 4 then + print_endline + (" internal enum " ^ join_class_path enum_def.e_path ".")) + else + let meta = Texpr.build_metadata common_ctx.basic object_def in + if has_enum_flag enum_def EnExtern then + if debug >= 4 then + print_endline + ("external enum " ^ join_class_path enum_def.e_path "."); + generate_script_enum script enum_def meta + | TTypeDecl _ | TAbstractDecl _ -> (* already done *) ()) + common_ctx.types; + + (match common_ctx.main.main_expr with + | None -> script#writeOpLine IaNoMain + | Some e -> + script#writeOpLine IaMain; + script#gen_expression e); + + script#write + (script#op IaResources + ^ string_of_int (Hashtbl.length common_ctx.resources) + ^ "\n"); + Hashtbl.iter + (fun name data -> + script#write + (script#op IaReso ^ script#stringText name + ^ string_of_int (String.length data) + ^ "\n")) + common_ctx.resources; + Hashtbl.iter (fun _ data -> script#writeData data) common_ctx.resources; + + script#close diff --git a/src/generators/cpp/gen/cppGen.ml b/src/generators/cpp/gen/cppGen.ml new file mode 100644 index 00000000000..f5c9061c6cc --- /dev/null +++ b/src/generators/cpp/gen/cppGen.ml @@ -0,0 +1,2048 @@ +open Ast +open Gctx +open Type +open Error +open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext + +type tinject = { + inj_prologue : bool -> unit; + inj_setvar : string; + inj_tail : string; +} + +let cpp_type_of = CppRetyper.cpp_type_of +let cpp_type_of_null = CppRetyper.cpp_type_of_null +let cpp_instance_type = CppRetyper.cpp_instance_type +let type_to_string haxe_type = tcpp_to_string (cpp_type_of haxe_type) + +let type_cant_be_null haxe_type = + match cpp_type_of haxe_type with TCppScalar _ -> true | _ -> false + +let type_arg_to_string name default_val arg_type prefix = + let remap_name = keyword_remap name in + let type_str = type_to_string arg_type in + match default_val with + | Some { eexpr = TConst TNull } -> (type_str, remap_name) + | Some constant when type_cant_be_null arg_type -> + ("::hx::Null< " ^ type_str ^ " > ", prefix ^ remap_name) + | Some constant -> (type_str, prefix ^ remap_name) + | _ -> (type_str, remap_name) + +let cpp_var_name_of var = + match get_meta_string var.v_meta Meta.Native with + | Some n -> n + | None -> keyword_remap var.v_name + +let cpp_var_debug_name_of v = + match get_meta_string v.v_meta Meta.RealPath with + | Some n -> n + | None -> v.v_name + +(* Generate prototype text, including allowing default values to be null *) +let print_arg name default_val arg_type prefix = + let n, t = type_arg_to_string name default_val arg_type prefix in + n ^ " " ^ t + +(* Generate prototype text, including allowing default values to be null *) +let print_arg_name name default_val arg_type prefix = + let n, _ = type_arg_to_string name default_val arg_type prefix in + n + +let print_arg_list arg_list prefix = + String.concat "," + (List.map (fun (v, o) -> print_arg v.v_name o v.v_type prefix) arg_list) + +let print_arg_list_name arg_list prefix = + String.concat "," + (List.map + (fun (v, o) -> print_arg_name v.v_name o v.v_type prefix) + arg_list) + +let print_arg_names args = + String.concat "," (List.map (fun (name, _, _) -> keyword_remap name) args) + +let rec print_tfun_arg_list include_names arg_list = + let oType o arg_type = + let type_str = type_to_string arg_type in + (* type_str may have already converted Null to Dynamic because of NotNull tag ... *) + if o && type_cant_be_null arg_type && type_str <> "Dynamic" then + "::hx::Null< " ^ type_str ^ " > " + else type_str + in + match arg_list with + | [] -> "" + | [ (name, o, arg_type) ] -> + oType o arg_type ^ if include_names then " " ^ keyword_remap name else "" + | (name, o, arg_type) :: remaining -> + oType o arg_type + ^ (if include_names then " " ^ keyword_remap name else "") + ^ "," + ^ print_tfun_arg_list include_names remaining + +let has_new_gc_references class_def = + let is_gc_reference field = + should_implement_field field + && is_data_member field + && not (type_cant_be_null field.cf_type) + in + List.exists is_gc_reference class_def.cl_ordered_fields + +let rec has_gc_references class_def = + (match class_def.cl_super with + | Some def when has_gc_references (fst def) -> true + | _ -> false) + || has_new_gc_references class_def + +let rec find_next_super_iteration class_def = + match class_def.cl_super with + | Some (klass, params) when has_new_gc_references klass -> + tcpp_to_string_suffix "_obj" (cpp_instance_type klass params) + | Some (klass, _) -> find_next_super_iteration klass + | _ -> "" + +let cpp_member_name_of member = + match get_meta_string member.cf_meta Meta.Native with + | Some n -> n + | None -> keyword_remap member.cf_name + +let function_signature include_names tfun abi = + match follow tfun with + | TFun (args, ret) -> + type_to_string ret ^ " " ^ abi ^ "(" + ^ print_tfun_arg_list include_names args + ^ ")" + | _ -> "void *" + +let cpp_no_debug_synbol ctx var = + ctx.ctx_debug_level <= 1 + || (match var.v_kind with VUser _ -> false | _ -> true) + || + match cpp_type_of var.v_type with + | TCppStar _ | TCppReference _ -> true + | TCppInst (class_def, _) when Meta.has Meta.StructAccess class_def.cl_meta -> + true + | TCppInst (class_def, _) when Meta.has Meta.Unreflective class_def.cl_meta -> + true + | _ -> + let name = cpp_var_debug_name_of var in + String.length name > 4 && String.sub name 0 4 = "_hx_" + +let cpp_debug_name_of var = keyword_remap var.v_name +let cpp_debug_var_visible ctx var = not (cpp_no_debug_synbol ctx (fst var)) +let cpp_var_type_of var = tcpp_to_string (cpp_type_of var.v_type) + +let mk_injection prologue set_var tail = + Some { inj_prologue = prologue; inj_setvar = set_var; inj_tail = tail } + +let tvar_arg_to_string tvar default_val prefix = + let remap_name = cpp_var_name_of tvar in + let type_str = cpp_var_type_of tvar in + match default_val with + | Some { eexpr = TConst TNull } -> + (tcpp_to_string (cpp_type_of_null tvar.v_type), remap_name) + | Some constant -> + (tcpp_to_string (cpp_type_of_null tvar.v_type), prefix ^ remap_name) + | _ -> (type_str, remap_name) + +(* Generate prototype text, including allowing default values to be null *) +let cpp_arg_string tvar default_val prefix = + let t, n = tvar_arg_to_string tvar default_val prefix in + t ^ " " ^ n + +let cpp_arg_list args prefix = + String.concat "," (List.map (fun (v, o) -> cpp_arg_string v o prefix) args) + +let gen_type ctx haxe_type = ctx.ctx_output (type_to_string haxe_type) + +let cpp_macro_var_type_of var = + let t = tcpp_to_string (cpp_type_of var.v_type) in + if String.contains t ',' then + Str.global_replace (Str.regexp ",") " HX_COMMA " t + else t + +let cpp_class_name klass = + let globalNamespace = + match get_meta_string klass.cl_meta Meta.Native with + | Some _ -> "" + | None -> "::" + in + let path = globalNamespace ^ join_class_path_remap klass.cl_path "::" in + if is_native_class klass || path = "::String" then path else path ^ "_obj" + +let rec implements_native_interface class_def = + List.exists + (fun (intf_def, _) -> + is_native_gen_class intf_def || implements_native_interface intf_def) + class_def.cl_implements + || + match class_def.cl_super with + | Some (i, _) -> implements_native_interface i + | _ -> false + +let can_quick_alloc klass = + (not (is_native_class klass)) && not (implements_native_interface klass) + +let only_stack_access haxe_type = + match cpp_type_of haxe_type with + | TCppInst (klass, _) -> Meta.has Meta.StackOnly klass.cl_meta + | _ -> false + +let cpp_is_static_extension member = + Meta.has Meta.NativeStaticExtension member.cf_meta + +let cpp_enum_name_of field = + match get_meta_string field.ef_meta Meta.Native with + | Some n -> n + | None -> keyword_remap field.ef_name + +let string_of_path path = "::" ^ join_class_path_remap path "::" ^ "_obj" + +let default_value_string ctx value = + match value.eexpr with + | TConst (TInt i) -> Printf.sprintf "%ld" i + | TConst (TFloat float_as_string) -> + "((Float)" ^ Texpr.replace_separators float_as_string "" ^ ")" + | TConst (TString s) -> strq ctx s + | TConst (TBool b) -> if b then "true" else "false" + | TConst TNull -> "null()" + | TField (_, FEnum (enum, field)) -> + string_of_path enum.e_path ^ "::" ^ cpp_enum_name_of field ^ "_dyn()" + | _ -> "/* Hmmm " ^ s_expr_kind value ^ " */" + +let cpp_gen_default_values ctx args prefix = + List.iter + (fun (tvar, o) -> + let vtype = cpp_type_of tvar.v_type in + let not_null = + type_has_meta_key Meta.NotNull tvar.v_type || is_cpp_scalar vtype + in + match o with + | Some { eexpr = TConst TNull } -> () + | Some const -> + let name = cpp_var_name_of tvar in + let spacer = + if ctx.ctx_debug_level > 0 then " \t" else "" + in + let pname = prefix ^ name in + ctx.ctx_output + (spacer ^ "\t" ^ tcpp_to_string vtype ^ " " ^ name ^ " = " ^ pname); + ctx.ctx_output + (if not_null then + ".Default(" ^ default_value_string ctx.ctx_common const ^ ");\n" + else + ";\n" ^ spacer ^ "\tif (::hx::IsNull(" ^ pname ^ ")) " ^ name + ^ " = " + ^ default_value_string ctx.ctx_common const + ^ ";\n") + | _ -> ()) + args + +let ctx_default_values ctx args prefix = cpp_gen_default_values ctx args prefix + +let cpp_class_hash interface = + gen_hash 0 (join_class_path interface.cl_path "::") + +let cpp_template_param path native = + let path = "::" ^ join_class_path_remap path "::" in + if native then path + else + match path with + | "::Array" -> "::hx::ArrayBase" + | "::Int" -> "int" + | "::Bool" -> "bool" + | x -> x + +let rec is_constant_zero expr = + match expr.cppexpr with + | CppFloat x when float_of_string x = 0.0 -> true + | CppInt i when i = Int32.zero -> true + | CppCastScalar (expr, _) -> is_constant_zero expr + | _ -> false + +let cpp_is_const_scalar_array arrayType expressions = + List.length expressions > 0 + && + match arrayType with + | TCppScalarArray _ -> + List.for_all + (fun expr -> + match expr.cppexpr with + | CppInt _ | CppFloat _ | CppString _ | CppBool _ -> true + | _ -> false) + expressions + | _ -> false + +let list_num l = string_of_int (List.length l) + +(* This gets the class include order correct. In the header files, we forward declare + the class types so the header file does not have any undefined variables. + In the cpp files, we include all the required header files, providing the actual + types for everything. This way there is no problem with circular class references. +*) +let gen_forward_decl writer class_path isNative = + let output = writer#write in + match class_path with + | [ "@verbatim" ], file -> writer#write (guarded_include file) + | _ -> + let name = fst (remap_class_path class_path) in + output + ((if isNative then "HX_DECLARE_NATIVE" else "HX_DECLARE_CLASS") + ^ list_num name ^ "("); + List.iter (fun package_part -> output (package_part ^ ",")) name; + output (snd class_path ^ ")\n") + +let format_code code = String.concat "\n" (ExtString.String.nsplit code "\r\n") + +let get_meta_string_full_filename meta key = + let rec loop = function + | [] -> "" + | (k, _, pos) :: _ when k = key -> + if Filename.is_relative pos.pfile then + Path.normalize_path (Filename.concat (Sys.getcwd ()) pos.pfile) + else pos.pfile + | _ :: l -> loop l + in + loop meta + +let get_meta_string_full_dirname meta key = + let name = get_meta_string_full_filename meta key in + try Path.normalize_path (Filename.dirname name) + with Invalid_argument _ -> "" + +let get_code meta key = + let code = get_meta_string meta key |> Option.default "" in + let magic_var = "${GENCPP_SOURCE_DIRECTORY}" in + let code = + if ExtString.String.exists code magic_var then + let source_directory = get_meta_string_full_dirname meta key in + let _, code = ExtString.String.replace code magic_var source_directory in + code + else code + in + if code <> "" then format_code code ^ "\n" else code + +let get_class_code class_def key = + match class_def.cl_kind with + | KAbstractImpl abstract_def -> + let value = get_code abstract_def.a_meta key in + value + | _ -> get_code class_def.cl_meta key + +let with_debug ctx metadata run = + let old_debug = ctx.ctx_debug_level in + let no_debug = Meta.has Meta.NoDebug metadata in + if no_debug then ctx.ctx_debug_level <- 0; + run no_debug; + ctx.ctx_debug_level <- old_debug + +let hx_stack_push ctx output clazz func_name pos gc_stack = + if ctx.ctx_debug_level > 0 then ( + let stripped_file = strip_file ctx.ctx_common pos.pfile in + let esc_file = StringHelper.s_escape stripped_file in + ctx.ctx_file_info := PMap.add stripped_file pos.pfile !(ctx.ctx_file_info); + let full_name = + clazz ^ "." ^ func_name + ^ + if clazz = "*" then + " (" ^ esc_file ^ ":" ^ string_of_int (Lexer.get_error_line pos) ^ ")" + else "" + in + + let hash_class_func = gen_hash 0 (clazz ^ "." ^ func_name) in + let hash_file = gen_hash 0 stripped_file in + + let lineName = string_of_int (Lexer.get_error_line pos) in + incr ctx.ctx_file_id; + let classId = hash64 (clazz ^ "." ^ stripped_file) in + let varName = "_hx_pos_" ^ classId ^ "_" ^ lineName ^ "_" ^ func_name in + let decl = + varName ^ ",\"" ^ clazz ^ "\",\"" ^ func_name ^ "\"," ^ hash_class_func + ^ ",\"" ^ full_name ^ "\",\"" ^ esc_file ^ "\"," ^ lineName ^ "," + ^ hash_file + in + if ctx.ctx_is_header then + ctx.ctx_writer#write_h_unique + ("HX_DECLARE_STACK_FRAME" ^ "(" ^ varName ^ ")\n") + else + ctx.ctx_writer#write_h_unique + ((if func_name = "new" then "HX_DEFINE_STACK_FRAME" + else "HX_LOCAL_STACK_FRAME") + ^ "(" ^ decl ^ ")\n"); + output + ((if gc_stack then "HX_GC_STACKFRAME" else "HX_STACKFRAME") + ^ "(&" ^ varName ^ ")\n")) + else if gc_stack then output "HX_JUST_GC_STACKFRAME\n" + +(* Add include to source code *) +let add_include writer class_path = writer#add_include class_path + +let real_interfaces = + List.filter (function t, pl -> + (match (t, pl) with + | { cl_path = [ "cpp"; "rtti" ], _ }, [] -> false + | _ -> true)) + +let native_field_name_remap is_static field = + let remap_name = keyword_remap field.cf_name in + if not is_static then remap_name + else + match get_meta_string field.cf_meta Meta.Native with + | Some nativeImpl -> + let r = Str.regexp "^[a-zA-Z_0-9]+$" in + if Str.string_match r remap_name 0 then "_hx_" ^ remap_name + else "_hx_f" ^ gen_hash 0 remap_name + | None -> remap_name + +let rec is_dynamic_accessor name acc field class_def = + acc ^ "_" ^ field.cf_name = name + && (not (List.exists (fun f -> f.cf_name = name) class_def.cl_ordered_fields)) + && + match class_def.cl_super with + | None -> true + | Some (parent, _) -> is_dynamic_accessor name acc field parent + +(* Builds inheritance tree, so header files can include parents defs. *) +let create_super_dependencies common_ctx = + let result = Hashtbl.create 0 in + let real_non_native_interfaces = + List.filter (function t, pl -> + (match (t, pl) with + | { cl_path = [ "cpp"; "rtti" ], _ }, [] -> false + | _ -> not (is_native_gen_class t))) + in + let iterator object_def = + match object_def with + | TClassDecl class_def when not (has_class_flag class_def CExtern) -> + let deps = ref [] in + (match class_def.cl_super with + | Some super -> + if not (has_class_flag (fst super) CExtern) then + deps := (fst super).cl_path :: !deps + | _ -> ()); + List.iter + (fun imp -> + if not (has_class_flag (fst imp) CExtern) then + deps := (fst imp).cl_path :: !deps) + (real_non_native_interfaces class_def.cl_implements); + Hashtbl.add result class_def.cl_path !deps + | TEnumDecl enum_def when not (has_enum_flag enum_def EnExtern) -> + Hashtbl.add result enum_def.e_path [] + | _ -> () + in + List.iter iterator common_ctx.types; + result + +let can_inline_constructor baseCtx class_def super_deps constructor_deps = + match class_def.cl_constructor with + | Some { cf_expr = Some super_func } -> + let is_simple = ref true in + let rec check_simple e = + (match e.eexpr with + | TReturn _ -> is_simple := false + | TArrayDecl e when List.length e > 0 -> is_simple := false + | _ -> ()); + if !is_simple then Type.iter check_simple e + in + check_simple super_func; + !is_simple + && + let rec known_classes class_def so_far = + match class_def.cl_super with + | Some super -> known_classes (fst super) ((fst super).cl_path :: so_far) + | _ -> so_far + in + let allowed = known_classes class_def [ class_def.cl_path ] in + (* Check to see if all the types required by the constructor are already in the header *) + (* This is quite restrictive, since most classes are forward-declared *) + let deps, _ = + CppReferences.find_referenced_types_flags baseCtx (TClassDecl class_def) + "new" super_deps constructor_deps false false true + in + List.for_all (fun dep -> List.mem dep allowed) deps + | _ -> true + +let create_constructor_dependencies common_ctx = + let result = Hashtbl.create 0 in + List.iter + (fun object_def -> + match object_def with + | TClassDecl class_def when not (has_class_flag class_def CExtern) -> ( + match class_def.cl_constructor with + | Some func_def -> Hashtbl.add result class_def.cl_path func_def + | _ -> ()) + | _ -> ()) + common_ctx.types; + result + +let begin_namespace output class_path = + List.iter + (fun namespace -> output ("namespace " ^ namespace ^ "{\n")) + (List.map keyword_remap (fst class_path)) + +let end_namespace output class_path = + List.iter + (fun namespace -> output ("}" ^ " // end namespace " ^ namespace ^ "\n")) + (fst class_path) + +let begin_header_file output_h def_string nativeGen = + output_h ("#ifndef INCLUDED_" ^ def_string ^ "\n"); + output_h ("#define INCLUDED_" ^ def_string ^ "\n\n"); + output_h "#ifndef HXCPP_H\n"; + if nativeGen then ( + output_h "#ifdef HXCPP_API_LEVEL\n"; + output_h "#include \n"; + output_h "#else\n"; + output_h "#include \n"; + output_h "#endif\n") + else output_h "#include \n"; + output_h "#endif\n\n" + +let end_header_file output_h def_string = + output_h ("\n#endif /* INCLUDED_" ^ def_string ^ " */ \n") + +let cpp_tfun_signature include_names args return_type = + let argList = print_tfun_arg_list include_names args in + let returnType = type_to_string return_type in + "( " ^ returnType ^ " (::hx::Object::*)(" ^ argList ^ "))" + +exception FieldFound of tclass_field + +let find_class_implementation class_def name interface = + let rec find def = + List.iter + (fun f -> if f.cf_name = name then raise (FieldFound f)) + def.cl_ordered_fields; + match def.cl_super with Some (def, _) -> find def | _ -> () + in + try + find class_def; + abort + ("Could not find implementation of " ^ name ^ " in " + ^ join_class_path class_def.cl_path "." + ^ " required by " + ^ join_class_path interface.cl_path ".") + class_def.cl_pos + with FieldFound field -> ( + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> "" + | TFun (args, return_type), Method _ -> + cpp_tfun_signature false args return_type + | _, _ -> "") + +let gen_gc_name class_path = + let class_name_text = join_class_path class_path "." in + const_char_star class_name_text + +(* All interfaces (and sub-interfaces) implemented *) +let implementations class_def = + let implemented_hash = Hashtbl.create 0 in + let native_implemented = Hashtbl.create 0 in + + let cpp_interface_impl_name interface = + "_hx_" ^ join_class_path interface.cl_path "_" + in + let iterator impl = + let rec descend_interface interface = + let intf_def = fst interface in + let interface_name = cpp_interface_impl_name intf_def in + let hash = + if is_native_gen_class intf_def then native_implemented + else implemented_hash + in + if not (Hashtbl.mem hash interface_name) then ( + Hashtbl.replace hash interface_name intf_def; + List.iter descend_interface intf_def.cl_implements); + match intf_def.cl_super with + | Some (interface, params) -> descend_interface (interface, params) + | _ -> () + in + descend_interface impl + in + + List.iter iterator (real_interfaces class_def.cl_implements); + (implemented_hash, native_implemented) + +let needed_interface_functions implemented_instance_fields + native_implementations = + let have = + List.map (fun field -> (field.cf_name, ())) implemented_instance_fields + |> List.to_seq |> Hashtbl.of_seq + in + let want = ref [] in + Hashtbl.iter + (fun _ intf_def -> + List.iter + (fun field -> + if not (Hashtbl.mem have field.cf_name) then ( + Hashtbl.replace have field.cf_name (); + want := field :: !want)) + intf_def.cl_ordered_fields) + native_implementations; + !want + +let gen_cpp_ast_expression_tree ctx class_name func_name function_args + function_type injection tree = + let writer = ctx.ctx_writer in + let out = ctx.ctx_output in + let lastLine = ref (-1) in + let tempId = ref 0 in + let strq = strq ctx.ctx_common in + + let spacer = if ctx.ctx_debug_level > 0 then " \t" else "" in + let output_i value = + out spacer; + writer#write_i value + in + + let output_p expr value = + if ctx.ctx_debug_level > 0 then ( + let line = Lexer.get_error_line expr.cpppos in + let lineName = Printf.sprintf "%4d" line in + let macro = if line != !lastLine then "HXLINE" else "HXDLIN" in + out (macro ^ "(" ^ lineName ^ ")\t"); + lastLine := line); + writer#write_i value + in + + let forInjection = + match injection with Some inject -> inject.inj_setvar <> "" | _ -> false + in + + let cppTree = + CppRetyper.expression ctx TCppVoid function_args function_type tree + forInjection + in + let label_name i = Printf.sprintf "_hx_goto_%i" i in + let class_hash = gen_hash_small 0 class_name in + + let rec gen_with_injection injection expr new_line = + (match expr.cppexpr with + | CppBlock (exprs, closures, gc_stack) -> + writer#begin_block; + List.iter gen_closure closures; + (match injection with + | Some inject -> inject.inj_prologue gc_stack + | _ -> ()); + let remaining = ref (List.length exprs) in + lastLine := Lexer.get_error_line tree.epos; + List.iter + (fun e -> + output_p e ""; + (if !remaining = 1 then + match injection with + | Some inject -> out inject.inj_setvar + | _ -> ()); + gen e; + decr remaining; + writer#terminate_line) + exprs; + (match injection with Some inject -> out inject.inj_tail | _ -> ()); + out spacer; + if new_line then writer#end_block else writer#end_block_line + | CppInt i -> + out + (Printf.sprintf + (if i > Int32.of_int (-1000000000) && i < Int32.of_int 1000000000 + then "%ld" + else "(int)%ld") + i) + | CppFloat float_as_string -> out ("((Float)" ^ float_as_string ^ ")") + | CppString s -> out (strq s) + | CppBool b -> out (if b then "true" else "false") + | CppNull -> out "null()" + | CppNil -> out "nil" + | CppThis ThisReal -> out "::hx::ObjectPtr(this)" + | CppThis _ -> out "__this" + | CppSuper thiscall -> + out + ("::hx::ObjectPtr(" + ^ (if thiscall = ThisReal then "this" else "__this.mPtr") + ^ ")") + | CppBreak -> out "break" + | CppContinue -> out "continue" + | CppGoto label -> out ("goto " ^ label_name label) + | CppVarDecl (var, init) -> ( + let name = cpp_var_name_of var in + (if cpp_no_debug_synbol ctx var then + out (cpp_var_type_of var ^ " " ^ name) + else + let dbgName = cpp_var_debug_name_of var in + let macro = if init = None then "HX_VAR" else "HX_VARI" in + let varType = cpp_macro_var_type_of var in + if name <> dbgName then + out + (macro ^ "_NAME( " ^ varType ^ "," ^ name ^ ",\"" ^ dbgName + ^ "\")") + else out (macro ^ "( " ^ varType ^ "," ^ name ^ ")")); + match init with + | Some init -> + out " = "; + gen init + | _ -> ()) + | CppEnumIndex obj -> + gen obj; + if cpp_is_dynamic_type obj.cpptype then + out ".StaticCast< ::hx::EnumBase >()"; + out "->_hx_getIndex()" + | CppNullAccess -> out ("::hx::Throw(" ^ strq "Null access" ^ ")") + | CppFunction (func, _) -> ( + match func with + | FuncThis (field, _) -> + out ("this->" ^ cpp_member_name_of field ^ "_dyn()") + | FuncInstance (expr, inst, field) -> + gen expr; + out + ((if expr.cpptype = TCppString || inst = InstStruct then "." + else "->") + ^ cpp_member_name_of field ^ "_dyn()") + | FuncInterface (expr, _, field) -> + gen expr; + out ("->__Field(" ^ strq field.cf_name ^ ", ::hx::paccDynamic)") + | FuncStatic (clazz, _, field) -> ( + match get_meta_string field.cf_meta Meta.Native with + | Some n -> out n + | None -> + out (cpp_class_name clazz); + out ("::" ^ cpp_member_name_of field ^ "_dyn()")) + | FuncExpression expr -> gen expr + | FuncExtern (name, isGlobal) -> + if isGlobal then out " ::"; + out name + | FuncInternal (expr, name, _) -> + gen expr; + out ("->__Field(" ^ strq name ^ ",::hx::paccDynamic)") + | FuncSuper _ | FuncSuperConstruct _ -> + abort "Can't create super closure" expr.cpppos + | FuncNew _ -> abort "Can't create new closure" expr.cpppos + | FuncEnumConstruct _ -> + abort "Enum constructor outside of CppCall" expr.cpppos + | FuncFromStaticFunction -> + abort "Can't create cpp.Function.fromStaticFunction closure" + expr.cpppos + | FuncTemplate _ -> + abort "Can't create template function closure" expr.cpppos) + | CppCall (FuncInterface (expr, clazz, field), args) + when not (is_native_gen_class clazz) -> + out (cpp_class_name clazz ^ "::" ^ cpp_member_name_of field ^ "("); + gen expr; + List.iter + (fun arg -> + out ","; + gen arg) + args; + out ")" + | CppCall ((FuncStatic (_, true, field) as func), arg_list) + | CppCall ((FuncInstance (_, InstObjC, field) as func), arg_list) -> + out "[ "; + (match func with + | FuncStatic (cl, _, _) -> out (join_class_path_remap cl.cl_path "::") + | FuncInstance (expr, _, _) -> gen expr + | _ -> ()); + + let names = ExtString.String.nsplit field.cf_name ":" in + let field_name, arg_names = + match names with + | name :: args -> (name, args) + | _ -> die "" __LOC__ (* per nsplit specs, this should never happen *) + in + out (" " ^ field_name); + (try + match (arg_list, arg_names) with + | [], _ -> () + | [ single_arg ], _ -> + out ": "; + gen single_arg + | first_arg :: args, arg_names -> + out ": "; + gen first_arg; + List.iter2 + (fun arg arg_name -> + out (" " ^ arg_name ^ ": "); + gen arg) + args arg_names + with Invalid_argument _ -> + (* not all arguments names are known *) + abort + ("The function called here with name " ^ String.concat ":" names + ^ " does not contain the right amount of arguments' names as \ + required" ^ " by the objective-c calling / naming convention:" + ^ " expected " + ^ string_of_int (List.length arg_list) + ^ " and found " + ^ string_of_int (List.length arg_names)) + expr.cpppos); + out " ]" + | CppCall (FuncNew (TCppInst (klass, p)), args) when can_quick_alloc klass + -> + out (cpp_class_path_of klass p ^ "_obj::__alloc( HX_CTX "); + List.iter + (fun arg -> + out ","; + gen arg) + args; + out ")" + | CppCall (func, args) -> + let doCall = ref true in + let closeCall = ref "" in + let argsRef = ref args in + (match func with + | FuncThis (field, _) -> out ("this->" ^ cpp_member_name_of field) + | FuncInstance (expr, inst, field) -> + let operator = + if expr.cpptype = TCppString || inst = InstStruct then "." + else "->" + in + gen expr; + out (operator ^ cpp_member_name_of field) + | FuncInterface (expr, _, field) -> + gen expr; + out ("->" ^ cpp_member_name_of field) + | FuncStatic (clazz, false, field) when cpp_is_static_extension field + -> ( + match args with + | fst :: remaining -> + argsRef := remaining; + gen fst; + out ("->" ^ cpp_member_name_of field) + | _ -> + abort "Native static extensions must have at least 1 argument" + expr.cpppos) + | FuncStatic (clazz, _, field) -> ( + match get_meta_string field.cf_meta Meta.Native with + | Some rename -> + (* This is the case if you use @:native('new foo'). c++ wil group the space undesirably *) + if String.contains rename ' ' then ( + out "("; + closeCall := ")"); + out rename + | None -> + out (cpp_class_name clazz); + out ("::" ^ cpp_member_name_of field)) + | FuncTemplate (clazz, field, tpath, native) -> + (match get_meta_string field.cf_meta Meta.Native with + | Some rename -> + (* This is the case if you use @:native('new foo'). c++ wil group the space undesirably *) + if String.contains rename ' ' then ( + out "("; + closeCall := ")"); + out rename + | None -> + out (cpp_class_name clazz); + out ("::" ^ cpp_member_name_of field)); + out ("< " ^ cpp_template_param tpath native ^ " >") + | FuncFromStaticFunction -> + abort "Unexpected FuncFromStaticFunction" expr.cpppos + | FuncEnumConstruct (enum, field) -> + out (string_of_path enum.e_path ^ "::" ^ cpp_enum_name_of field) + | FuncSuperConstruct (TCppInst (klass, _)) when is_native_class klass -> + doCall := false + | FuncSuperConstruct _ -> + out + ((if not ctx.ctx_real_this_ptr then "__this->" else "") + ^ "super::__construct") + | FuncSuper (_, TCppInst (klass, p), field) when is_native_class klass + -> + out (cpp_class_path_of klass p ^ "::" ^ cpp_member_name_of field) + | FuncSuper (this, _, field) -> + out + ((if this == ThisReal then "this->" else "__->") + ^ "super::" ^ cpp_member_name_of field) + | FuncNew newType -> + let objName = + match newType with + | TCppString -> "::String" + | TCppDynamicArray -> "::cpp::VirtualArray_obj::__new" + | TCppObjectArray _ -> "::Array_obj< ::Dynamic>::__new" + | TCppScalarArray value -> + "::Array_obj< " ^ tcpp_to_string value ^ " >::__new" + | TCppObjC klass -> cpp_class_path_of klass [] ^ "_obj::__new" + | TCppNativePointer klass -> "new " ^ cpp_class_path_of klass [] + | TCppInst (klass, p) when is_native_class klass -> + cpp_class_path_of klass p + | TCppInst (klass, p) -> cpp_class_path_of klass p ^ "_obj::__new" + | TCppClass -> "::hx::Class_obj::__new" + | TCppFunction _ -> tcpp_to_string newType + | _ -> + abort + ("Unknown 'new' target " ^ tcpp_to_string newType) + expr.cpppos + in + out objName + | FuncInternal (func, name, join) -> + gen func; + out (join ^ name) + | FuncExtern (name, isGlobal) -> + if isGlobal then out " ::"; + out name + | FuncExpression expr -> gen expr); + if !doCall then ( + let sep = ref "" in + out "("; + List.iter + (fun arg -> + out !sep; + sep := ","; + gen arg) + !argsRef; + out (")" ^ !closeCall)) + | CppNewNative e -> + out "new "; + gen e + | CppAddressOf e -> + out "&("; + gen e; + out ")" + | CppDereference e -> + out "(*("; + gen e; + out "))" + | CppFunctionAddress (klass, member) -> + let signature = function_signature false member.cf_type "" in + let name = cpp_member_name_of member in + (*let void_cast = has_meta_key field.cf_meta Meta.Void in*) + out ("::cpp::Function< " ^ signature ^ ">(::hx::AnyCast("); + out ("&::" ^ join_class_path_remap klass.cl_path "::" ^ "_obj::" ^ name); + out " ))" + | CppExtern (name, isGlobal) -> + if isGlobal then out " ::"; + out name + | CppDynamicField (obj, name) -> + gen obj; + out ("->__Field(" ^ strq name ^ ",::hx::paccDynamic)") + | CppArray arrayLoc -> ( + match arrayLoc with + | ArrayTyped (arrayObj, index, _) -> + gen arrayObj; + out "->__get("; + gen index; + out ")" + | ArrayPointer (arrayObj, index) -> + gen arrayObj; + out ".ptr["; + gen index; + out "]" + | ArrayRawPointer (arrayObj, index) -> + gen arrayObj; + out "["; + gen index; + out "]" + | ArrayObject (arrayObj, index, elem) -> + let close = + if cpp_is_dynamic_type elem then "" + else if elem = TCppDynamicArray then ( + out (tcpp_to_string elem ^ "( "); + ")") + else ".StaticCast< " ^ tcpp_to_string elem ^ " >()" + in + gen arrayObj; + out "->__get("; + gen index; + out (")" ^ close) + | ArrayVirtual (arrayObj, index) -> + gen arrayObj; + out "->__get("; + gen index; + out ")" + | ArrayDynamic (arrayObj, index) -> + gen arrayObj; + out "->__GetItem("; + gen index; + out ")" + | ArrayImplements (_, arrayObj, index) -> + gen arrayObj; + out "->__get("; + gen index; + out ")") + | CppSet (lvalue, rvalue) -> + let close = + if expr.cpptype = TCppVoid then "" + else ( + out "("; + ")") + in + (match lvalue with + | CppVarRef (VarClosure var) + when is_gc_element ctx (cpp_type_of var.v_type) -> + out ("this->_hx_set_" ^ cpp_var_name_of var ^ "(HX_CTX, "); + gen rvalue; + out ")" + | CppVarRef (VarThis (member, _)) + when is_gc_element ctx (cpp_type_of member.cf_type) -> + out ("this->_hx_set_" ^ cpp_member_name_of member ^ "(HX_CTX, "); + gen rvalue; + out ")" + | CppVarRef (VarInstance (obj, member, _, "->")) + when is_gc_element ctx (cpp_type_of member.cf_type) -> + gen obj; + out ("->_hx_set_" ^ cpp_member_name_of member ^ "(HX_CTX, "); + gen rvalue; + out ")" + | CppVarRef (VarInternal (obj, operator, member)) -> + gen obj; + out (operator ^ member) + | CppVarRef varLoc -> + gen_val_loc varLoc true; + out " = "; + gen rvalue + | CppArrayRef arrayLoc -> ( + match arrayLoc with + | ArrayObject (arrayObj, index, _) + when is_gc_element ctx TCppDynamic -> + gen arrayObj; + out "->setCtx( HX_CTX, "; + gen index; + out ","; + gen rvalue; + out ")" + | ArrayTyped (arrayObj, index, t) when is_gc_element ctx t -> + gen arrayObj; + out "->setCtx( HX_CTX, "; + gen index; + out ","; + gen rvalue; + out ")" + | ArrayObject (arrayObj, index, _) + | ArrayTyped (arrayObj, index, _) + | ArrayRawPointer (arrayObj, index) -> + gen arrayObj; + out "["; + gen index; + out "] = "; + gen rvalue + | ArrayPointer (arrayObj, index) -> + gen arrayObj; + out ".ptr["; + gen index; + out "] = "; + gen rvalue + | ArrayVirtual (arrayObj, index) -> + gen arrayObj; + out "->set("; + gen index; + out ","; + gen rvalue; + out ")" + | ArrayDynamic (arrayObj, index) -> + gen arrayObj; + out "->__SetItem("; + gen index; + out ","; + gen rvalue; + out ")" + | ArrayImplements (_, arrayObj, index) -> + gen arrayObj; + out "->__set("; + gen index; + out ","; + gen rvalue; + out ")") + | CppDynamicRef (expr, name) -> + gen expr; + out ("->__SetField(" ^ strq name ^ ","); + gen rvalue; + out ",::hx::paccDynamic)" + | CppExternRef (name, isGlobal) -> + if isGlobal then out " ::"; + out (name ^ " = ")); + out close + | CppCrement (incFlag, preFlag, lvalue) -> + let op = if incFlag == CppIncrement then "++" else "--" in + if preFlag == Prefix then out op; + gen_lvalue lvalue; + if preFlag == Postfix then out op + | CppModify (op, lvalue, rvalue) -> + out (string_of_op_eq op expr.cpppos); + out "("; + gen_lvalue lvalue; + out ","; + gen rvalue; + out ")" + | CppPosition (name, line, clazz, func) -> + out + ("::hx::SourceInfo(" ^ strq name ^ "," + ^ string_of_int (Int32.to_int line) + ^ "," ^ strq clazz ^ "," ^ strq func ^ ")") + | CppClassOf (path, native) -> + let path = "::" ^ join_class_path_remap path "::" in + let path = + match path with "::Int" -> "int" | "::Bool" -> "bool" | x -> x + in + if native then out "null()" + else if path = "::Array" then out "::hx::ArrayBase::__mClass" + else out ("::hx::ClassOf< " ^ path ^ " >()") + | CppVar loc -> gen_val_loc loc false + | CppClosure closure -> + out + (" ::Dynamic(new _hx_Closure_" ^ string_of_int closure.close_id ^ "("); + let separator = ref "" in + (match closure.close_this with + | Some this -> + out (if this = ThisReal then "this" else "__this"); + separator := "," + | _ -> ()); + + Hashtbl.iter + (fun name value -> + out !separator; + separator := ","; + out (keyword_remap name)) + closure.close_undeclared; + out "))" + | CppObjectDecl (values, isStruct) -> + let length = List.length values in + let lengthStr = string_of_int length in + if expr.cpptype != TCppVoid then out " ::Dynamic("; + if isStruct && length > 0 && length <= 5 then ( + out + ("::hx::AnonStruct" ^ lengthStr ^ "_obj< " + ^ String.concat "," + (List.map + (fun (_, value) -> tcpp_to_string value.cpptype) + values) + ^ " >::Create("); + let sep = ref "" in + List.iter + (fun (name, value) -> + out (!sep ^ strq name ^ ","); + sep := ","; + gen value) + values; + out ")") + else ( + out ("::hx::Anon_obj::Create(" ^ lengthStr ^ ")"); + let sorted = + List.sort + (fun (_, _, h0) (_, _, h1) -> Int32.compare h0 h1) + (List.map + (fun (name, value) -> (name, value, gen_hash32 0 name)) + values) + in + writer#push_indent; + ExtList.List.iteri + (fun idx (name, value, _) -> + out ("\n" ^ spacer); + writer#write_i + ("->setFixed(" ^ string_of_int idx ^ "," ^ strq name ^ ","); + gen value; + out ")") + sorted); + if expr.cpptype != TCppVoid then out ")"; + writer#pop_indent + | CppArrayDecl exprList when cpp_is_const_scalar_array expr.cpptype exprList + -> + let arrayType = + match expr.cpptype with + | TCppScalarArray value -> value + | _ -> assert false + in + let typeName = tcpp_to_string arrayType in + incr ctx.ctx_file_id; + + let id = + "_hx_array_data_" ^ class_hash ^ "_" + ^ string_of_int !(ctx.ctx_file_id) + in + + let out_top = ctx.ctx_writer#write_h in + out_top ("static const " ^ typeName ^ " " ^ id ^ "[] = {\n\t"); + List.iter + (fun expr -> + match expr.cppexpr with + | CppInt i -> out_top (Printf.sprintf "(%s)%ld," typeName i) + | CppFloat f -> out_top (f ^ ",") + | CppString s -> out_top (strq s ^ ",") + | CppBool b -> out_top (if b then "1," else "0,") + | _ -> die "" __LOC__) + exprList; + out_top "\n};\n"; + out + ("::Array_obj< " ^ typeName ^ " >::fromData( " ^ id ^ "," + ^ list_num exprList ^ ")") + | CppArrayDecl exprList -> + let count = List.length exprList in + let countStr = string_of_int count in + let arrayType, close = + match expr.cpptype with + | TCppObjectArray _ -> ("::Array_obj< ::Dynamic>", "") + | TCppScalarArray value -> + ("::Array_obj< " ^ tcpp_to_string value ^ " >", "") + | TCppDynamicArray -> ("::cpp::VirtualArray_obj", "") + | _ -> (" ::Dynamic( ::cpp::VirtualArray_obj", ")") + in + out (arrayType ^ "::__new(" ^ countStr ^ ")"); + ExtList.List.iteri + (fun idx elem -> + out ("->init(" ^ string_of_int idx ^ ","); + gen elem; + out ")") + exprList; + out close + | CppBinop (Ast.OpUShr, left, right) -> + out "::hx::UShr("; + gen left; + out ","; + gen right; + out ")" + | CppBinop (Ast.OpMod, left, right) -> + if is_constant_zero right then ( + out "::hx::Mod("; + gen left; + out ",(double)( "; + gen right; + out " ))") + else ( + out "::hx::Mod("; + gen left; + out ","; + gen right; + out ")") + | CppBinop (Ast.OpDiv, left, right) when is_constant_zero right -> + out "::hx::DivByZero("; + gen left; + out ")" + | CppBinop (op, left, right) -> + let op = string_of_op op expr.cpppos in + out "("; + gen left; + out (" " ^ op ^ " "); + gen right; + out ")" + | CppCompare (opName, left, right, _) -> + out ("::hx::" ^ opName ^ "( "); + gen left; + out ","; + gen right; + out " )" + | CppNullCompare (op, left) -> + out ("::hx::" ^ op ^ "( "); + gen left; + out " )" + | CppThrow value -> + out "HX_STACK_DO_THROW("; + gen value; + out ")" + | CppReturn None -> out "return" + | CppReturn (Some value) -> + out "return "; + gen value + | CppEnumField (enum, field) -> + out + (string_of_path enum.e_path ^ "::" ^ cpp_enum_name_of field ^ "_dyn()") + | CppEnumParameter (obj, field, index) -> ( + let valueType = cpp_type_of (get_nth_type field index) in + let baseType = enum_getter_type valueType in + gen obj; + if cpp_is_dynamic_type obj.cpptype then + out ".StaticCast< ::hx::EnumBase >()"; + out ("->_hx_get" ^ baseType ^ "(" ^ string_of_int index ^ ")"); + match valueType with + | TCppObjectArray _ | TCppScalarArray _ | TCppDynamicArray | TCppClass + | TCppEnum _ | TCppInst _ -> + out (".StaticCast< " ^ tcpp_to_string valueType ^ " >()") + | _ -> ()) + | CppIntSwitch (condition, cases, defVal) -> + out "switch((int)("; + gen condition; + out "))"; + writer#begin_block; + List.iter + (fun (values, expr) -> + out spacer; + writer#write_i ""; + List.iter + (fun value -> + out ("case (int)" ^ Printf.sprintf "%ld" value ^ ": ")) + values; + gen expr; + out spacer; + writer#write_i "break;\n") + cases; + (match defVal with + | Some expr -> + output_i "default:"; + gen expr + | _ -> ()); + out spacer; + writer#end_block + | CppSwitch (condition, conditionType, cases, optional_default, label) -> + let tmp_name = "_hx_switch_" ^ string_of_int !tempId in + incr tempId; + out (tcpp_to_string conditionType ^ " " ^ tmp_name ^ " = "); + gen condition; + out ";\n"; + List.iter + (fun (cases, expression) -> + output_i "if ( "; + let or_str = ref "" in + List.iter + (fun value -> + out (!or_str ^ " (" ^ tmp_name ^ "=="); + gen value; + out ")"; + or_str := " || ") + cases; + out " )"; + gen expression) + cases; + (match optional_default with + | None -> () + | Some default -> + output_i "/* default */"; + gen default); + output_i (label_name label ^ ":") + | CppUnop (unop, value) -> + out + (match unop with CppNot -> "!" | CppNeg -> "-" | CppNegBits -> "~"); + out "("; + gen value; + out ")" + | CppWhile (condition, block, while_flag, loop_id) -> + (match while_flag with + | NormalWhile -> + out "while("; + gen condition; + out ")"; + lastLine := -1; + gen block + | DoWhile -> + out "do "; + lastLine := -1; + gen_with_injection None block false; + out " while("; + gen condition; + out ");\n"); + if loop_id > -1 then output_i (label_name loop_id ^ ":") + | CppIf (condition, block, None) -> + out "if ("; + gen condition; + out ") "; + gen block + | CppIf (condition, block, Some elze) when expr.cpptype = TCppVoid -> + out "if ("; + gen condition; + out ") "; + gen block; + output_i "else "; + gen elze + | CppIf (condition, block, Some elze) -> + gen condition; + out " ? "; + gen block; + out " : "; + gen elze + | CppFor (tvar, init, loop) -> + let varType = cpp_var_type_of tvar in + out + ("for(::cpp::FastIterator_obj< " ^ varType + ^ " > *__it = ::cpp::CreateFastIterator< " ^ varType ^ " >("); + gen init; + out "); __it->hasNext(); )"; + let prologue _ = + output_i (varType ^ " " ^ cpp_var_name_of tvar ^ " = __it->next();\n") + in + gen_with_injection (mk_injection prologue "" "") loop true + | CppTry (block, catches) -> + let prologue = function + | _ -> + ExtList.List.iteri + (fun idx (v, _) -> + output_i + ("HX_STACK_CATCHABLE(" ^ cpp_macro_var_type_of v ^ ", " + ^ string_of_int idx ^ ");\n")) + catches + in + out "try "; + gen_with_injection + (mk_injection prologue "" "") + block + (List.length catches < 0); + if List.length catches > 0 then ( + out " catch( ::Dynamic _hx_e) "; + writer#begin_block; + + let seen_dynamic = ref false in + let else_str = ref "" in + List.iter + (fun (v, catch) -> + let type_name = cpp_var_type_of v in + (match cpp_type_of v.v_type with + | TCppInterface klass -> + let hash = cpp_class_hash klass in + output_i + (!else_str ^ "if (::hx::TIsInterface< (int)" ^ hash + ^ " >(_hx_e.mPtr))") + | TCppString -> + output_i + (!else_str + ^ "if (_hx_e.IsClass< ::String >() && \ + _hx_e->toString()!=null() )") + | _ -> + if type_name = "Dynamic" then ( + seen_dynamic := true; + output_i !else_str) + else + output_i + (!else_str ^ "if (_hx_e.IsClass< " ^ type_name ^ " >() )")); + + let prologue = function + | _ -> + output_i "HX_STACK_BEGIN_CATCH\n"; + output_i + (type_name ^ " " ^ cpp_var_name_of v ^ " = _hx_e;\n") + in + gen_with_injection (mk_injection prologue "" "") catch true; + else_str := "else ") + catches; + + if not !seen_dynamic then ( + output_i "else {\n"; + output_i "\tHX_STACK_DO_THROW(_hx_e);\n"; + output_i "}\n"); + out spacer; + writer#end_block) + | CppCode (value, exprs) -> + Codegen.interpolate_code ctx.ctx_common.error (format_code value) exprs out + (fun e -> gen e) + expr.cpppos + | CppTCast (expr, cppType) -> ( + match cppType with + | TCppInterface i -> + out " ::hx::interface_check("; + gen expr; + out ("," ^ cpp_class_hash i ^ ")") + | _ -> + let toType = tcpp_to_string cppType in + if toType = "Dynamic" then ( + out " ::Dynamic("; + gen expr; + out ")") + else ( + out ("::hx::TCast< " ^ toType ^ " >::cast("); + gen expr; + out ")")) + | CppCastStatic (expr, toType) -> + let close = + match expr.cpptype with + | TCppDynamic -> "" + | _ -> + out "Dynamic( "; + ")" + in + gen expr; + out (close ^ ".StaticCast< " ^ tcpp_to_string toType ^ " >()") + | CppCast (expr, toType) -> ( + match (expr.cppexpr, expr.cpptype, toType) with + | CppCall (FuncInternal _, _), _, _ -> + gen expr; + out (".StaticCast< " ^ tcpp_to_string toType ^ " >()") + | _, TCppObjC _, _ | _, TCppObjCBlock _, _ -> + out ("( (" ^ tcpp_to_string toType ^ ")((id) ( "); + gen expr; + out ") ))" + | _, _, TCppObjectPtr -> + out "::hx::DynamicPtr("; + gen expr; + out ")" + | _, TCppPointer (_, _), TCppStar (_, _) + | _, TCppPointer (_, _), TCppRawPointer (_, _) -> + out ("( (" ^ tcpp_to_string toType ^ ")( ("); + gen expr; + out ").get_raw()) )" + | _ -> + out ("( (" ^ tcpp_to_string toType ^ ")("); + gen expr; + out ") )") + | CppCastScalar (expr, scalar) -> + out ("( (" ^ scalar ^ ")("); + gen expr; + out ") )" + | CppCastVariant expr -> + out " ::Dynamic("; + gen expr; + out ")" + | CppCastObjC (expr, klass) -> + let path = join_class_path_remap klass.cl_path "::" in + let toType = + if has_class_flag klass CInterface then "id < " ^ path ^ ">" + else path ^ " *" + in + out ("( (" ^ toType ^ ") (id) ("); + gen expr; + out ") )" + | CppCastObjCBlock (expr, args, ret) -> + out (tcpp_objc_block_struct args ret ^ "::create( "); + gen expr; + out ")" + | CppCastProtocol (expr, klass) -> + out (join_class_path_remap klass.cl_path "::" ^ "_obj::_hx_toProtocol( "); + gen expr; + out ")" + | CppCastNative expr -> + out "("; + gen expr; + out ").mPtr"); + if ctx.ctx_debug_level >= 3 then + out + ("/* " ^ s_tcpp expr.cppexpr ^ ":" ^ tcpp_to_string expr.cpptype ^ " */") + and gen expr = gen_with_injection None expr true + and gen_lvalue lvalue = + match lvalue with + | CppVarRef varLoc -> gen_val_loc varLoc true + | CppArrayRef arrayLoc -> ( + match arrayLoc with + | ArrayObject (arrayObj, index, _) -> + out "::hx::IndexRef("; + gen arrayObj; + out ".mPtr,"; + gen index; + out ")" + | ArrayTyped (arrayObj, index, _) -> + gen arrayObj; + out "["; + gen index; + out "]" + | ArrayPointer (arrayObj, index) -> + gen arrayObj; + out ".ptr["; + gen index; + out "]" + | ArrayRawPointer (arrayObj, index) -> + gen arrayObj; + out "["; + gen index; + out "]" + | ArrayVirtual (arrayObj, index) | ArrayDynamic (arrayObj, index) -> + out "::hx::IndexRef("; + gen arrayObj; + out ".mPtr,"; + gen index; + out ")" + | ArrayImplements (_, arrayObj, index) -> + out "::hx::__ArrayImplRef("; + gen arrayObj; + out ","; + gen index; + out ")") + | CppExternRef (name, isGlobal) -> + if isGlobal then out " ::"; + out name + | CppDynamicRef (expr, name) -> + let objPtr = + match expr.cpptype with TCppVariant -> "getObject()" | _ -> ".mPtr" + in + out "::hx::FieldRef(("; + gen expr; + out (")" ^ objPtr ^ "," ^ strq name ^ ")") + and gen_val_loc loc lvalue = + match loc with + | VarClosure var -> out (cpp_var_name_of var) + | VarLocal local -> out (cpp_var_name_of local) + | VarStatic (clazz, objc, member) -> ( + match get_meta_string member.cf_meta Meta.Native with + | Some n -> out n + | None -> + if objc then ( + out (join_class_path_remap clazz.cl_path "::"); + out ("." ^ cpp_member_name_of member)) + else ( + out (cpp_class_name clazz); + out ("::" ^ cpp_member_name_of member))) + | VarThis (member, _) -> out ("this->" ^ cpp_member_name_of member) + | VarInstance (obj, member, _, operator) -> + gen obj; + out (operator ^ cpp_member_name_of member) + | VarInternal (obj, operator, member) -> + gen obj; + out (operator ^ member) + | VarInterface (obj, member) -> + gen obj; + out ("->" ^ cpp_member_name_of member ^ "_get()") + and string_of_op_eq op pos = + match op with + | OpAdd -> "::hx::AddEq" + | OpMult -> "::hx::MultEq" + | OpDiv -> "::hx::DivEq" + | OpSub -> "::hx::SubEq" + | OpAnd -> "::hx::AndEq" + | OpOr -> "::hx::OrEq" + | OpXor -> "::hx::XorEq" + | OpShl -> "::hx::ShlEq" + | OpShr -> "::hx::ShrEq" + | OpUShr -> "::hx::UShrEq" + | OpMod -> "::hx::ModEq" + | _ -> abort "Bad assign op" pos + and string_of_op op pos = + match op with + | OpAdd -> "+" + | OpMult -> "*" + | OpDiv -> "/" + | OpSub -> "-" + | OpEq -> "==" + | OpNotEq -> "!=" + | OpGt -> ">" + | OpGte -> ">=" + | OpLt -> "<" + | OpLte -> "<=" + | OpAnd -> "&" + | OpOr -> "|" + | OpXor -> "^" + | OpBoolAnd -> "&&" + | OpBoolOr -> "||" + | OpShl -> "<<" + | OpShr -> ">>" + | OpUShr -> ">>>" + | OpMod -> "%" + | OpInterval -> "..." + | OpArrow -> "->" + | OpIn -> " in " + | OpNullCoal -> "??" + | OpAssign | OpAssignOp _ -> abort "Unprocessed OpAssign" pos + and gen_closure closure = + let argc = Hashtbl.length closure.close_undeclared in + let size = string_of_int argc in + if argc >= 62 then + (* Limited by c++ macro size of 128 args *) + abort "Too many capture variables" closure.close_expr.cpppos; + if argc >= 20 || List.length closure.close_args >= 20 then + writer#add_big_closures; + let argsCount = list_num closure.close_args in + output_i ("HX_BEGIN_LOCAL_FUNC_S" ^ size ^ "("); + out + (if closure.close_this != None then "::hx::LocalThisFunc," + else "::hx::LocalFunc,"); + out ("_hx_Closure_" ^ string_of_int closure.close_id); + Hashtbl.iter + (fun name var -> + out ("," ^ cpp_macro_var_type_of var ^ "," ^ keyword_remap name)) + closure.close_undeclared; + out (") HXARGC(" ^ argsCount ^ ")\n"); + + let func_type = tcpp_to_string closure.close_type in + output_i + (func_type ^ " _hx_run(" ^ cpp_arg_list closure.close_args "__o_" ^ ")"); + + let prologue = function + | gc_stack -> + cpp_gen_default_values ctx closure.close_args "__o_"; + hx_stack_push ctx output_i class_name func_name + closure.close_expr.cpppos gc_stack; + if ctx.ctx_debug_level >= 2 then ( + if closure.close_this != None then + output_i "HX_STACK_THIS(__this.mPtr)\n"; + List.iter + (fun (v, _) -> + output_i + ("HX_STACK_ARG(" ^ cpp_var_name_of v ^ ",\"" + ^ cpp_debug_name_of v ^ "\")\n")) + (List.filter (cpp_debug_var_visible ctx) closure.close_args); + + let line = Lexer.get_error_line closure.close_expr.cpppos in + let lineName = Printf.sprintf "%4d" line in + out ("HXLINE(" ^ lineName ^ ")\n")) + in + gen_with_injection (mk_injection prologue "" "") closure.close_expr true; + + let return = + match closure.close_type with TCppVoid -> "(void)" | _ -> "return" + in + + output_i ("HX_END_LOCAL_FUNC" ^ argsCount ^ "(" ^ return ^ ")\n\n") + in + + gen_with_injection injection cppTree true + +let gen_cpp_init ctx dot_name func_name var_name expr = + let output = ctx.ctx_output in + let prologue = function + | gc_stack -> + let spacer = + if ctx.ctx_debug_level > 0 then " \t" else "\t" + in + let output_i s = output (spacer ^ s) in + hx_stack_push ctx output_i dot_name func_name expr.epos gc_stack + in + let injection = mk_injection prologue var_name "" in + gen_cpp_ast_expression_tree ctx dot_name func_name [] t_dynamic injection + (mk_block expr) + +let generate_main_header output_main = + output_main "#include \n\n"; + output_main "#include \n\n"; + output_main "extern \"C\" void __hxcpp_main();\n\n"; + output_main "extern \"C\" void __hxcpp_lib_main();\n\n" + +let generate_main_footer1 output_main = output_main "void __hxcpp_main() {\n" + +let generate_main_footer2 output_main = + output_main "\t}\n\n"; + output_main "void __hxcpp_lib_main() {\n"; + output_main "\tHX_TOP_OF_STACK\n"; + output_main "\t::hx::Boot();\n"; + output_main "\t__boot_all();\n"; + output_main "\t__hxcpp_main();\n"; + output_main "\t}\n" + +let generate_main ctx super_deps class_def = + let common_ctx = ctx.ctx_common in + (* main routine should be a single static function *) + let main_expression = + match class_def.cl_ordered_statics with + | [ { cf_expr = Some expression } ] -> expression + | _ -> die "" __LOC__ + in + CppReferences.find_referenced_types ctx (TClassDecl class_def) super_deps + (Hashtbl.create 0) false false false + |> ignore; + let depend_referenced = + CppReferences.find_referenced_types ctx (TClassDecl class_def) super_deps + (Hashtbl.create 0) false true false + in + let generate_startup filename is_main = + (*make_class_directories base_dir ( "src" :: []);*) + let cpp_file = new_cpp_file common_ctx common_ctx.file ([], filename) in + let output_main = cpp_file#write in + + generate_main_header cpp_file#write_h; + + List.iter (add_include cpp_file) depend_referenced; + output_main "\n\n"; + + if is_main then output_main "\n#include \n\n"; + + generate_main_footer1 output_main; + + let ctx = file_context ctx cpp_file 1 false in + gen_cpp_init ctx "hxcpp" "__hxcpp_main" "" main_expression; + + generate_main_footer2 output_main; + cpp_file#close + in + generate_startup "__main__" true; + generate_startup "__lib__" false + +let generate_dummy_main common_ctx = + let generate_startup filename is_main = + let main_file = new_cpp_file common_ctx common_ctx.file ([], filename) in + let output_main = main_file#write in + generate_main_header main_file#write_h; + if is_main then output_main "\n#include \n\n"; + generate_main_footer1 output_main; + generate_main_footer2 output_main; + main_file#close + in + generate_startup "__main__" true; + generate_startup "__lib__" false + +let generate_boot ctx boot_enums boot_classes nonboot_classes init_classes = + let common_ctx = ctx.ctx_common in + (* Write boot class too ... *) + let base_dir = common_ctx.file in + let boot_file = new_cpp_file common_ctx base_dir ([], "__boot__") in + let output_boot = boot_file#write in + boot_file#write_h "#include \n\n"; + + List.iter + (fun class_path -> boot_file#add_include class_path) + (boot_enums @ boot_classes @ nonboot_classes); + + let newScriptable = Gctx.defined common_ctx Define.Scriptable in + if newScriptable then ( + output_boot "#include \n"; + let funcs = + hash_iterate !(ctx.ctx_interface_slot) (fun name id -> (name, id)) + in + let sorted = List.sort (fun (_, id1) (_, id2) -> id1 - id2) funcs in + output_boot + "static const char *scriptableInterfaceFuncs[] = {\n\t0,\n\t0,\n"; + List.iter + (fun (name, id) -> + output_boot ("\t\"" ^ name ^ "\", //" ^ string_of_int (-id) ^ "\n")) + sorted; + output_boot "};\n"); + + output_boot "\nvoid __files__boot();\n"; + output_boot "\nvoid __boot_all()\n{\n"; + output_boot "__files__boot();\n"; + output_boot "::hx::RegisterResources( ::hx::GetResources() );\n"; + if newScriptable then + output_boot + ("::hx::ScriptableRegisterNameSlots(scriptableInterfaceFuncs," + ^ string_of_int !(ctx.ctx_interface_slot_count) + ^ ");\n"); + + List.iter + (fun class_path -> + output_boot + ("::" ^ join_class_path_remap class_path "::" ^ "_obj::__register();\n")) + (boot_enums @ boot_classes @ nonboot_classes); + + let dump_boot = + List.iter (fun class_path -> + output_boot + ("::" ^ join_class_path_remap class_path "::" ^ "_obj::__boot();\n")) + in + + dump_boot boot_enums; + + List.iter + (fun class_path -> + output_boot + ("::" ^ join_class_path_remap class_path "::" ^ "_obj::__init__();\n")) + (List.rev init_classes); + + let is_cpp_class = function + | "cpp" :: _, _ -> true + | [], "EReg" -> true + | [ "haxe" ], "Log" -> true + | _ -> false + in + + dump_boot + (List.filter (fun path -> is_cpp_class path) (List.rev boot_classes)); + dump_boot + (List.filter (fun path -> not (is_cpp_class path)) (List.rev boot_classes)); + + output_boot "}\n\n"; + boot_file#close + +let generate_files common_ctx file_info = + (* Write __files__ class too ... *) + let base_dir = common_ctx.file in + let files_file = new_cpp_file common_ctx base_dir ([], "__files__") in + let output_files = files_file#write in + let types = common_ctx.types in + files_file#write_h "#include \n\n"; + output_files "namespace hx {\n"; + output_files "const char *__hxcpp_all_files[] = {\n"; + output_files "#ifdef HXCPP_DEBUGGER\n"; + List.iter + (fun file -> output_files (const_char_star file ^ ",\n")) + (List.sort String.compare (pmap_keys !file_info)); + output_files "#endif\n"; + output_files " 0 };\n"; + output_files "\n"; + + output_files "const char *__hxcpp_all_files_fullpath[] = {\n"; + output_files "#ifdef HXCPP_DEBUGGER\n"; + List.iter + (fun file -> + output_files + (const_char_star + (Path.get_full_path + (try Gctx.find_file common_ctx file with Not_found -> file)) + ^ ",\n")) + (List.sort String.compare (pmap_keys !file_info)); + output_files "#endif\n"; + output_files " 0 };\n"; + output_files "\n"; + + output_files "const char *__hxcpp_all_classes[] = {\n"; + output_files "#ifdef HXCPP_DEBUGGER\n"; + List.iter + (fun object_def -> + match object_def with + | TClassDecl class_def when is_extern_class class_def -> () + | TClassDecl class_def when has_class_flag class_def CInterface -> () + | TClassDecl class_def -> + output_files + (const_char_star (join_class_path class_def.cl_path ".") ^ ",\n") + | _ -> ()) + types; + output_files "#endif\n"; + output_files " 0 };\n"; + + output_files "} // namespace hx\n"; + output_files + "void __files__boot() { \ + __hxcpp_set_debugger_info(::hx::__hxcpp_all_classes, \ + ::hx::__hxcpp_all_files_fullpath); }\n"; + + files_file#close + +let gen_cpp_function_body ctx clazz is_static func_name function_def head_code + tail_code no_debug = + let output = ctx.ctx_output in + let dot_name = join_class_path clazz.cl_path "." in + if no_debug then ctx.ctx_debug_level <- 0; + let prologue = function + | gc_stack -> + let spacer = if no_debug then "\t" else " \t" in + let output_i s = output (spacer ^ s) in + ctx_default_values ctx function_def.tf_args "__o_"; + hx_stack_push ctx output_i dot_name func_name function_def.tf_expr.epos + gc_stack; + if ctx.ctx_debug_level >= 2 then ( + if not is_static then + output_i + ("HX_STACK_THIS(" + ^ (if ctx.ctx_real_this_ptr then "this" else "__this") + ^ ")\n"); + List.iter + (fun (v, _) -> + if not (cpp_no_debug_synbol ctx v) then + output_i + ("HX_STACK_ARG(" ^ cpp_var_name_of v ^ ",\"" ^ v.v_name + ^ "\")\n")) + function_def.tf_args; + + let line = Lexer.get_error_line function_def.tf_expr.epos in + let lineName = Printf.sprintf "%4d" line in + output ("HXLINE(" ^ lineName ^ ")\n")); + if head_code <> "" then output_i (head_code ^ "\n") + in + let args = List.map fst function_def.tf_args in + + let injection = mk_injection prologue "" tail_code in + gen_cpp_ast_expression_tree ctx dot_name func_name args function_def.tf_type + injection + (mk_block function_def.tf_expr) + +let constructor_arg_var_list class_def = + match class_def.cl_constructor with + | Some definition -> ( + match definition.cf_expr with + | Some { eexpr = TFunction function_def } -> + List.map + (fun (v, o) -> + (v.v_name, type_arg_to_string v.v_name o v.v_type "__o_")) + function_def.tf_args + | _ -> ( + match follow definition.cf_type with + | TFun (args, _) -> + List.map (fun (a, _, t) -> (a, (type_to_string t, a))) args + | _ -> [])) + | _ -> [] + +let generate_constructor ctx out class_def isHeader = + let class_name = class_name class_def in + let ptr_name = class_pointer class_def in + let can_quick_alloc = can_quick_alloc class_def in + let gcName = gen_gc_name class_def.cl_path in + let isContainer = if has_gc_references class_def then "true" else "false" in + let cargs = constructor_arg_var_list class_def in + let constructor_type_var_list = List.map snd cargs in + let constructor_type_args = + String.concat "," + (List.map (fun (t, a) -> t ^ " " ^ a) constructor_type_var_list) + in + let constructor_var_list = List.map snd constructor_type_var_list in + let constructor_args = String.concat "," constructor_var_list in + + let classScope = if isHeader then "" else class_name ^ "::" in + let staticHead = if isHeader then "inline static " else "" in + out + (staticHead ^ ptr_name ^ " " ^ classScope ^ "__new(" ^ constructor_type_args + ^ ") {\n"); + out ("\t" ^ ptr_name ^ " __this = new " ^ class_name ^ "();\n"); + out ("\t__this->__construct(" ^ constructor_args ^ ");\n"); + out "\treturn __this;\n"; + out "}\n\n"; + + if can_quick_alloc then ( + out + (staticHead ^ ptr_name ^ " " ^ classScope ^ "__alloc(::hx::Ctx *_hx_ctx" + ^ (if constructor_type_args = "" then "" else "," ^ constructor_type_args) + ^ ") {\n"); + out + ("\t" ^ class_name ^ " *__this = (" ^ class_name + ^ "*)(::hx::Ctx::alloc(_hx_ctx, sizeof(" ^ class_name ^ "), " ^ isContainer + ^ ", " ^ gcName ^ "));\n"); + out ("\t*(void **)__this = " ^ class_name ^ "::_hx_vtable;\n"); + let rec dump_dynamic class_def = + if has_dynamic_member_functions class_def then + out + ("\t" + ^ join_class_path_remap class_def.cl_path "::" + ^ "_obj::__alloc_dynamic_functions(_hx_ctx,__this);\n") + else + match class_def.cl_super with + | Some super -> dump_dynamic (fst super) + | _ -> () + in + dump_dynamic class_def; + + if isHeader then + match class_def.cl_constructor with + | Some + ({ cf_expr = Some { eexpr = TFunction function_def } } as definition) + -> + with_debug ctx definition.cf_meta (fun no_debug -> + ctx.ctx_real_this_ptr <- false; + gen_cpp_function_body ctx class_def false "new" function_def "" "" + no_debug; + out "\n") + | _ -> () + else out ("\t__this->__construct(" ^ constructor_args ^ ");\n"); + + out "\treturn __this;\n"; + out "}\n\n") + +let generate_native_constructor ctx out class_def isHeader = + let cargs = constructor_arg_var_list class_def in + let constructor_type_var_list = List.map snd cargs in + let constructor_type_args = + String.concat "," + (List.map (fun (t, a) -> t ^ " " ^ a) constructor_type_var_list) + in + let class_name = class_name class_def in + + match class_def.cl_constructor with + | Some ({ cf_expr = Some { eexpr = TFunction function_def } } as definition) + -> + if isHeader then + out ("\t\t" ^ class_name ^ "(" ^ constructor_type_args ^ ");\n\n") + else + with_debug ctx definition.cf_meta (fun no_debug -> + ctx.ctx_real_this_ptr <- true; + out + (class_name ^ "::" ^ class_name ^ "(" ^ constructor_type_args + ^ ")"); + + (match class_def.cl_super with + | Some (klass, _) -> ( + let rec find_super_args = function + | TCall ({ eexpr = TConst TSuper }, args) :: _ -> Some args + | (TParenthesis e | TMeta (_, e) | TCast (e, None)) :: rest -> + find_super_args (e.eexpr :: rest) + | TBlock e :: rest -> + find_super_args (List.map (fun e -> e.eexpr) e @ rest) + | _ :: rest -> find_super_args rest + | _ -> None + in + match find_super_args [ function_def.tf_expr.eexpr ] with + | Some args -> + out ("\n:" ^ cpp_class_path_of klass [] ^ "("); + let sep = ref "" in + List.iter + (fun arg -> + out !sep; + sep := ","; + gen_cpp_ast_expression_tree ctx "" "" [] t_dynamic None + arg) + args; + out ")\n" + | _ -> ()) + | _ -> ()); + + let head_code = get_code definition.cf_meta Meta.FunctionCode in + let tail_code = get_code definition.cf_meta Meta.FunctionTailCode in + gen_cpp_function_body ctx class_def false "new" function_def + head_code tail_code no_debug) + | _ -> () + +let dynamic_functions class_def = + List.fold_left + (fun result field -> + match field.cf_expr with + | Some { eexpr = TFunction function_def } + when is_dynamic_haxe_method field -> + keyword_remap field.cf_name :: result + | _ -> result) + [] class_def.cl_ordered_fields \ No newline at end of file diff --git a/src/generators/cpp/gen/cppGenClassHeader.ml b/src/generators/cpp/gen/cppGenClassHeader.ml new file mode 100644 index 00000000000..4a813471de7 --- /dev/null +++ b/src/generators/cpp/gen/cppGenClassHeader.ml @@ -0,0 +1,552 @@ +open Ast +open Type +open Error +open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext +open CppGen + +let gen_member_def ctx class_def is_static is_interface field = + let output = ctx.ctx_output in + let remap_name = keyword_remap field.cf_name in + let nativeGen = Meta.has Meta.NativeGen class_def.cl_meta in + + if is_interface then + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> () + | TFun (args, return_type), Method _ -> + let gen_args = print_tfun_arg_list true in + if is_static || nativeGen then ( + output + ((if not is_static then "\t\tvirtual " else "\t\t") + ^ type_to_string return_type); + output (" " ^ remap_name ^ "( "); + output (gen_args args); + output (if not is_static then ")=0;\n" else ");\n"); + if reflective class_def field then + if Gctx.defined ctx.ctx_common Define.DynamicInterfaceClosures + then + output + ("\t\tinline ::Dynamic " ^ remap_name + ^ "_dyn() { return __Field( " + ^ strq ctx.ctx_common field.cf_name + ^ ", ::hx::paccDynamic); }\n") + else output ("\t\tvirtual ::Dynamic " ^ remap_name ^ "_dyn()=0;\n")) + else + let argList = gen_args args in + let returnType = type_to_string return_type in + let returnStr = if returnType = "void" then "" else "return " in + let commaArgList = if argList = "" then argList else "," ^ argList in + let cast = + "::hx::interface_cast< ::" + ^ join_class_path_remap class_def.cl_path "::" + ^ "_obj *>" + in + output + ("\t\t" ^ returnType ^ " (::hx::Object :: *_hx_" ^ remap_name ^ ")(" + ^ argList ^ "); \n"); + output + ("\t\tstatic inline " ^ returnType ^ " " ^ remap_name + ^ "( ::Dynamic _hx_" ^ commaArgList ^ ") {\n"); + output "\t\t\t#ifdef HXCPP_CHECK_POINTER\n"; + output + "\t\t\tif (::hx::IsNull(_hx_)) ::hx::NullReference(\"Object\", \ + false);\n"; + output "\t\t\t#ifdef HXCPP_GC_CHECK_POINTER\n"; + output "\t\t\t\tGCCheckPointer(_hx_.mPtr);\n"; + output "\t\t\t#endif\n"; + output "\t\t\t#endif\n"; + output + ("\t\t\t" ^ returnStr ^ "(_hx_.mPtr->*( " ^ cast + ^ "(_hx_.mPtr->_hx_getInterface(" ^ cpp_class_hash class_def + ^ ")))->_hx_" ^ remap_name ^ ")(" ^ print_arg_names args + ^ ");\n\t\t}\n") + | _ -> () + else + let nonVirtual = Meta.has Meta.NonVirtual field.cf_meta in + let doDynamic = + (nonVirtual || not (is_override field)) && reflective class_def field + in + let decl = get_meta_string field.cf_meta Meta.Decl in + let has_decl = match decl with Some _ -> true | None -> false in + if has_decl then output (" typedef " ^ (decl |> Option.get) ^ ";\n"); + output (if is_static then "\t\tstatic " else "\t\t"); + match field.cf_expr with + | Some { eexpr = TFunction function_def } -> + (if is_dynamic_haxe_method field then ( + if doDynamic then ( + output ("::Dynamic " ^ remap_name ^ ";\n"); + if (not is_static) && is_gc_element ctx TCppDynamic then + output + ("\t\tinline ::Dynamic _hx_set_" ^ remap_name + ^ "(::hx::StackContext *_hx_ctx,::Dynamic _hx_v) { \ + HX_OBJ_WB(this,_hx_v.mPtr) return " ^ remap_name + ^ "=_hx_v; }\n"); + output (if is_static then "\t\tstatic " else "\t\t"); + output + ("inline ::Dynamic &" ^ remap_name ^ "_dyn() " ^ "{return " + ^ remap_name ^ "; }\n"))) + else + let return_type = type_to_string function_def.tf_type in + (if (not is_static) && not nonVirtual then + let scriptable = + Gctx.defined ctx.ctx_common Define.Scriptable + in + if (not (is_internal_member field.cf_name)) && not scriptable then + let key = + join_class_path class_def.cl_path "." ^ "." ^ field.cf_name + in + try output (Hashtbl.find ctx.ctx_class_member_types key) + with Not_found -> () + else output "virtual "); + output (if return_type = "Void" then "void" else return_type); + + let remap_name = native_field_name_remap is_static field in + output (" " ^ remap_name ^ "("); + output (print_arg_list function_def.tf_args ""); + output ");\n"; + if doDynamic then ( + output (if is_static then "\t\tstatic " else "\t\t"); + output ("::Dynamic " ^ remap_name ^ "_dyn();\n"))); + output "\n" + | _ when has_class_field_flag field CfAbstract -> + let ctx_arg_list ctx arg_list prefix = + let get_default_value name = + try + match Meta.get Meta.Value field.cf_meta with + | _, [ (EObjectDecl decls, _) ], _ -> + Some + (List.find (fun ((n, _, _), _) -> n = name) decls + |> snd + |> type_constant_value ctx.ctx_common.basic) + | _ -> None + with Not_found -> None + in + + String.concat "," + (List.map + (fun (n, o, t) -> print_arg n (get_default_value n) t prefix) + arg_list) + in + let tl, tr = + match follow field.cf_type with + | TFun (tl, tr) -> (tl, tr) + | _ -> die "" __LOC__ + in + let return_type = type_to_string tr in + let remap_name = native_field_name_remap is_static field in + output "virtual "; + output (if return_type = "Void" then "void" else return_type); + output (" " ^ remap_name ^ "("); + output (ctx_arg_list ctx tl ""); + output + (") " + ^ (if return_type = "void" then "{}" else "{ return 0; }") + ^ "\n"); + if doDynamic then output ("\t\t::Dynamic " ^ remap_name ^ "_dyn();\n") + | _ when has_decl -> output (remap_name ^ "_decl " ^ remap_name ^ ";\n") + (* Variable access *) + | _ -> ( + (* Variable access *) + let tcpp = cpp_type_of field.cf_type in + let tcppStr = tcpp_to_string tcpp in + if (not is_static) && only_stack_access field.cf_type then + abort + ("Variables of type " ^ tcppStr ^ " may not be used as members") + field.cf_pos; + + output (tcppStr ^ " " ^ remap_name ^ ";\n"); + (if (not is_static) && is_gc_element ctx tcpp then + let getPtr = + match tcpp with TCppString -> ".raw_ref()" | _ -> ".mPtr" + in + output + ("\t\tinline " ^ tcppStr ^ " _hx_set_" ^ remap_name + ^ "(::hx::StackContext *_hx_ctx," ^ tcppStr + ^ " _hx_v) { HX_OBJ_WB(this,_hx_v" ^ getPtr ^ ") return " + ^ remap_name ^ "=_hx_v; }\n")); + + (* Add a "dyn" function for variable to unify variable/function access *) + match follow field.cf_type with + | _ when nativeGen -> () + | TFun (_, _) -> + output (if is_static then "\t\tstatic " else "\t\t"); + output + ("Dynamic " ^ remap_name ^ "_dyn() { return " ^ remap_name + ^ ";}\n") + | _ -> ( + (match field.cf_kind with + | Var { v_read = AccCall } + when (not is_static) + && is_dynamic_accessor ("get_" ^ field.cf_name) "get" field + class_def -> + output ("\t\tDynamic get_" ^ field.cf_name ^ ";\n") + | _ -> ()); + match field.cf_kind with + | Var { v_write = AccCall } + when (not is_static) + && is_dynamic_accessor ("set_" ^ field.cf_name) "set" field + class_def -> + output ("\t\tDynamic set_" ^ field.cf_name ^ ";\n") + | _ -> ())) + +let generate baseCtx class_def = + let common_ctx = baseCtx.ctx_common in + let class_path = class_def.cl_path in + let nativeGen = Meta.has Meta.NativeGen class_def.cl_meta in + let smart_class_name = snd class_path in + let scriptable = + Gctx.defined common_ctx Define.Scriptable && not class_def.cl_private + in + let class_name = class_name class_def in + let ptr_name = class_pointer class_def in + let can_quick_alloc = can_quick_alloc class_def in + let gcName = gen_gc_name class_def.cl_path in + let isContainer = if has_gc_references class_def then "true" else "false" in + let cargs = constructor_arg_var_list class_def in + let constructor_type_var_list = List.map snd cargs in + let constructor_type_args = + String.concat "," + (List.map (fun (t, a) -> t ^ " " ^ a) constructor_type_var_list) + in + + (*let cpp_file = new_cpp_file common_ctx.file class_path in*) + let debug = + if + Meta.has Meta.NoDebug class_def.cl_meta + || Gctx.defined baseCtx.ctx_common Define.NoDebug + then 0 + else 1 + in + + let h_file = new_header_file common_ctx common_ctx.file class_path in + let ctx = file_context baseCtx h_file debug true in + let strq = strq ctx.ctx_common in + + let parent, super = + match class_def.cl_super with + | Some (klass, params) -> + let name = + tcpp_to_string_suffix "_obj" (cpp_instance_type klass params) + in + ( (if has_class_flag class_def CInterface && nativeGen then "virtual " + else "") + ^ name, + name ) + | None when nativeGen && has_class_flag class_def CInterface -> + ("virtual ::hx::NativeInterface", "::hx::NativeInterface") + | None when has_class_flag class_def CInterface -> ("", "::hx::Object") + | None when nativeGen -> ("", "") + | None -> ("::hx::Object", "::hx::Object") + in + let output_h = h_file#write in + let def_string = join_class_path class_path "_" in + + begin_header_file h_file#write_h def_string nativeGen; + + (* Include the real header file for the super class *) + (match class_def.cl_super with + | Some super -> + let klass = fst super in + let include_files = get_all_meta_string_path klass.cl_meta Meta.Include in + if List.length include_files > 0 then + List.iter + (fun inc -> h_file#add_include (path_of_string inc)) + include_files + else h_file#add_include klass.cl_path + | _ -> ()); + + (* And any interfaces ... *) + List.iter + (fun imp -> + let interface = fst imp in + let include_files = + get_all_meta_string_path interface.cl_meta Meta.Include + in + if List.length include_files > 0 then + List.iter + (fun inc -> h_file#add_include (path_of_string inc)) + include_files + else h_file#add_include interface.cl_path) + (real_interfaces class_def.cl_implements); + + (* Only need to forward-declare classes that are mentioned in the header file + (ie, not the implementation) *) + let super_deps = create_super_dependencies common_ctx in + let header_referenced, header_flags = + CppReferences.find_referenced_types_flags ctx (TClassDecl class_def) "*" + super_deps (Hashtbl.create 0) true false scriptable + in + List.iter2 + (fun r f -> gen_forward_decl h_file r f) + header_referenced header_flags; + output_h "\n"; + + output_h (get_class_code class_def Meta.HeaderCode); + let includes = + get_all_meta_string_path class_def.cl_meta Meta.HeaderInclude + in + let printer inc = output_h ("#include \"" ^ inc ^ "\"\n") in + List.iter printer includes; + + begin_namespace output_h class_path; + output_h "\n\n"; + output_h (get_class_code class_def Meta.HeaderNamespaceCode); + + let extern_class = Gctx.defined common_ctx Define.DllExport in + let attribs = + "HXCPP_" ^ (if extern_class then "EXTERN_" else "") ^ "CLASS_ATTRIBUTES" + in + + let dump_native_interfaces () = + List.iter + (fun (c, params) -> + output_h (" , public virtual " ^ join_class_path c.cl_path "::")) + (List.filter + (fun (t, _) -> is_native_gen_class t) + class_def.cl_implements) + in + + if has_class_flag class_def CInterface && not nativeGen then ( + output_h ("class " ^ attribs ^ " " ^ class_name ^ " {\n"); + output_h "\tpublic:\n"; + output_h ("\t\ttypedef " ^ super ^ " super;\n")) + else if super = "" then ( + output_h ("class " ^ attribs ^ " " ^ class_name); + dump_native_interfaces (); + output_h "\n{\n\tpublic:\n") + else ( + output_h ("class " ^ attribs ^ " " ^ class_name ^ " : public " ^ parent); + dump_native_interfaces (); + output_h "\n{\n\tpublic:\n"; + if not nativeGen then ( + output_h ("\t\ttypedef " ^ super ^ " super;\n"); + output_h ("\t\ttypedef " ^ class_name ^ " OBJ_;\n"))); + + let classId = + try Hashtbl.find baseCtx.ctx_type_ids (class_text class_def.cl_path) + with Not_found -> Int32.zero + in + let classIdTxt = Printf.sprintf "0x%08lx" classId in + + if (not (has_class_flag class_def CInterface)) && not nativeGen then ( + output_h ("\t\t" ^ class_name ^ "();\n"); + output_h "\n\tpublic:\n"; + output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); + output_h ("\t\tvoid __construct(" ^ constructor_type_args ^ ");\n"); + output_h + ("\t\tinline void *operator new(size_t inSize, bool inContainer=" + ^ isContainer ^ ",const char *inName=" ^ gcName ^ ")\n"); + output_h + "\t\t\t{ return ::hx::Object::operator new(inSize,inContainer,inName); }\n"; + output_h "\t\tinline void *operator new(size_t inSize, int extra)\n"; + output_h + ("\t\t\t{ return ::hx::Object::operator new(inSize+extra," ^ isContainer + ^ "," ^ gcName ^ "); }\n"); + if has_class_flag class_def CAbstract then output_h "\n" + else if + can_inline_constructor baseCtx class_def super_deps + (create_constructor_dependencies common_ctx) + then ( + output_h "\n"; + CppGen.generate_constructor ctx + (fun str -> output_h ("\t\t" ^ str)) + class_def true) + else ( + output_h + ("\t\tstatic " ^ ptr_name ^ " __new(" ^ constructor_type_args ^ ");\n"); + if can_quick_alloc then + output_h + ("\t\tstatic " ^ ptr_name ^ " __alloc(::hx::Ctx *_hx_ctx" + ^ (if constructor_type_args = "" then "" + else "," ^ constructor_type_args) + ^ ");\n")); + if not (has_class_flag class_def CAbstract) then ( + output_h "\t\tstatic void * _hx_vtable;\n"; + output_h "\t\tstatic Dynamic __CreateEmpty();\n"; + output_h "\t\tstatic Dynamic __Create(::hx::DynamicArray inArgs);\n"); + if List.length (CppGen.dynamic_functions class_def) > 0 then + output_h + ("\t\tstatic void __alloc_dynamic_functions(::hx::Ctx *_hx_alloc," + ^ class_name ^ " *_hx_obj);\n"); + if scriptable then + output_h "\t\tstatic ::hx::ScriptFunction __script_construct;\n"; + output_h ("\t\t//~" ^ class_name ^ "();\n\n"); + output_h "\t\tHX_DO_RTTI_ALL;\n"; + if has_get_member_field class_def then + output_h + "\t\t::hx::Val __Field(const ::String &inString, ::hx::PropertyAccess \ + inCallProp);\n"; + if has_get_static_field class_def then + output_h + "\t\tstatic bool __GetStatic(const ::String &inString, Dynamic \ + &outValue, ::hx::PropertyAccess inCallProp);\n"; + if has_set_member_field class_def then + output_h + "\t\t::hx::Val __SetField(const ::String &inString,const ::hx::Val \ + &inValue, ::hx::PropertyAccess inCallProp);\n"; + if has_set_static_field class_def then + output_h + "\t\tstatic bool __SetStatic(const ::String &inString, Dynamic \ + &ioValue, ::hx::PropertyAccess inCallProp);\n"; + if has_get_fields class_def then + output_h "\t\tvoid __GetFields(Array< ::String> &outFields);\n"; + + if has_compare_field class_def then + output_h + ("\t\tint __Compare(const ::hx::Object *inRHS) const { " + ^ "return const_cast<" ^ class_name + ^ " *>(this)->__compare(Dynamic((::hx::Object *)inRHS)); }\n"); + + output_h "\t\tstatic void __register();\n"; + let native_gen = Meta.has Meta.NativeGen class_def.cl_meta in + let needs_gc_funcs = (not native_gen) && has_new_gc_references class_def in + if needs_gc_funcs then ( + output_h "\t\tvoid __Mark(HX_MARK_PARAMS);\n"; + output_h "\t\tvoid __Visit(HX_VISIT_PARAMS);\n"); + + let haxe_implementations, native_implementations = + CppGen.implementations class_def + in + let implements_haxe = Hashtbl.length haxe_implementations > 0 in + let implements_native = Hashtbl.length native_implementations > 0 in + + if implements_native then ( + let implemented_instance_fields = + List.filter should_implement_field class_def.cl_ordered_fields + in + let neededInterfaceFunctions = + match implements_native with + | true -> + CppGen.needed_interface_functions implemented_instance_fields + native_implementations + | false -> [] + in + + output_h "\n\t\tHX_NATIVE_IMPLEMENTATION\n"; + List.iter + (fun field -> + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> () + | TFun (args, return_type), _ -> + let retVal = type_to_string return_type in + let ret = if retVal = "void" then "" else "return " in + let name = keyword_remap field.cf_name in + let argNames = + List.map (fun (name, _, _) -> keyword_remap name) args + in + output_h + ("\t\t" ^ retVal ^ " " ^ name ^ "( " + ^ print_tfun_arg_list true args + ^ ") {\n"); + output_h + ("\t\t\t" ^ ret ^ "super::" ^ name ^ "( " + ^ String.concat "," argNames ^ ");\n\t\t}\n") + | _ -> ()) + neededInterfaceFunctions; + output_h "\n"); + + output_h "\t\tbool _hx_isInstanceOf(int inClassId);\n"; + if implements_haxe then ( + output_h "\t\tvoid *_hx_getInterface(int inHash);\n"; + (* generate header glue *) + let alreadyGlued = Hashtbl.create 0 in + Hashtbl.iter + (fun interface_name src -> + let rec check_interface interface = + let check_field field = + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> () + | TFun (args, return_type), Method _ -> + let cast = cpp_tfun_signature false args return_type in + let class_implementation = + find_class_implementation class_def field.cf_name interface + in + let realName = cpp_member_name_of field in + let castKey = realName ^ "::" ^ cast in + let castKey = + if interface_name = "_hx_haxe_IMap" && realName = "set" then + castKey ^ "*" + else castKey + in + let implementationKey = + realName ^ "::" ^ class_implementation + in + if castKey <> implementationKey then + let glue = + Printf.sprintf "%s_%08lx" field.cf_name + (gen_hash32 0 cast) + in + if not (Hashtbl.mem alreadyGlued castKey) then ( + Hashtbl.replace alreadyGlued castKey (); + let argList = print_tfun_arg_list true args in + let returnType = type_to_string return_type in + let headerCode = + "\t\t" ^ returnType ^ " " ^ glue ^ "(" ^ argList + ^ ");\n" + in + output_h headerCode; + output_h "\n") + | _ -> () + in + (match interface.cl_super with + | Some (super, _) -> check_interface super + | _ -> ()); + List.iter check_field interface.cl_ordered_fields + in + check_interface src) + haxe_implementations); + + if has_init_field class_def then output_h "\t\tstatic void __init__();\n\n"; + output_h + ("\t\t::String __ToString() const { return " ^ strq smart_class_name + ^ "; }\n\n")) + else if not nativeGen then output_h "\t\tHX_DO_INTERFACE_RTTI;\n\n" + else ( + CppGen.generate_native_constructor ctx output_h class_def true; + (* native interface *) ()); + + if has_boot_field class_def then output_h "\t\tstatic void __boot();\n"; + + (match class_def.cl_array_access with + | Some t -> output_h ("\t\ttypedef " ^ type_string t ^ " __array_access;\n") + | _ -> ()); + + List.iter + (gen_member_def ctx class_def true (has_class_flag class_def CInterface)) + (List.filter should_implement_field class_def.cl_ordered_statics); + + let not_toString (field, args, _) = + field.cf_name <> "toString" || has_class_flag class_def CInterface + in + let functions = List.filter not_toString (all_virtual_functions class_def) in + if has_class_flag class_def CInterface then + List.iter + (fun (field, _, _) -> gen_member_def ctx class_def false true field) + functions + else + List.iter + (gen_member_def ctx class_def false false) + (List.filter should_implement_field class_def.cl_ordered_fields); + + (if has_class_flag class_def CInterface then + match get_meta_string class_def.cl_meta Meta.ObjcProtocol with + | Some protocol -> + output_h + ("\t\tstatic id<" ^ protocol + ^ "> _hx_toProtocol(Dynamic inImplementation);\n") + | None -> ()); + + output_h (get_class_code class_def Meta.HeaderClassCode); + output_h "};\n\n"; + + end_namespace output_h class_path; + + end_header_file output_h def_string; + + h_file#close \ No newline at end of file diff --git a/src/generators/cpp/gen/cppGenClassImplementation.ml b/src/generators/cpp/gen/cppGenClassImplementation.ml new file mode 100644 index 00000000000..5ee9861bdc4 --- /dev/null +++ b/src/generators/cpp/gen/cppGenClassImplementation.ml @@ -0,0 +1,1392 @@ +open Ast +open Type +open Error +open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext +open CppGen + +let gen_field ctx class_def class_name is_static field = + ctx.ctx_real_this_ptr <- not is_static; + + let output = ctx.ctx_output in + let remap_name = keyword_remap field.cf_name in + let decl = get_meta_string field.cf_meta Meta.Decl in + let has_decl = match decl with Some _ -> true | None -> false in + match field.cf_expr with + (* Function field *) + | Some { eexpr = TFunction function_def } -> + let return_type_str = type_to_string function_def.tf_type in + let nargs = string_of_int (List.length function_def.tf_args) in + let return_type = cpp_type_of function_def.tf_type in + let is_void = return_type = TCppVoid in + let ret = if is_void then "(void)" else "return " in + + let needsWrapper t = + match t with + | TCppStar _ -> true + | TCppInst (t, _) -> Meta.has Meta.StructAccess t.cl_meta + | _ -> false + in + let orig_debug = ctx.ctx_debug_level in + let no_debug = Meta.has Meta.NoDebug field.cf_meta in + + if not (is_dynamic_haxe_method field) then ( + (* The actual function definition *) + let remap_name = native_field_name_remap is_static field in + output (if is_void then "void" else return_type_str); + output (" " ^ class_name ^ "::" ^ remap_name ^ "("); + output (print_arg_list function_def.tf_args "__o_"); + output ")"; + ctx.ctx_real_this_ptr <- true; + let code = get_code field.cf_meta Meta.FunctionCode in + let tail_code = get_code field.cf_meta Meta.FunctionTailCode in + + match get_meta_string field.cf_meta Meta.Native with + | Some nativeImpl when is_static -> + output " {\n"; + output + ("\t" ^ ret ^ "::" ^ nativeImpl ^ "(" + ^ print_arg_list_name function_def.tf_args "__o_" + ^ ");\n"); + output "}\n\n" + | _ -> + gen_cpp_function_body ctx class_def is_static field.cf_name + function_def code tail_code no_debug; + + output "\n\n"; + let nonVirtual = Meta.has Meta.NonVirtual field.cf_meta in + let doDynamic = + (nonVirtual || not (is_override field)) + && reflective class_def field + in + (* generate dynamic version too ... *) + if doDynamic then + let tcpp_args = + List.map + (fun (v, _) -> cpp_type_of v.v_type) + function_def.tf_args + in + let wrap = + needsWrapper return_type || List.exists needsWrapper tcpp_args + in + if wrap then ( + let wrapName = "_hx_wrap" ^ class_name ^ "_" ^ remap_name in + output ("static ::Dynamic " ^ wrapName ^ "( "); + let sep = ref " " in + if not is_static then ( + output "::hx::Object *obj"; + sep := ","); + ExtList.List.iteri + (fun i _ -> + output (!sep ^ "const Dynamic &a" ^ string_of_int i); + sep := ",") + tcpp_args; + output ") {\n\t"; + (if not is_void then + match return_type with + | TCppStar _ -> output "return (cpp::Pointer) " + | TCppInst (t, _) when Meta.has Meta.StructAccess t.cl_meta + -> + output + ("return (cpp::Struct< " ^ tcpp_to_string return_type + ^ " >) ") + | _ -> output "return "); + + if is_static then output (class_name ^ "::" ^ remap_name ^ "(") + else + output + ("reinterpret_cast< " ^ class_name ^ " *>(obj)->" + ^ remap_name ^ "("); + + sep := ""; + ExtList.List.iteri + (fun i arg -> + output !sep; + sep := ","; + (match arg with + | TCppStar (t, const) -> + output + ("(cpp::" + ^ (if const then "Const" else "") + ^ "Pointer<" ^ tcpp_to_string t ^ " >) ") + | TCppInst (t, _) when Meta.has Meta.StructAccess t.cl_meta + -> + output ("(cpp::Struct< " ^ tcpp_to_string arg ^ " >) ") + | _ -> ()); + output ("a" ^ string_of_int i)) + tcpp_args; + + output ");\n"; + + if is_void then output "\treturn null();\n"; + output "}\n"; + let nName = string_of_int (List.length tcpp_args) in + output + ("::Dynamic " ^ class_name ^ "::" ^ remap_name + ^ "_dyn() {\n\treturn "); + if is_static then + output + ("::hx::CreateStaticFunction" ^ nName ^ "(\"" ^ remap_name + ^ "\"," ^ wrapName ^ ");") + else + output + ("::hx::CreateMemberFunction" ^ nName ^ "(\"" ^ remap_name + ^ "\",this," ^ wrapName ^ ");"); + output "}\n") + else ( + if is_static then output "STATIC_"; + output + ("HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," + ^ remap_name ^ "," ^ ret ^ ")\n\n"))) + else ( + ctx.ctx_real_this_ptr <- false; + let func_name = "__default_" ^ remap_name in + output ("HX_BEGIN_DEFAULT_FUNC(" ^ func_name ^ "," ^ class_name ^ ")\n"); + output return_type_str; + output + (" _hx_run(" ^ print_arg_list function_def.tf_args "__o_" ^ ")"); + gen_cpp_function_body ctx class_def is_static func_name function_def "" + "" no_debug; + + output ("HX_END_LOCAL_FUNC" ^ nargs ^ "(" ^ ret ^ ")\n"); + output "HX_END_DEFAULT_FUNC\n\n"; + + if is_static then + output ("::Dynamic " ^ class_name ^ "::" ^ remap_name ^ ";\n\n")); + ctx.ctx_debug_level <- orig_debug + (* Data field *) + | _ when has_decl -> + if is_static then ( + output (class_name ^ "::" ^ remap_name ^ "_decl "); + output (" " ^ class_name ^ "::" ^ remap_name ^ ";\n\n")) + | _ -> + if is_static && is_physical_field field then ( + gen_type ctx field.cf_type; + output (" " ^ class_name ^ "::" ^ remap_name ^ ";\n\n")) + else if has_class_field_flag field CfAbstract then + let tl, tr = + match follow field.cf_type with + | TFun (tl, tr) -> (tl, tr) + | _ -> die "" __LOC__ + in + let nargs = string_of_int (List.length tl) in + let return_type = cpp_type_of tr in + let is_void = return_type = TCppVoid in + let ret = if is_void then "(void)" else "return " in + output + ("HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," + ^ remap_name ^ "," ^ ret ^ ")\n\n") + +let gen_field_init ctx class_def field = + let dot_name = join_class_path class_def.cl_path "." in + let output = ctx.ctx_output in + let remap_name = keyword_remap field.cf_name in + + match field.cf_expr with + (* Function field *) + | Some { eexpr = TFunction function_def } -> + if is_dynamic_haxe_method field then + let func_name = "__default_" ^ remap_name in + output ("\t" ^ remap_name ^ " = new " ^ func_name ^ ";\n\n") + (* Data field *) + | Some expr -> + let var_name = + match remap_name with + | "__meta__" -> "__mClass->__meta__" + | "__rtti" -> "__mClass->__rtti__" + | _ -> remap_name + in + + gen_cpp_init ctx dot_name "boot" (var_name ^ " = ") expr + | _ -> () + +let cpp_get_interface_slot ctx name = + try Hashtbl.find !(ctx.ctx_interface_slot) name + with Not_found -> + let result = !(ctx.ctx_interface_slot_count) in + Hashtbl.replace !(ctx.ctx_interface_slot) name result; + ctx.ctx_interface_slot_count := !(ctx.ctx_interface_slot_count) + 1; + result + +let generate_protocol_delegate ctx class_def output = + let protocol = + get_meta_string class_def.cl_meta Meta.ObjcProtocol |> Option.default "" + in + let full_class_name = + ("::" ^ join_class_path_remap class_def.cl_path "::") ^ "_obj" + in + let name = "_hx_" ^ protocol ^ "_delegate" in + output ("@interface " ^ name ^ " : NSObject<" ^ protocol ^ "> {\n"); + output "\t::hx::Object *haxeObj;\n"; + output "}\n"; + output "@end\n\n"; + output ("@implementation " ^ name ^ "\n"); + output "- (id)initWithImplementation:( ::hx::Object *)inInplemnetation {\n"; + output " if (self = [super init]) {\n"; + output " self->haxeObj = inInplemnetation;\n"; + output " GCAddRoot(&self->haxeObj);\n"; + output " }\n"; + output " return self;\n"; + output "}\n"; + output "- (void)dealloc {\n"; + output " GCRemoveRoot(&self->haxeObj);\n"; + output " #ifndef OBJC_ARC\n"; + output " [super dealloc];\n"; + output " #endif\n"; + output "}\n\n"; + + let dump_delegate field = + match field.cf_type with + | TFun (args, ret) -> + let retStr = type_to_string ret in + let fieldName, argNames = + match get_meta_string field.cf_meta Meta.ObjcProtocol with + | Some nativeName -> + let parts = ExtString.String.nsplit nativeName ":" in + (List.hd parts, parts) + | None -> (field.cf_name, List.map (fun (n, _, _) -> n) args) + in + output ("- (" ^ retStr ^ ") " ^ fieldName); + + let first = ref true in + (try + List.iter2 + (fun (name, _, argType) signature_name -> + if !first then + output (" :(" ^ type_to_string argType ^ ")" ^ name) + else + output + (" " ^ signature_name ^ ":(" ^ type_to_string argType ^ ")" + ^ name); + first := false) + args argNames + with Invalid_argument _ -> + abort + (let argString = + String.concat "," (List.map (fun (name, _, _) -> name) args) + in + "Invalid arg count in delegate in " ^ field.cf_name ^ " '" + ^ field.cf_name ^ "," ^ argString ^ "' != '" + ^ String.concat "," argNames ^ "'") + field.cf_pos); + output " {\n"; + output "\t::hx::NativeAttach _hx_attach;\n"; + output + ((if retStr = "void" then "\t" else "\treturn ") + ^ full_class_name ^ "::" + ^ keyword_remap field.cf_name + ^ "(haxeObj"); + List.iter (fun (name, _, _) -> output ("," ^ name)) args; + output ");\n}\n\n" + | _ -> () + in + List.iter dump_delegate class_def.cl_ordered_fields; + + output "@end\n\n" + +let generate baseCtx class_def = + let common_ctx = baseCtx.ctx_common in + let class_path = class_def.cl_path in + let debug = baseCtx.ctx_debug_level in + let cpp_file = new_placed_cpp_file baseCtx.ctx_common class_path in + let cpp_ctx = file_context baseCtx cpp_file debug false in + let ctx = cpp_ctx in + let output_cpp = cpp_file#write in + let strq = strq ctx.ctx_common in + let scriptable = + Gctx.defined common_ctx Define.Scriptable && not class_def.cl_private + in + + let class_super_name = + match class_def.cl_super with + | Some (klass, params) -> + tcpp_to_string_suffix "_obj" (cpp_instance_type klass params) + | _ -> "" + in + if debug > 1 then + print_endline + ("Found class definition:" ^ join_class_path class_def.cl_path "::"); + + cpp_file#write_h "#include \n\n"; + + let constructor_deps = create_constructor_dependencies common_ctx in + let super_deps = create_super_dependencies common_ctx in + let all_referenced = + CppReferences.find_referenced_types ctx (TClassDecl class_def) super_deps + constructor_deps false false scriptable + in + List.iter (add_include cpp_file) all_referenced; + + if scriptable then cpp_file#write_h "#include \n"; + + cpp_file#write_h "\n"; + + output_cpp (get_class_code class_def Meta.CppFileCode); + let includes = get_all_meta_string_path class_def.cl_meta Meta.CppInclude in + let printer inc = output_cpp ("#include \"" ^ inc ^ "\"\n") in + List.iter printer includes; + + begin_namespace output_cpp class_path; + output_cpp "\n"; + + output_cpp (get_class_code class_def Meta.CppNamespaceCode); + + let nativeGen = Meta.has Meta.NativeGen class_def.cl_meta in + let class_name = class_name class_def in + let cargs = constructor_arg_var_list class_def in + let constructor_type_var_list = List.map snd cargs in + let constructor_var_list = List.map snd constructor_type_var_list in + let constructor_type_args = + String.concat "," + (List.map (fun (t, a) -> t ^ " " ^ a) constructor_type_var_list) + in + let haxe_implementations, native_implementations = + implementations class_def + in + + if (not (has_class_flag class_def CInterface)) && not nativeGen then ( + output_cpp + ("void " ^ class_name ^ "::__construct(" ^ constructor_type_args ^ ")"); + (match class_def.cl_constructor with + | Some ({ cf_expr = Some { eexpr = TFunction function_def } } as definition) + -> + with_debug ctx definition.cf_meta (fun no_debug -> + gen_cpp_function_body ctx class_def false "new" function_def "" "" + no_debug; + output_cpp "\n") + | _ -> output_cpp " { }\n\n"); + + (* Destructor goes in the cpp file so we can "see" the full definition of the member vars *) + if not (has_class_flag class_def CAbstract) then ( + let ptr_name = class_pointer class_def in + let array_arg_list inList = + (* Convert an array to a comma separated list of values *) + let i = ref (0 - 1) in + String.concat "," + (List.map + (fun _ -> + incr i; + "inArgs[" ^ string_of_int !i ^ "]") + inList) + in + + output_cpp + ("Dynamic " ^ class_name ^ "::__CreateEmpty() { return new " + ^ class_name ^ "; }\n\n"); + output_cpp ("void *" ^ class_name ^ "::_hx_vtable = 0;\n\n"); + + output_cpp + ("Dynamic " ^ class_name ^ "::__Create(::hx::DynamicArray inArgs)\n"); + output_cpp + ("{\n\t" ^ ptr_name ^ " _hx_result = new " ^ class_name ^ "();\n"); + output_cpp + ("\t_hx_result->__construct(" + ^ array_arg_list constructor_var_list + ^ ");\n"); + output_cpp "\treturn _hx_result;\n}\n\n"); + let rec addParent cls others = + match cls.cl_super with + | Some (super, _) -> ( + try + let parentId = + Hashtbl.find ctx.ctx_type_ids (class_text super.cl_path) + in + addParent super (parentId :: others) + with Not_found -> others) + | _ -> others + in + let classId = + try Hashtbl.find baseCtx.ctx_type_ids (class_text class_def.cl_path) + with Not_found -> Int32.zero + in + let implemented_classes = addParent class_def [ classId; Int32.of_int 1 ] in + let implemented_classes = List.sort compare implemented_classes in + + output_cpp ("bool " ^ class_name ^ "::_hx_isInstanceOf(int inClassId) {\n"); + let txt cId = Printf.sprintf "0x%08lx" cId in + let rec dump_classes indent classes = + match classes with + | [] -> () + | [ c ] -> output_cpp (indent ^ "return inClassId==(int)" ^ txt c ^ ";\n") + | [ c; c1 ] -> + output_cpp + (indent ^ "return inClassId==(int)" ^ txt c ^ " || inClassId==(int)" + ^ txt c1 ^ ";\n") + | _ -> + let len = List.length classes in + let mid = List.nth classes (len / 2) in + let low, high = List.partition (fun e -> e <= mid) classes in + output_cpp (indent ^ "if (inClassId<=(int)" ^ txt mid ^ ") {\n"); + dump_classes (indent ^ "\t") low; + output_cpp (indent ^ "} else {\n"); + dump_classes (indent ^ "\t") high; + output_cpp (indent ^ "}\n") + in + dump_classes "\t" implemented_classes; + output_cpp "}\n\n"; + + let implements_haxe_keys = hash_keys haxe_implementations in + let implements_haxe = Hashtbl.length haxe_implementations > 0 in + + if implements_haxe then ( + let alreadyGlued = Hashtbl.create 0 in + let cname = "_hx_" ^ join_class_path class_def.cl_path "_" in + let implname = cpp_class_name class_def in + let cpp_glue = ref [] in + List.iter + (fun interface_name -> + try + let interface = Hashtbl.find haxe_implementations interface_name in + output_cpp + ("static " ^ cpp_class_name interface ^ " " ^ cname ^ "_" + ^ interface_name ^ "= {\n"); + let rec gen_interface_funcs interface = + let gen_field field = + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> () + | TFun (args, return_type), Method _ -> + let cast = cpp_tfun_signature false args return_type in + let class_implementation = + find_class_implementation class_def field.cf_name + interface + in + let realName = cpp_member_name_of field in + let castKey = realName ^ "::" ^ cast in + (* C++ can't work out which function it needs to take the addrss of + when the implementation is overloaded - currently the map-set functions. + Change the castKey to force a glue function in this case (could double-cast the pointer, but it is ugly) + *) + let castKey = + if interface_name = "_hx_haxe_IMap" && realName = "set" + then castKey ^ "*" + else castKey + in + let implementationKey = + realName ^ "::" ^ class_implementation + in + if castKey <> implementationKey then ( + let glue = + Printf.sprintf "%s_%08lx" field.cf_name + (gen_hash32 0 cast) + in + if not (Hashtbl.mem alreadyGlued castKey) then ( + Hashtbl.replace alreadyGlued castKey (); + let argList = print_tfun_arg_list true args in + let returnType = type_to_string return_type in + let returnStr = + if returnType = "void" then "" else "return " + in + let cppCode = + returnType ^ " " ^ class_name ^ "::" ^ glue ^ "(" + ^ argList ^ ") {\n" ^ "\t\t\t" ^ returnStr ^ realName + ^ "(" ^ print_arg_names args ^ ");\n}\n" + in + (* let headerCode = "\t\t" ^ returnType ^ " " ^ glue ^ "(" ^ argList ^ ");\n" in *) + (* header_glue := headerCode :: !header_glue; *) + cpp_glue := cppCode :: !cpp_glue); + output_cpp + ("\t" ^ cast ^ "&" ^ implname ^ "::" ^ glue ^ ",\n")) + else + output_cpp + ("\t" ^ cast ^ "&" ^ implname ^ "::" ^ realName ^ ",\n") + | _ -> () + in + (match interface.cl_super with + | Some super -> gen_interface_funcs (fst super) + | _ -> ()); + List.iter gen_field interface.cl_ordered_fields + in + gen_interface_funcs interface; + output_cpp "};\n\n" + with Not_found -> ()) + implements_haxe_keys; + + output_cpp (String.concat "\n" !cpp_glue); + + output_cpp ("void *" ^ class_name ^ "::_hx_getInterface(int inHash) {\n"); + output_cpp "\tswitch(inHash) {\n"; + List.iter + (fun interface_name -> + try + let interface = Hashtbl.find haxe_implementations interface_name in + output_cpp + ("\t\tcase (int)" ^ cpp_class_hash interface ^ ": return &" + ^ cname ^ "_" ^ interface_name ^ ";\n") + with Not_found -> ()) + implements_haxe_keys; + + output_cpp "\t}\n"; + + if class_super_name = "" then ( + output_cpp "\t#ifdef HXCPP_SCRIPTABLE\n"; + output_cpp "\treturn super::_hx_getInterface(inHash);\n"; + output_cpp "\t#else\n"; + output_cpp "\treturn 0;\n"; + output_cpp "\t#endif\n") + else output_cpp "\treturn super::_hx_getInterface(inHash);\n"; + output_cpp "}\n\n")); + + (match TClass.get_cl_init class_def with + | Some expression -> + let ctx = file_context baseCtx cpp_file debug false in + output_cpp ("void " ^ class_name ^ "::__init__()"); + gen_cpp_init ctx (cpp_class_name class_def) "__init__" "" + (mk_block expression); + output_cpp "\n\n" + | _ -> ()); + + let dump_field_name field = output_cpp ("\t" ^ strq field.cf_name ^ ",\n") in + let statics_except_meta = statics_except_meta class_def in + let implemented_fields = + List.filter should_implement_field statics_except_meta + in + + List.iter + (gen_field ctx class_def class_name false) + class_def.cl_ordered_fields; + List.iter (gen_field ctx class_def class_name true) statics_except_meta; + output_cpp "\n"; + + let dynamic_functions = dynamic_functions class_def in + if List.length dynamic_functions > 0 then ( + output_cpp + ("void " ^ class_name ^ "::__alloc_dynamic_functions(::hx::Ctx *_hx_ctx," + ^ class_name ^ " *_hx_obj) {\n"); + List.iter + (fun name -> + output_cpp + ("\tif (!_hx_obj->" ^ name ^ ".mPtr) _hx_obj->" ^ name + ^ " = new __default_" ^ name ^ "(_hx_obj);\n")) + dynamic_functions; + (match class_def.cl_super with + | Some super -> + let rec find_super class_def = + if has_dynamic_member_functions class_def then + let super_name = + join_class_path_remap class_def.cl_path "::" ^ "_obj" + in + output_cpp + ("\t" ^ super_name + ^ "::__alloc_dynamic_functions(_hx_ctx,_hx_obj);\n") + else + match class_def.cl_super with + | Some super -> find_super (fst super) + | _ -> () + in + find_super (fst super) + | _ -> ()); + output_cpp "}\n"); + + let inline_constructor = + can_inline_constructor baseCtx class_def super_deps + (create_constructor_dependencies common_ctx) + in + if + (not (has_class_flag class_def CInterface)) + && (not nativeGen) && (not inline_constructor) + && not (has_class_flag class_def CAbstract) + then generate_constructor ctx output_cpp class_def false + else if nativeGen then + generate_native_constructor ctx output_cpp class_def false; + + let reflect_member_fields = + List.filter (reflective class_def) class_def.cl_ordered_fields + in + let reflect_static_fields = + List.filter (reflective class_def) statics_except_meta + in + + (* Initialise non-static variables *) + if (not (has_class_flag class_def CInterface)) && not nativeGen then ( + output_cpp (class_name ^ "::" ^ class_name ^ "()\n{\n"); + List.iter + (fun name -> + output_cpp ("\t" ^ name ^ " = new __default_" ^ name ^ "(this);\n")) + dynamic_functions; + output_cpp "}\n\n"; + + let dump_field_iterator macro field = + if is_data_member field then ( + let remap_name = keyword_remap field.cf_name in + output_cpp + ("\t" ^ macro ^ "(" ^ remap_name ^ ",\"" ^ field.cf_name ^ "\");\n"); + + (match field.cf_kind with + | Var { v_read = AccCall } + when is_dynamic_accessor ("get_" ^ field.cf_name) "get" field + class_def -> + let name = "get_" ^ field.cf_name in + output_cpp ("\t" ^ macro ^ "(" ^ name ^ "," ^ "\"" ^ name ^ "\");\n") + | _ -> ()); + match field.cf_kind with + | Var { v_write = AccCall } + when is_dynamic_accessor ("set_" ^ field.cf_name) "set" field + class_def -> + let name = "set_" ^ field.cf_name in + output_cpp ("\t" ^ macro ^ "(" ^ name ^ "," ^ "\"" ^ name ^ "\");\n") + | _ -> ()) + in + + let implemented_instance_fields = + List.filter should_implement_field class_def.cl_ordered_fields + in + + let override_iteration = + (not nativeGen) && has_new_gc_references class_def + in + if override_iteration then ( + let super_needs_iteration = find_next_super_iteration class_def in + let smart_class_name = snd class_path in + (* MARK function - explicitly mark all child pointers *) + output_cpp ("void " ^ class_name ^ "::__Mark(HX_MARK_PARAMS)\n{\n"); + output_cpp ("\tHX_MARK_BEGIN_CLASS(" ^ smart_class_name ^ ");\n"); + List.iter + (dump_field_iterator "HX_MARK_MEMBER_NAME") + implemented_instance_fields; + (match super_needs_iteration with + | "" -> () + | super -> output_cpp ("\t" ^ super ^ "::__Mark(HX_MARK_ARG);\n")); + output_cpp "\tHX_MARK_END_CLASS();\n"; + output_cpp "}\n\n"; + + (* Visit function - explicitly visit all child pointers *) + output_cpp ("void " ^ class_name ^ "::__Visit(HX_VISIT_PARAMS)\n{\n"); + List.iter + (dump_field_iterator "HX_VISIT_MEMBER_NAME") + implemented_instance_fields; + (match super_needs_iteration with + | "" -> () + | super -> output_cpp ("\t" ^ super ^ "::__Visit(HX_VISIT_ARG);\n")); + output_cpp "}\n\n"); + + let dump_quick_field_test fields = + if List.length fields > 0 then ( + let len = function _, l, _ -> l in + let sfields = List.sort (fun f1 f2 -> len f1 - len f2) fields in + let len_case = ref (-1) in + output_cpp "\tswitch(inName.length) {\n"; + List.iter + (fun (field, l, result) -> + if l <> !len_case then ( + if !len_case >= 0 then output_cpp "\t\tbreak;\n"; + output_cpp ("\tcase " ^ string_of_int l ^ ":\n"); + len_case := l); + output_cpp + ("\t\tif (HX_FIELD_EQ(inName,\"" + ^ StringHelper.s_escape field + ^ "\") ) { " ^ result ^ " }\n")) + sfields; + output_cpp "\t}\n") + in + + let checkPropCall field = + if + Meta.has Meta.NativeProperty class_def.cl_meta + || Meta.has Meta.NativeProperty field.cf_meta + || Gctx.defined common_ctx Define.ForceNativeProperty + then "inCallProp != ::hx::paccNever" + else "inCallProp == ::hx::paccAlways" + in + + let toCommon t f value = + t ^ "( " + ^ (match cpp_type_of f.cf_type with + | TCppInst (t, _) as inst when Meta.has Meta.StructAccess t.cl_meta -> + "cpp::Struct< " ^ tcpp_to_string inst ^ " >( " ^ value ^ " )" + | TCppStar (t, _) -> "cpp::Pointer( " ^ value ^ " )" + | _ -> value) + ^ " )" + in + let toVal f value = toCommon "::hx::Val" f value in + let toDynamic f value = toCommon "" f value in + + if has_get_member_field class_def then ( + (* Dynamic "Get" Field function - string version *) + output_cpp + ("::hx::Val " ^ class_name + ^ "::__Field(const ::String &inName,::hx::PropertyAccess inCallProp)\n\ + {\n"); + let get_field_dat = + List.map (fun f -> + ( f.cf_name, + String.length f.cf_name, + match f.cf_kind with + | Var { v_read = AccCall } when not (is_physical_field f) -> + "if (" ^ checkPropCall f ^ ") return " + ^ toVal f (keyword_remap ("get_" ^ f.cf_name) ^ "()") + ^ ";" + | Var { v_read = AccCall } -> + "return " + ^ toVal f + (checkPropCall f ^ " ? " + ^ keyword_remap ("get_" ^ f.cf_name) + ^ "() : " ^ keyword_remap f.cf_name + ^ if variable_field f then "" else "_dyn()") + ^ ";" + | _ -> + "return " + ^ toVal f + (keyword_remap f.cf_name + ^ if variable_field f then "" else "_dyn()") + ^ ";" )) + in + let reflect_member_readable = + List.filter (is_readable class_def) reflect_member_fields + in + dump_quick_field_test (get_field_dat reflect_member_readable); + output_cpp "\treturn super::__Field(inName,inCallProp);\n}\n\n"); + + if has_get_static_field class_def then ( + output_cpp + ("bool " ^ class_name + ^ "::__GetStatic(const ::String &inName, Dynamic &outValue, \ + ::hx::PropertyAccess inCallProp)\n\ + {\n"); + let get_field_dat = + List.map (fun f -> + ( f.cf_name, + String.length f.cf_name, + match f.cf_kind with + | Var { v_read = AccCall } when not (is_physical_field f) -> + "if (" ^ checkPropCall f ^ ") { outValue = " + ^ toDynamic f (keyword_remap ("get_" ^ f.cf_name) ^ "()") + ^ "; return true; }" + | Var { v_read = AccCall } -> + "outValue = " + ^ toDynamic f + (checkPropCall f ^ " ? " + ^ keyword_remap ("get_" ^ f.cf_name) + ^ "() : " ^ keyword_remap f.cf_name + ^ if variable_field f then "" else "_dyn()") + ^ "; return true;" + | _ when variable_field f -> + "outValue = " + ^ toDynamic f (keyword_remap f.cf_name) + ^ "; return true;" + | _ -> + "outValue = " + ^ native_field_name_remap true f + ^ "_dyn(); return true;" )) + in + let reflect_static_readable = + List.filter (is_readable class_def) reflect_static_fields + in + dump_quick_field_test (get_field_dat reflect_static_readable); + output_cpp "\treturn false;\n}\n\n"); + + let castable f = + match cpp_type_of f.cf_type with + | TCppInst (t, _) as inst when Meta.has Meta.StructAccess t.cl_meta -> + "cpp::Struct< " ^ tcpp_to_string inst ^ " > " + | TCppStar (t, _) -> "cpp::Pointer< " ^ tcpp_to_string t ^ " >" + | _ -> type_to_string f.cf_type + in + + (* Dynamic "Set" Field function *) + if has_set_member_field class_def then ( + output_cpp + ("::hx::Val " ^ class_name + ^ "::__SetField(const ::String &inName,const ::hx::Val \ + &inValue,::hx::PropertyAccess inCallProp)\n\ + {\n"); + + let set_field_dat = + List.map (fun f -> + let default_action = + if is_gc_element ctx (cpp_type_of f.cf_type) then + "_hx_set_" ^ keyword_remap f.cf_name + ^ "(HX_CTX_GET,inValue.Cast< " ^ castable f ^ " >());" + ^ " return inValue;" + else + keyword_remap f.cf_name ^ "=inValue.Cast< " ^ castable f + ^ " >();" ^ " return inValue;" + in + ( f.cf_name, + String.length f.cf_name, + match f.cf_kind with + | Var { v_write = AccCall } -> + let inVal = "(inValue.Cast< " ^ castable f ^ " >())" in + let setter = keyword_remap ("set_" ^ f.cf_name) in + "if (" ^ checkPropCall f ^ ") return " + ^ toVal f (setter ^ inVal) + ^ ";" + ^ if not (is_physical_field f) then "" else default_action + | _ -> default_action )) + in + + let reflect_member_writable = + List.filter (is_writable class_def) reflect_member_fields + in + let reflect_write_member_variables = + List.filter variable_field reflect_member_writable + in + dump_quick_field_test (set_field_dat reflect_write_member_variables); + output_cpp "\treturn super::__SetField(inName,inValue,inCallProp);\n}\n\n"); + + if has_set_static_field class_def then ( + output_cpp + ("bool " ^ class_name + ^ "::__SetStatic(const ::String &inName,Dynamic \ + &ioValue,::hx::PropertyAccess inCallProp)\n\ + {\n"); + + let set_field_dat = + List.map (fun f -> + let default_action = + keyword_remap f.cf_name ^ "=ioValue.Cast< " ^ castable f + ^ " >(); return true;" + in + ( f.cf_name, + String.length f.cf_name, + match f.cf_kind with + | Var { v_write = AccCall } -> + let inVal = "(ioValue.Cast< " ^ castable f ^ " >())" in + let setter = keyword_remap ("set_" ^ f.cf_name) in + "if (" ^ checkPropCall f ^ ") ioValue = " + ^ toDynamic f (setter ^ inVal) + ^ ";" + ^ + if not (is_physical_field f) then "" + else " else " ^ default_action + | _ -> default_action )) + in + + let reflect_static_writable = + List.filter (is_writable class_def) reflect_static_fields + in + let reflect_write_static_variables = + List.filter variable_field reflect_static_writable + in + dump_quick_field_test (set_field_dat reflect_write_static_variables); + output_cpp "\treturn false;\n}\n\n"); + + (* For getting a list of data members (eg, for serialization) *) + if has_get_fields class_def then ( + let append_field field = + output_cpp ("\toutFields->push(" ^ strq field.cf_name ^ ");\n") + in + let is_data_field field = + match follow field.cf_type with TFun _ -> false | _ -> true + in + + output_cpp + ("void " ^ class_name + ^ "::__GetFields(Array< ::String> &outFields)\n{\n"); + List.iter append_field + (List.filter is_data_field class_def.cl_ordered_fields); + output_cpp "\tsuper::__GetFields(outFields);\n"; + output_cpp "};\n\n"); + + let storage field = + match cpp_type_of field.cf_type with + | TCppScalar "bool" -> "::hx::fsBool" + | TCppScalar "int" -> "::hx::fsInt" + | TCppScalar "Float" -> "::hx::fsFloat" + | TCppString -> "::hx::fsString" + | o when is_object_element o -> + "::hx::fsObject" ^ " /* " ^ tcpp_to_string o ^ " */ " + | u -> "::hx::fsUnknown" ^ " /* " ^ tcpp_to_string u ^ " */ " + in + let dump_member_storage field = + output_cpp + ("\t{" ^ storage field ^ ",(int)offsetof(" ^ class_name ^ "," + ^ keyword_remap field.cf_name + ^ ")," ^ strq field.cf_name ^ "},\n") + in + let dump_static_storage field = + output_cpp + ("\t{" ^ storage field ^ ",(void *) &" ^ class_name ^ "::" + ^ keyword_remap field.cf_name + ^ "," ^ strq field.cf_name ^ "},\n") + in + + output_cpp "#ifdef HXCPP_SCRIPTABLE\n"; + + let stored_fields = + List.filter is_data_member implemented_instance_fields + in + if List.length stored_fields > 0 then ( + output_cpp + ("static ::hx::StorageInfo " ^ class_name + ^ "_sMemberStorageInfo[] = {\n"); + List.iter dump_member_storage stored_fields; + output_cpp "\t{ ::hx::fsUnknown, 0, null()}\n};\n") + else + output_cpp + ("static ::hx::StorageInfo *" ^ class_name + ^ "_sMemberStorageInfo = 0;\n"); + + let stored_statics = List.filter is_data_member implemented_fields in + if List.length stored_statics > 0 then ( + output_cpp + ("static ::hx::StaticInfo " ^ class_name ^ "_sStaticStorageInfo[] = {\n"); + List.iter dump_static_storage stored_statics; + output_cpp "\t{ ::hx::fsUnknown, 0, null()}\n};\n") + else + output_cpp + ("static ::hx::StaticInfo *" ^ class_name ^ "_sStaticStorageInfo = 0;\n"); + + output_cpp "#endif\n\n"); + + (* cl_interface *) + let implemented_instance_fields = + List.filter should_implement_field class_def.cl_ordered_fields + in + let reflective_members = + List.filter (reflective class_def) implemented_instance_fields + in + let sMemberFields = + match reflective_members with + | [] -> "0 /* sMemberFields */" + | _ -> + let memberFields = class_name ^ "_sMemberFields" in + output_cpp ("static ::String " ^ memberFields ^ "[] = {\n"); + List.iter dump_field_name reflective_members; + output_cpp "\t::String(null()) };\n\n"; + memberFields + in + + let hasMarkFunc = + (not nativeGen) && List.exists is_data_member implemented_fields + in + + if hasMarkFunc then ( + (* Mark static variables as used *) + output_cpp + ("static void " ^ class_name ^ "_sMarkStatics(HX_MARK_PARAMS) {\n"); + List.iter + (fun field -> + if is_data_member field then + output_cpp + ("\tHX_MARK_MEMBER_NAME(" ^ class_name ^ "::" + ^ keyword_remap field.cf_name + ^ ",\"" ^ field.cf_name ^ "\");\n")) + implemented_fields; + output_cpp "};\n\n"; + + (* Visit static variables *) + output_cpp "#ifdef HXCPP_VISIT_ALLOCS\n"; + output_cpp + ("static void " ^ class_name ^ "_sVisitStatics(HX_VISIT_PARAMS) {\n"); + List.iter + (fun field -> + if is_data_member field then + output_cpp + ("\tHX_VISIT_MEMBER_NAME(" ^ class_name ^ "::" + ^ keyword_remap field.cf_name + ^ ",\"" ^ field.cf_name ^ "\");\n")) + implemented_fields; + output_cpp "};\n\n"; + output_cpp "#endif\n\n"); + + let generate_script_function isStatic field scriptName callName = + match follow field.cf_type with + | TFun (args, return_type) when not (is_data_member field) -> + let isTemplated = + (not isStatic) && not (has_class_flag class_def CInterface) + in + if isTemplated then output_cpp "\ntemplate"; + output_cpp + ("\nstatic void CPPIA_CALL " ^ scriptName + ^ "(::hx::CppiaCtx *ctx) {\n"); + let ret = + match cpp_type_of return_type with + | TCppScalar "bool" -> "b" + | _ -> CppCppia.script_signature return_type false + in + if ret <> "v" then + output_cpp + ("ctx->return" ^ CppCppia.script_type return_type false ^ "("); + + let dump_call cast = + if has_class_flag class_def CInterface then + output_cpp + (class_name ^ "::" ^ callName ^ "(ctx->getThis()" + ^ if List.length args > 0 then "," else "") + else if isStatic then output_cpp (class_name ^ "::" ^ callName ^ "(") + else + output_cpp + ("((" ^ class_name ^ "*)ctx->getThis())->" ^ cast ^ callName ^ "("); + + let signature, _, _ = + List.fold_left + (fun (signature, sep, size) (_, opt, t) -> + output_cpp + (sep ^ "ctx->get" ^ CppCppia.script_type t opt ^ "(" ^ size + ^ ")"); + ( signature ^ CppCppia.script_signature t opt, + ",", + size ^ "+sizeof(" ^ CppCppia.script_size_type t opt ^ ")" )) + (ret, "", "sizeof(void*)") args + in + output_cpp ")"; + signature + in + let signature = + if isTemplated then ( + output_cpp " _HX_SUPER ? "; + ignore (dump_call (class_name ^ "::")); + output_cpp " : "; + dump_call "") + else dump_call "" + in + + if ret <> "v" then output_cpp ")"; + output_cpp ";\n}\n"; + signature + | _ -> "" + in + + let newInteface = has_class_flag class_def CInterface in + + if scriptable && not nativeGen then ( + let delegate = "this->" in + let dump_script_field idx (field, f_args, return_t) = + let args = print_tfun_arg_list true f_args in + let names = List.map (fun (n, _, _) -> keyword_remap n) f_args in + let return_type = type_to_string return_t in + let ret = + if return_type = "Void" || return_type = "void" then " " else "return " + in + let name = keyword_remap field.cf_name in + let vtable = "__scriptVTable[" ^ string_of_int (idx + 1) ^ "] " in + let args_varray = + List.fold_left + (fun l n -> l ^ ".Add(" ^ n ^ ")") + "Array()" names + in + + output_cpp ("\t" ^ return_type ^ " " ^ name ^ "( " ^ args ^ " ) {\n"); + if newInteface then ( + output_cpp "\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n"; + output_cpp "\t\t::hx::AutoStack __as(__ctx);\n"; + output_cpp "\t\t__ctx->pushObject(this);\n"; + List.iter + (fun (name, opt, t) -> + output_cpp + ("\t\t__ctx->push" ^ CppCppia.script_type t opt ^ "(" + ^ keyword_remap name ^ ");\n")) + f_args; + let interfaceSlot = string_of_int (-cpp_get_interface_slot ctx name) in + output_cpp + ("\t\t" ^ ret ^ "__ctx->run" + ^ CppCppia.script_type return_t false + ^ "(__GetScriptVTable()[" ^ interfaceSlot ^ "]);\n"); + output_cpp "\t}\n") + else ( + output_cpp ("\tif (" ^ vtable ^ ") {\n"); + output_cpp "\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n"; + output_cpp "\t\t::hx::AutoStack __as(__ctx);\n"; + output_cpp + ("\t\t__ctx->pushObject(" + ^ (if has_class_flag class_def CInterface then "mDelegate.mPtr" + else "this") + ^ ");\n"); + List.iter + (fun (name, opt, t) -> + output_cpp + ("\t\t__ctx->push" ^ CppCppia.script_type t opt ^ "(" + ^ keyword_remap name ^ ");\n")) + f_args; + output_cpp + ("\t\t" ^ ret ^ "__ctx->run" + ^ CppCppia.script_type return_t false + ^ "(" ^ vtable ^ ");\n"); + output_cpp ("\t} else " ^ ret); + + if has_class_flag class_def CInterface then ( + output_cpp + (" " ^ delegate ^ "__Field(HX_CSTRING(\"" ^ field.cf_name + ^ "\"), ::hx::paccNever)"); + if List.length names <= 5 then + output_cpp ("->__run(" ^ String.concat "," names ^ ");") + else output_cpp ("->__Run(" ^ args_varray ^ ");")) + else + output_cpp + (class_name ^ "::" ^ name ^ "(" ^ String.concat "," names ^ ");"); + if return_type <> "void" then output_cpp "return null();"; + output_cpp "}\n"; + let dynamic_interface_closures = + Gctx.defined baseCtx.ctx_common Define.DynamicInterfaceClosures + in + if has_class_flag class_def CInterface && not dynamic_interface_closures + then + output_cpp + ("\tDynamic " ^ name + ^ "_dyn() { return mDelegate->__Field(HX_CSTRING(\"" ^ field.cf_name + ^ "\"), ::hx::paccNever); }\n\n")) + in + + let new_sctipt_functions = + if newInteface then all_virtual_functions class_def + else List.rev (current_virtual_functions_rev class_def []) + in + let sctipt_name = class_name ^ "__scriptable" in + + if newInteface then ( + output_cpp ("class " ^ sctipt_name ^ " : public ::hx::Object {\n"); + output_cpp "public:\n") + else ( + output_cpp ("class " ^ sctipt_name ^ " : public " ^ class_name ^ " {\n"); + output_cpp (" typedef " ^ sctipt_name ^ " __ME;\n"); + output_cpp (" typedef " ^ class_name ^ " super;\n"); + let field_arg_count field = + match (follow field.cf_type, field.cf_kind) with + | _, Method MethDynamic -> -1 + | TFun (args, return_type), Method _ -> List.length args + | _, _ -> -1 + in + let has_funky_toString = + List.exists + (fun f -> f.cf_name = "toString") + class_def.cl_ordered_statics + || List.exists + (fun f -> f.cf_name = "toString" && field_arg_count f <> 0) + class_def.cl_ordered_fields + in + let super_string = + if has_funky_toString then class_name ^ "::super" else class_name + in + output_cpp (" typedef " ^ super_string ^ " __superString;\n"); + if has_class_flag class_def CInterface then + output_cpp " HX_DEFINE_SCRIPTABLE_INTERFACE\n" + else ( + output_cpp + (" HX_DEFINE_SCRIPTABLE(HX_ARR_LIST" + ^ string_of_int (List.length constructor_var_list) + ^ ")\n"); + output_cpp "\tHX_DEFINE_SCRIPTABLE_DYNAMIC;\n")); + + let list_iteri func in_list = + let idx = ref 0 in + List.iter + (fun elem -> + func !idx elem; + idx := !idx + 1) + in_list + in + + let not_toString (field, args, _) = + field.cf_name <> "toString" || has_class_flag class_def CInterface + in + let functions = + List.filter not_toString (all_virtual_functions class_def) + in + list_iteri dump_script_field functions; + output_cpp "};\n\n"; + + let sigs = Hashtbl.create 0 in + + let static_functions = + List.filter (fun f -> not (is_data_member f)) reflect_static_fields + in + let all_script_functions = + List.map (fun (f, _, _) -> f) new_sctipt_functions @ static_functions + in + + if List.length all_script_functions > 0 then ( + List.iter + (fun (f, _, _) -> + let s = + generate_script_function false f ("__s_" ^ f.cf_name) + (keyword_remap f.cf_name) + in + Hashtbl.add sigs f.cf_name s) + new_sctipt_functions; + + let dump_script_static f = + let s = + generate_script_function true f ("__s_" ^ f.cf_name) + (keyword_remap f.cf_name) + in + Hashtbl.add sigs f.cf_name s + in + List.iter dump_script_static class_def.cl_ordered_statics; + + output_cpp "#ifndef HXCPP_CPPIA_SUPER_ARG\n"; + output_cpp "#define HXCPP_CPPIA_SUPER_ARG(x)\n"; + output_cpp "#endif\n"; + output_cpp + "static ::hx::ScriptNamedFunction __scriptableFunctions[] = {\n"; + let dump_func f isStaticFlag = + let s = try Hashtbl.find sigs f.cf_name with Not_found -> "v" in + output_cpp + (" ::hx::ScriptNamedFunction(\"" ^ f.cf_name ^ "\",__s_" ^ f.cf_name + ^ ",\"" ^ s ^ "\", " ^ isStaticFlag ^ " "); + let superCall = + if isStaticFlag = "true" || has_class_flag class_def CInterface then + "0" + else "__s_" ^ f.cf_name ^ "" + in + output_cpp ("HXCPP_CPPIA_SUPER_ARG(" ^ superCall ^ ")"); + output_cpp " ),\n" + in + List.iter (fun (f, _, _) -> dump_func f "false") new_sctipt_functions; + List.iter (fun f -> dump_func f "true") static_functions; + output_cpp + " ::hx::ScriptNamedFunction(0,0,0 HXCPP_CPPIA_SUPER_ARG(0) ) };\n") + else + output_cpp + "static ::hx::ScriptNamedFunction *__scriptableFunctions = 0;\n"; + + if newInteface then ( + output_cpp ("\n\n" ^ class_name ^ " " ^ class_name ^ "_scriptable = {\n"); + List.iter + (fun (f, args, return_type) -> + let cast = cpp_tfun_signature true args return_type in + output_cpp + ("\t" ^ cast ^ "&" ^ sctipt_name ^ "::" ^ keyword_remap f.cf_name + ^ ",\n")) + new_sctipt_functions; + output_cpp "};\n")); + + let class_name_text = join_class_path class_path "." in + + (* Initialise static in boot function ... *) + if (not (has_class_flag class_def CInterface)) && not nativeGen then ( + (* Remap the specialised "extern" classes back to the generic names *) + output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); + (if scriptable then + match class_def.cl_constructor with + | Some field -> + let signature = + generate_script_function false field "__script_construct_func" + "__construct" + in + output_cpp + ("::hx::ScriptFunction " ^ class_name + ^ "::__script_construct(__script_construct_func,\"" ^ signature + ^ "\");\n") + | _ -> + output_cpp + ("::hx::ScriptFunction " ^ class_name + ^ "::__script_construct(0,0);\n")); + + let reflective_statics = + List.filter (reflective class_def) implemented_fields + in + let sStaticFields = + if List.length reflective_statics > 0 then ( + output_cpp ("static ::String " ^ class_name ^ "_sStaticFields[] = {\n"); + List.iter dump_field_name reflective_statics; + output_cpp "\t::String(null())\n};\n\n"; + class_name ^ "_sStaticFields") + else "0 /* sStaticFields */" + in + + output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); + if not (has_class_flag class_def CAbstract) then ( + output_cpp ("\t" ^ class_name ^ " _hx_dummy;\n"); + output_cpp ("\t" ^ class_name ^ "::_hx_vtable = *(void **)&_hx_dummy;\n")); + output_cpp "\t::hx::Static(__mClass) = new ::hx::Class_obj();\n"; + output_cpp ("\t__mClass->mName = " ^ strq class_name_text ^ ";\n"); + output_cpp "\t__mClass->mSuper = &super::__SGetClass();\n"; + if not (has_class_flag class_def CAbstract) then ( + output_cpp "\t__mClass->mConstructEmpty = &__CreateEmpty;\n"; + output_cpp "\t__mClass->mConstructArgs = &__Create;\n"); + output_cpp + ("\t__mClass->mGetStaticField = &" + ^ + if has_get_static_field class_def then class_name ^ "::__GetStatic;\n" + else "::hx::Class_obj::GetNoStaticField;\n"); + output_cpp + ("\t__mClass->mSetStaticField = &" + ^ + if has_set_static_field class_def then class_name ^ "::__SetStatic;\n" + else "::hx::Class_obj::SetNoStaticField;\n"); + if hasMarkFunc then + output_cpp ("\t__mClass->mMarkFunc = " ^ class_name ^ "_sMarkStatics;\n"); + output_cpp + ("\t__mClass->mStatics = ::hx::Class_obj::dupFunctions(" ^ sStaticFields + ^ ");\n"); + output_cpp + ("\t__mClass->mMembers = ::hx::Class_obj::dupFunctions(" ^ sMemberFields + ^ ");\n"); + output_cpp ("\t__mClass->mCanCast = ::hx::TCanCast< " ^ class_name ^ " >;\n"); + if hasMarkFunc then + output_cpp + ("#ifdef HXCPP_VISIT_ALLOCS\n\t__mClass->mVisitFunc = " ^ class_name + ^ "_sVisitStatics;\n#endif\n"); + output_cpp + ("#ifdef HXCPP_SCRIPTABLE\n\t__mClass->mMemberStorageInfo = " ^ class_name + ^ "_sMemberStorageInfo;\n#endif\n"); + output_cpp + ("#ifdef HXCPP_SCRIPTABLE\n\t__mClass->mStaticStorageInfo = " ^ class_name + ^ "_sStaticStorageInfo;\n#endif\n"); + output_cpp "\t::hx::_hx_RegisterClass(__mClass->mName, __mClass);\n"; + if scriptable then + output_cpp + (" HX_SCRIPTABLE_REGISTER_CLASS(\"" ^ class_name_text ^ "\"," + ^ class_name ^ ");\n"); + Hashtbl.iter + (fun _ intf_def -> + output_cpp + ("\tHX_REGISTER_VTABLE_OFFSET( " ^ class_name ^ "," + ^ join_class_path_remap intf_def.cl_path "::" + ^ ");\n")) + native_implementations; + output_cpp "}\n\n") + else if not nativeGen then ( + output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); + + output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); + + output_cpp "\t::hx::Static(__mClass) = new ::hx::Class_obj();\n"; + output_cpp ("\t__mClass->mName = " ^ strq class_name_text ^ ";\n"); + output_cpp "\t__mClass->mSuper = &super::__SGetClass();\n"; + if hasMarkFunc then + output_cpp ("\t__mClass->mMarkFunc = " ^ class_name ^ "_sMarkStatics;\n"); + output_cpp + ("\t__mClass->mMembers = ::hx::Class_obj::dupFunctions(" ^ sMemberFields + ^ ");\n"); + output_cpp + ("\t__mClass->mCanCast = ::hx::TIsInterface< (int)" + ^ cpp_class_hash class_def ^ " >;\n"); + if hasMarkFunc then + output_cpp + ("#ifdef HXCPP_VISIT_ALLOCS\n\t__mClass->mVisitFunc = " ^ class_name + ^ "_sVisitStatics;\n#endif\n"); + output_cpp "\t::hx::_hx_RegisterClass(__mClass->mName, __mClass);\n"; + if scriptable then + output_cpp + (" HX_SCRIPTABLE_REGISTER_INTERFACE(\"" ^ class_name_text ^ "\"," + ^ class_name ^ ");\n"); + output_cpp "}\n\n"); + + if has_boot_field class_def then ( + output_cpp ("void " ^ class_name ^ "::__boot()\n{\n"); + + List.iter + (gen_field_init ctx class_def) + (List.filter should_implement_field class_def.cl_ordered_statics); + + output_cpp "}\n\n"); + + end_namespace output_cpp class_path; + + if + has_class_flag class_def CInterface + && Meta.has Meta.ObjcProtocol class_def.cl_meta + then ( + let full_class_name = + ("::" ^ join_class_path_remap class_path "::") ^ "_obj" + in + let protocol = + get_meta_string class_def.cl_meta Meta.ObjcProtocol |> Option.default "" + in + generate_protocol_delegate ctx class_def output_cpp; + output_cpp + ("id<" ^ protocol ^ "> " ^ full_class_name + ^ "::_hx_toProtocol(Dynamic inImplementation) {\n"); + output_cpp + ("\treturn [ [_hx_" ^ protocol + ^ "_delegate alloc] initWithImplementation:inImplementation.mPtr];\n"); + output_cpp "}\n\n"); + + cpp_file#close \ No newline at end of file diff --git a/src/generators/cpp/gen/cppGenEnum.ml b/src/generators/cpp/gen/cppGenEnum.ml new file mode 100644 index 00000000000..ae00e32708f --- /dev/null +++ b/src/generators/cpp/gen/cppGenEnum.ml @@ -0,0 +1,211 @@ +open Ast +open Type +open Error +open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext +open CppGen + +let generate baseCtx enum_def = + let common_ctx = baseCtx.ctx_common in + let class_path = enum_def.e_path in + let just_class_name = (snd class_path) in + let class_name = just_class_name ^ "_obj" in + let remap_class_name = ("::" ^ (join_class_path_remap class_path "::") ) in + let cpp_file = new_placed_cpp_file common_ctx class_path in + let output_cpp = (cpp_file#write) in + let debug = if (Meta.has Meta.NoDebug enum_def.e_meta) || ( Gctx.defined common_ctx Define.NoDebug) then 0 else 1 in + + let ctx = file_context baseCtx cpp_file debug false in + let strq = strq ctx.ctx_common in + + let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text enum_def.e_path) with Not_found -> Int32.zero in + let classIdTxt = Printf.sprintf "0x%08lx" classId in + + if (debug>1) then + print_endline ("Found enum definition:" ^ (join_class_path class_path "::" )); + + cpp_file#write_h "#include \n\n"; + + let super_deps = create_super_dependencies common_ctx in + let referenced,flags = CppReferences.find_referenced_types_flags ctx (TEnumDecl enum_def) "*" super_deps (Hashtbl.create 0) false false false in + List.iter (add_include cpp_file) referenced; + + begin_namespace output_cpp class_path; + output_cpp "\n"; + + PMap.iter (fun _ constructor -> + let name = keyword_remap constructor.ef_name in + match constructor.ef_type with + | TFun (args,_) -> + output_cpp (remap_class_name ^ " " ^ class_name ^ "::" ^ name ^ "(" ^ + (print_tfun_arg_list true args) ^")\n"); + + output_cpp ("{\n\treturn ::hx::CreateEnum< " ^ class_name ^ " >(" ^ (strq name) ^ "," ^ + (string_of_int constructor.ef_index) ^ "," ^ (string_of_int (List.length args)) ^ ")" ); + ExtList.List.iteri (fun i (arg,_,_) -> output_cpp ("->_hx_init(" ^ (string_of_int i) ^ "," ^ (keyword_remap arg) ^ ")")) args; + output_cpp ";\n}\n\n" + | _ -> + output_cpp ( remap_class_name ^ " " ^ class_name ^ "::" ^ name ^ ";\n\n" ) + ) enum_def.e_constrs; + + + let constructor_arg_count constructor = + (match constructor.ef_type with | TFun(args,_) -> List.length args | _ -> 0 ) + in + + output_cpp ("bool " ^ class_name ^ "::__GetStatic(const ::String &inName, ::Dynamic &outValue, ::hx::PropertyAccess inCallProp)\n{\n"); + PMap.iter (fun _ constructor -> + let name = constructor.ef_name in + let dyn = if constructor_arg_count constructor > 0 then "_dyn()" else "" in + output_cpp ("\tif (inName==" ^ strq name ^ ") { outValue = " ^ class_name ^ "::" ^ keyword_remap name ^ dyn ^ "; return true; }\n" ); + ) enum_def.e_constrs; + output_cpp ("\treturn super::__GetStatic(inName, outValue, inCallProp);\n}\n\n"); + + output_cpp ("HX_DEFINE_CREATE_ENUM(" ^ class_name ^ ")\n\n"); + + output_cpp ("bool " ^ class_name ^ "::_hx_isInstanceOf(int inClassId) {\n"); + output_cpp ("\treturn inClassId == (int)0x00000001 || inClassId == ::hx::EnumBase_obj::_hx_ClassId || inClassId == _hx_ClassId;\n"); + output_cpp ("}\n"); + + output_cpp ("int " ^ class_name ^ "::__FindIndex(::String inName)\n{\n"); + PMap.iter (fun _ constructor -> + let name = constructor.ef_name in + let idx = string_of_int constructor.ef_index in + output_cpp ("\tif (inName==" ^ (strq name) ^ ") return " ^ idx ^ ";\n") ) enum_def.e_constrs; + output_cpp ("\treturn super::__FindIndex(inName);\n"); + output_cpp ("}\n\n"); + + (* Dynamic versions of constructors *) + let dump_dynamic_constructor _ constr = + let count = constructor_arg_count constr in + if (count>0) then begin + let nargs = string_of_int count in + output_cpp ("STATIC_HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," ^ + (keyword_remap constr.ef_name) ^ ",return)\n\n"); + end + in + PMap.iter dump_dynamic_constructor enum_def.e_constrs; + + + output_cpp ("int " ^ class_name ^ "::__FindArgCount(::String inName)\n{\n"); + PMap.iter (fun _ constructor -> + let name = constructor.ef_name in + let count = string_of_int (constructor_arg_count constructor) in + output_cpp ("\tif (inName==" ^ (strq name) ^ ") return " ^ count ^ ";\n") ) enum_def.e_constrs; + output_cpp ("\treturn super::__FindArgCount(inName);\n"); + output_cpp ("}\n\n"); + + (* Dynamic "Get" Field function - string version *) + output_cpp ("::hx::Val " ^ class_name ^ "::__Field(const ::String &inName,::hx::PropertyAccess inCallProp)\n{\n"); + let dump_constructor_test _ constr = + output_cpp ("\tif (inName==" ^ (strq constr.ef_name) ^ ") return " ^ + (keyword_remap constr.ef_name) ); + if ( (constructor_arg_count constr) > 0 ) then output_cpp "_dyn()"; + output_cpp (";\n") + in + PMap.iter dump_constructor_test enum_def.e_constrs; + output_cpp ("\treturn super::__Field(inName,inCallProp);\n}\n\n"); + + output_cpp ("static ::String " ^ class_name ^ "_sStaticFields[] = {\n"); + let sorted = + List.sort (fun f1 f2 -> (PMap.find f1 enum_def.e_constrs ).ef_index - + (PMap.find f2 enum_def.e_constrs ).ef_index ) + (pmap_keys enum_def.e_constrs) in + + List.iter (fun name -> output_cpp ("\t" ^ (strq name) ^ ",\n") ) sorted; + + output_cpp "\t::String(null())\n};\n\n"; + + (* ENUM - Mark static as used by GC - they are const now, so no marking*) + (* ENUM - Visit static as used by GC - none *) + + output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); + + output_cpp ("Dynamic __Create_" ^ class_name ^ "() { return new " ^ class_name ^ "; }\n\n"); + + output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); + let text_name = strq (join_class_path class_path ".") in + output_cpp ("\n::hx::Static(__mClass) = ::hx::_hx_RegisterClass(" ^ text_name ^ + ", ::hx::TCanCast< " ^ class_name ^ " >," ^ class_name ^ "_sStaticFields,0,\n"); + output_cpp ("\t&__Create_" ^ class_name ^ ", &__Create,\n"); + output_cpp ("\t&super::__SGetClass(), &Create" ^ class_name ^ ", 0\n"); + output_cpp("#ifdef HXCPP_VISIT_ALLOCS\n , 0\n#endif\n"); + output_cpp ("#ifdef HXCPP_SCRIPTABLE\n , 0\n#endif\n"); + output_cpp (");\n"); + output_cpp ("\t__mClass->mGetStaticField = &" ^ class_name ^"::__GetStatic;\n"); + output_cpp "}\n\n"; + + output_cpp ("void " ^ class_name ^ "::__boot()\n{\n"); + (match Texpr.build_metadata common_ctx.basic (TEnumDecl enum_def) with + | Some expr -> + let ctx = file_context ctx cpp_file 1 false in + gen_cpp_init ctx class_name "boot" "__mClass->__meta__ = " expr + | _ -> () ); + PMap.iter (fun _ constructor -> + let name = constructor.ef_name in + match constructor.ef_type with + | TFun (_,_) -> () + | _ -> + output_cpp ( (keyword_remap name) ^ " = ::hx::CreateConstEnum< " ^ class_name ^ " >(" ^ (strq name) ^ "," ^ + (string_of_int constructor.ef_index) ^ ");\n" ) + ) enum_def.e_constrs; + output_cpp ("}\n\n"); + + output_cpp "\n"; + end_namespace output_cpp class_path; + cpp_file#close; + + let h_file = new_header_file common_ctx common_ctx.file class_path in + let super = "::hx::EnumBase_obj" in + let output_h = (h_file#write) in + let def_string = join_class_path class_path "_" in + + begin_header_file (h_file#write_h) def_string false; + + List.iter2 (fun r f -> gen_forward_decl h_file r f) referenced flags; + + output_h ( get_code enum_def.e_meta Meta.HeaderCode ); + + begin_namespace output_h class_path; + + output_h "\n\n"; + output_h ("class " ^ class_name ^ " : public " ^ super ^ "\n"); + output_h ("{\n\ttypedef " ^ super ^ " super;\n"); + output_h ("\t\ttypedef " ^ class_name ^ " OBJ_;\n"); + output_h "\n\tpublic:\n"; + output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); + output_h ("\t\t" ^ class_name ^ "() {};\n"); + output_h ("\t\tHX_DO_ENUM_RTTI;\n"); + output_h ("\t\tstatic void __boot();\n"); + output_h ("\t\tstatic void __register();\n"); + output_h ("\t\tstatic bool __GetStatic(const ::String &inName, Dynamic &outValue, ::hx::PropertyAccess inCallProp);\n"); + output_h ("\t\t::String GetEnumName( ) const { return " ^ (strq (join_class_path class_path ".")) ^ "; }\n" ); + output_h ("\t\t::String __ToString() const { return " ^ (strq (just_class_name ^ ".") )^ " + _hx_tag; }\n"); + output_h ("\t\tbool _hx_isInstanceOf(int inClassId);\n\n"); + + + PMap.iter (fun _ constructor -> + let name = keyword_remap constructor.ef_name in + output_h ( "\t\tstatic " ^ remap_class_name ^ " " ^ name ); + match constructor.ef_type with + | TFun (args,_) -> + output_h ( "(" ^ (print_tfun_arg_list true args) ^");\n"); + output_h ( "\t\tstatic ::Dynamic " ^ name ^ "_dyn();\n"); + | _ -> + output_h ";\n"; + output_h ( "\t\tstatic inline " ^ remap_class_name ^ " " ^ name ^ + "_dyn() { return " ^name ^ "; }\n" ); + ) enum_def.e_constrs; + + output_h "};\n\n"; + + end_namespace output_h class_path; + + end_header_file output_h def_string; + h_file#close diff --git a/src/generators/cpp/gen/cppReferences.ml b/src/generators/cpp/gen/cppReferences.ml new file mode 100644 index 00000000000..15e39fe5989 --- /dev/null +++ b/src/generators/cpp/gen/cppReferences.ml @@ -0,0 +1,235 @@ +open Ast +open Type +open Error +open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext + +(* + Get a list of all classes referred to by the class/enum definition + These are used for "#include"ing the appropriate header files, + or for building the dependencies in the Build.xml file +*) +let find_referenced_types_flags ctx obj field_name super_deps constructor_deps header_only for_depends include_super_args = + let types = ref PMap.empty in + (if for_depends then + let include_files = + get_all_meta_string_path (t_infos obj).mt_meta Meta.Depend + in + let include_adder inc = + types := PMap.add (path_of_string inc) true !types + in + List.iter include_adder include_files); + let rec add_type_flag isNative in_path = + if not (PMap.mem in_path !types) then ( + types := PMap.add in_path isNative !types; + try List.iter (add_type_flag isNative) (Hashtbl.find super_deps in_path) + with Not_found -> ()) + and add_type in_path = add_type_flag false in_path in + let add_extern_type decl = + let tinfo = t_infos decl in + let include_files = + get_all_meta_string_path tinfo.mt_meta + (if for_depends then Meta.Depend else Meta.Include) + in + if List.length include_files > 0 then + List.iter (fun inc -> add_type (path_of_string inc)) include_files + else if (not for_depends) && Meta.has Meta.Include tinfo.mt_meta then + add_type tinfo.mt_path + in + + let add_extern_class klass = add_extern_type (TClassDecl klass) in + let add_extern_enum enum = add_extern_type (TEnumDecl enum) in + let add_native_gen_class klass = + let include_files = + get_all_meta_string_path klass.cl_meta + (if for_depends then Meta.Depend else Meta.Include) + in + if List.length include_files > 0 then + List.iter (fun inc -> add_type (path_of_string inc)) include_files + else if for_depends then add_type klass.cl_path + else + let path = klass.cl_path in + if not (has_class_flag klass CInterface) then + (* Always include native struct headers directly ... *) + add_type (path_of_string (join_class_path path "/" ^ ".h")) + else add_type_flag true klass.cl_path + in + let visited = ref [] in + let rec visit_type in_type = + if not (List.exists (fun t2 -> Type.fast_eq in_type t2) !visited) then ( + visited := in_type :: !visited; + (match follow in_type with + | TMono r -> ( match r.tm_type with None -> () | Some t -> visit_type t) + | TEnum (enum, _) -> ( + match is_extern_enum enum with + | true -> add_extern_enum enum + | false -> add_type enum.e_path) + (* If a class has a template parameter, then we treat it as dynamic - except + for the Array, Class, FastIterator or Pointer classes, for which we do a fully typed object *) + | TInst (klass, params) -> ( + match klass.cl_path with + | [], "Array" + | [], "Class" + | [ "cpp" ], "FastIterator" + | [ "cpp" ], "Pointer" + | [ "cpp" ], "ConstPointer" + | [ "cpp" ], "Function" + | [ "cpp" ], "RawPointer" + | [ "cpp" ], "RawConstPointer" -> + List.iter visit_type params + | _ when is_native_gen_class klass -> add_native_gen_class klass + | _ when is_extern_class klass -> + add_extern_class klass; + List.iter visit_type params + | _ -> ( + match klass.cl_kind with + | KTypeParameter _ -> () + | _ -> add_type klass.cl_path)) + | TAbstract (a, params) when is_scalar_abstract a -> + add_extern_type (TAbstractDecl a) + | TFun (args, haxe_type) -> + visit_type haxe_type; + List.iter (fun (_, _, t) -> visit_type t) args + | _ -> ()); + visited := List.tl !visited) + in + let visit_params expression = + let rec visit_expression expression = + (* Expand out TTypeExpr (ie, the name of a class, as used for static access etc ... *) + (match expression.eexpr with + | TTypeExpr type_def -> ( + match type_def with + | TClassDecl class_def when is_native_gen_class class_def -> + add_native_gen_class class_def + | TClassDecl class_def when is_extern_class class_def -> + add_extern_class class_def + | TEnumDecl enum_def when is_extern_enum enum_def -> + add_extern_enum enum_def + | _ -> add_type (t_path type_def)) + (* Must visit the types, Type.iter will visit the expressions ... *) + | TTry (e, catches) -> + List.iter (fun (v, _) -> visit_type v.v_type) catches + (* Must visit type too, Type.iter will visit the expressions ... *) + | TNew (klass, params, _) -> ( + visit_type (TInst (klass, params)); + try + let construct_type = Hashtbl.find constructor_deps klass.cl_path in + visit_type construct_type.cf_type + with Not_found -> ()) + (* Must visit type too, Type.iter will visit the expressions ... *) + | TVar (v, _) -> visit_type v.v_type + (* Must visit enum type too, Type.iter will visit the expressions ... *) + | TEnumParameter (_, ef, _) -> visit_type (follow ef.ef_type) + (* Must visit args too, Type.iter will visit the expressions ... *) + | TFunction func_def -> + List.iter (fun (v, _) -> visit_type v.v_type) func_def.tf_args + | TField (obj, field) -> ( + match field with + | FInstance (clazz, params, _) | FClosure (Some (clazz, params), _) -> + visit_type (TInst (clazz, params)) + | _ -> ()) + | TConst TSuper -> ( + match follow expression.etype with + | TInst (klass, params) -> ( + try + let construct_type = + Hashtbl.find constructor_deps klass.cl_path + in + visit_type construct_type.cf_type + with Not_found -> ()) + | _ -> + print_endline + ("TSuper : Odd etype ?" + ^ (CppRetyper.cpp_type_of expression.etype |> tcpp_to_string))) + | _ -> ()); + Type.iter visit_expression expression; + visit_type (follow expression.etype) + in + visit_expression expression + in + let visit_field field = + (* Add the type of the expression ... *) + visit_type field.cf_type; + if not header_only then + match field.cf_expr with + | Some expression -> visit_params expression + | _ -> () + in + let visit_class class_def = + let fields = + List.append class_def.cl_ordered_fields class_def.cl_ordered_statics + in + let fields_and_constructor = + List.append fields + (match class_def.cl_constructor with Some expr -> [ expr ] | _ -> []) + in + let fields_and_constructor = + if field_name = "*" then fields_and_constructor + else List.filter (fun f -> f.cf_name = field_name) fields_and_constructor + in + List.iter visit_field fields_and_constructor; + if include_super_args then + List.iter visit_field + (List.map (fun (a, _, _) -> a) (all_virtual_functions class_def)); + + (* Add super & interfaces *) + if is_native_gen_class class_def then add_native_gen_class class_def + else add_type class_def.cl_path + in + let visit_enum enum_def = + add_type enum_def.e_path; + PMap.iter + (fun _ constructor -> + match constructor.ef_type with + | TFun (args, _) -> List.iter (fun (_, _, t) -> visit_type t) args + | _ -> ()) + enum_def.e_constrs; + if not header_only then + let meta = + Texpr.build_metadata ctx.ctx_common.basic (TEnumDecl enum_def) + in + match meta with Some expr -> visit_params expr | _ -> () + in + let inc_cmp i1 i2 = + String.compare (join_class_path i1 ".") (join_class_path i2 ".") + in + + (* Body of main function *) + (match obj with + | TClassDecl class_def -> ( + visit_class class_def; + match TClass.get_cl_init class_def with + | Some expression -> visit_params expression + | _ -> ()) + | TEnumDecl enum_def -> visit_enum enum_def + | TTypeDecl _ | TAbstractDecl _ -> (* These are expanded *) ()); + + (* + The internal header files are also defined in the hx/Object.h file, so you do + #include them separately. However, Math classes has its + own header file (under the hxcpp tree) so these should be included + *) + let include_class_header = function + | [], "@Main" -> false + | [], "Math" -> true + | path -> not (is_internal_class path) + in + let deps = + List.sort inc_cmp + (List.filter (fun path -> include_class_header path) (pmap_keys !types)) + in + let flags = List.map (fun dep -> PMap.find dep !types) deps in + (deps, flags) + +let find_referenced_types ctx obj super_deps constructor_deps header_only for_depends include_super_args = + let deps, _ = + find_referenced_types_flags ctx obj "*" super_deps constructor_deps + header_only for_depends include_super_args + in + deps diff --git a/src/generators/gctx.ml b/src/generators/gctx.ml new file mode 100644 index 00000000000..2785bcf1cef --- /dev/null +++ b/src/generators/gctx.ml @@ -0,0 +1,119 @@ +open Globals +open Type +open Warning + +type context_main = { + mutable main_class : path option; + mutable main_expr : texpr option; +} + +type warning_function = ?depth:int -> ?from_macro:bool -> warning -> Warning.warning_option list list -> string -> pos -> unit +type error_function = ?depth:int -> string -> pos -> unit + +type t = { + platform : platform; + defines : Define.define; + class_paths : ClassPaths.class_paths; + run_command : string -> int; + run_command_args : string -> string list -> int; + warning : warning_function; + error : error_function; + print : string -> unit; + basic : basic_types; + debug : bool; + file : string; + version : int; + features : (string,bool) Hashtbl.t; + modules : Type.module_def list; + main : context_main; + types : Type.module_type list; + resources : (string,string) Hashtbl.t; + native_libs : NativeLibraries.native_library_base list; + include_files : (string * string) list; + std : tclass; (* TODO: I would prefer to not have this here, have to check default_cast *) +} + +let defined com s = + Define.defined com.defines s + +let defined_value com v = + Define.defined_value com.defines v + +let define_value com k v = + Define.define_value com.defines k v + +let defined_value_safe ?default com v = + match default with + | Some s -> Define.defined_value_safe ~default:s com.defines v + | None -> Define.defined_value_safe com.defines v + +let raw_defined gctx v = + Define.raw_defined gctx.defines v + +let find_file ctx f = + (ctx.class_paths#find_file f).file + +let add_feature gctx f = + Hashtbl.replace gctx.features f true + +let has_dce gctx = + try + Define.defined_value gctx.defines Define.Dce <> "no" +with Not_found -> + false + +let is_directly_used gctx meta = + not (has_dce gctx) || Meta.has Meta.DirectlyUsed meta + +let rec has_feature gctx f = + try + Hashtbl.find gctx.features f + with Not_found -> + if gctx.types = [] then not (has_dce gctx) else + match List.rev (ExtString.String.nsplit f ".") with + | [] -> die "" __LOC__ + | [cl] -> has_feature gctx (cl ^ ".*") + | field :: cl :: pack -> + let r = (try + let path = List.rev pack, cl in + (match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) gctx.types with + | t when field = "*" -> + not (has_dce gctx) || + begin match t with + | TClassDecl c -> + has_class_flag c CUsed; + | TAbstractDecl a -> + Meta.has Meta.ValueUsed a.a_meta + | _ -> Meta.has Meta.Used (t_infos t).mt_meta + end; + | TClassDecl c when (has_class_flag c CExtern) && (gctx.platform <> Js || cl <> "Array" && cl <> "Math") -> + not (has_dce gctx) || has_class_field_flag (try PMap.find field c.cl_statics with Not_found -> PMap.find field c.cl_fields) CfUsed + | TClassDecl c -> + PMap.exists field c.cl_statics || PMap.exists field c.cl_fields + | _ -> + false) + with Not_found -> + false + ) in + Hashtbl.add gctx.features f r; + r + +let get_entry_point gctx = + Option.map (fun path -> + let m = List.find (fun m -> m.m_path = path) gctx.modules in + let c = + match m.m_statics with + | Some c when (PMap.mem "main" c.cl_statics) -> c + | _ -> Option.get (ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types) + in + let e = Option.get gctx.main.main_expr in (* must be present at this point *) + (snd path, c, e) + ) gctx.main.main_class + +let get_es_version defines = + try int_of_string (Define.defined_value defines Define.JsEs) with _ -> 0 + +let map_source_header defines f = + match Define.defined_value_safe defines Define.SourceHeader with + | "" -> () + | s -> f s \ No newline at end of file diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index b90e97f427e..6d48400ecc0 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -16,6915 +16,38 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) -open Extlib_leftovers open Ast +open Gctx open Type open Error -open Common open Globals +open CppStrings +open CppExprUtils +open CppTypeUtils +open CppAst +open CppAstTools +open CppSourceWriter +open CppContext -(* - Generators do not care about non-core-type abstracts, so let us follow them - away by default. -*) -let follow = Abstract.follow_with_abstracts - -let replace_float_separators s = Texpr.replace_separators s "" - -(* - Code for generating source files. - It manages creating diretories, indents, blocks and only modifying files - when the content changes. -*) - -(* - A class_path is made from a package (array of strings) and a class name. - Join these together, inclding a separator. eg, "/" for includes : pack1/pack2/Name or "::" - for namespace "pack1::pack2::Name" -*) -let join_class_path path separator = - let result = match fst path, snd path with - | [], s -> s - | el, s -> String.concat separator el ^ separator ^ s in - if (String.contains result '+') then begin - let idx = String.index result '+' in - (String.sub result 0 idx) ^ (String.sub result (idx+1) ((String.length result) - idx -1 ) ) - end else - result;; - -let class_text path = - "::" ^ (join_class_path path "::") -;; - -(* The internal classes are implemented by the core hxcpp system, so the cpp - classes should not be generated *) -let is_internal_class = function - | ([],"Int") | ([],"Void") | ([],"String") | ([], "Null") | ([], "Float") - | ([],"Array") | ([], "Class") | ([], "Enum") | ([], "Bool") - | ([], "Dynamic") | ([], "ArrayAccess") | (["cpp"], "FastIterator") - | (["cpp"],"Pointer") | (["cpp"],"ConstPointer") - | (["cpp"],"RawPointer") | (["cpp"],"RawConstPointer") - | (["cpp"],"Function") -> true - | (["cpp"],"VirtualArray") -> true - | ([],"Math") -> true - | (["cpp"],"Int8") | (["cpp"],"UInt8") | (["cpp"],"Char") - | (["cpp"],"Int16") | (["cpp"],"UInt16") - | (["cpp"],"Int32") | (["cpp"],"UInt32") - | (["cpp"],"Int64") | (["cpp"],"UInt64") - | (["cpp"],"Float32") | (["cpp"],"Float64") | ([],"Single") -> true - | _ -> false;; - -let get_include_prefix common_ctx with_slash = - try - (Common.defined_value common_ctx Define.IncludePrefix) ^ (if with_slash then "/" else "") - with - Not_found -> "" -;; - - -let should_prefix_include = function - | x when is_internal_class x -> false - | ([],"hxMath") -> true - | _ -> false;; - - -let verbatim_include file = - if (String.sub file 0 1)="@" then - ("@import " ^ (String.sub file 1 ((String.length file) - 1 )) ^ ";\n") - else - ("#include \"" ^ file ^ "\"\n") -;; - -let hash64 s = - String.sub (Digest.to_hex (Digest.string s)) 0 16 -;; - - -let guarded_include file = - let guard_name = "INCLUDED_" ^ (hash64 file) in - "#ifndef " ^ guard_name ^ "\n" ^ - "#define " ^ guard_name ^ "\n" ^ - (verbatim_include file) ^ - "#endif\n"; - - - -class source_writer common_ctx write_header_func write_func close_func = - object(this) - val indent_str = "\t" - val mutable indent = "" - val mutable indents = [] - val mutable just_finished_block = false - val mutable headerLines = Hashtbl.create 0 - method close = close_func(); () - method write x = write_func x; just_finished_block <- false - method write_h x = write_header_func x; () - method write_h_unique x = if not (Hashtbl.mem headerLines x) then begin - Hashtbl.add headerLines x (); - this#write_h x; - end - method indent_one = this#write indent_str - - method push_indent = indents <- indent_str::indents; indent <- String.concat "" indents - method pop_indent = match indents with - | h::tail -> indents <- tail; indent <- String.concat "" indents - | [] -> indent <- "/*?*/"; - method write_i x = this#write (indent ^ x) - method get_indent = indent - method begin_block = this#write ("{\n"); this#push_indent - method end_block = this#pop_indent; this#write_i "}\n"; just_finished_block <- true - method end_block_line = this#pop_indent; this#write_i "}"; just_finished_block <- true - method terminate_line = this#write (if just_finished_block then "" else ";\n") - method add_big_closures = this#write_h_unique "#include \n"; - - method add_include class_path = - ( match class_path with - | (["@verbatim"],file) -> this#write_h_unique (guarded_include file) - | _ -> - let prefix = if should_prefix_include class_path then "" else get_include_prefix common_ctx true in - this#write_h ("#ifndef INCLUDED_" ^ (join_class_path class_path "_") ^ "\n"); - this#write_h ("#include <" ^ prefix ^ (join_class_path class_path "/") ^ ".h>\n"); - this#write_h ("#endif\n") - ) -end;; - -let read_whole_file chan = - Std.input_all chan;; - -(* The cached_source_writer will not write to the file if it has not changed, - thus allowing the makefile dependencies to work correctly *) -let cached_source_writer common_ctx filename = - let header = Buffer.create 0 in - let add_header str = Buffer.add_string header str in - let buffer = Buffer.create 0 in - let add_buf str = Buffer.add_string buffer str in - let close = fun() -> - Buffer.add_buffer header buffer; - let contents = Buffer.contents header in - let same = - try - let in_file = open_in filename in - let old_contents = read_whole_file in_file in - close_in in_file; - contents=old_contents - with _ -> - false - in - if not same then begin - let out_file = open_out filename in - output_string out_file contents; - close_out out_file; - end; - in - new source_writer common_ctx (add_header) (add_buf) (close) -;; - -let make_class_directories = Path.mkdir_recursive;; - -let make_base_directory dir = - make_class_directories "" ( ( Str.split_delim (Str.regexp "[\\/]+") dir ) );; - -let new_source_file common_ctx base_dir sub_dir extension class_path = - let include_prefix = get_include_prefix common_ctx true in - let full_dir = - if (sub_dir="include") && (include_prefix<>"") then begin - let dir = match fst class_path with - | [] -> base_dir ^ "/include/" ^ (get_include_prefix common_ctx false) - | path -> base_dir ^ "/include/" ^ include_prefix ^ ( String.concat "/" path ) - in - make_class_directories base_dir (["include";include_prefix]@(fst class_path)); - dir - end else begin - make_class_directories base_dir ( sub_dir :: (fst class_path)); - base_dir ^ "/" ^ sub_dir ^ "/" ^ ( String.concat "/" (fst class_path) ) - end - in - let file = cached_source_writer common_ctx (full_dir ^ "/" ^ ((snd class_path) ^ extension)) in - Codegen.map_source_header common_ctx (fun s -> file#write_h (Printf.sprintf "// %s\n" s)); - file - - - -let source_file_extension common_ctx = - (* no need to -D file_extension if -D objc is defined *) - if Common.defined common_ctx Define.Objc then - ".mm" - else try - "." ^ (Common.defined_value common_ctx Define.FileExtension) - with - Not_found -> ".cpp" -;; - - -let new_cpp_file common_ctx base_dir = new_source_file common_ctx base_dir "src" (source_file_extension common_ctx);; - -let new_header_file common_ctx base_dir = - new_source_file common_ctx base_dir "include" ".h";; - - - -(* CPP code generation context *) -(* - ctx_debug_level - 0 = no debug - 1 = function + line debug via macros, which can be activated at cpp compile-time - 2 = include macros for HXCPP_DEBUGGER - 3 = annotate source with additional info about AST and types - 4 = console output at haxe compile-time - - normal = 1 -*) -type context = -{ - ctx_common : Common.context; - - mutable ctx_debug_level : int; - (* cached as required *) - mutable ctx_file_info : (string,string) PMap.t ref; - - ctx_type_ids : (string,Int32.t) Hashtbl.t; - - (* Per file *) - ctx_output : string -> unit; - ctx_writer : source_writer; - ctx_file_id : int ref; - ctx_is_header : bool; - - ctx_interface_slot : (string,int) Hashtbl.t ref; - ctx_interface_slot_count : int ref; - (* This is for returning from the child nodes of TSwitch && TTry *) - mutable ctx_real_this_ptr : bool; - mutable ctx_class_member_types : (string,string) Hashtbl.t; -} - -let new_context common_ctx debug file_info member_types = -let null_file = new source_writer common_ctx ignore ignore (fun () -> () ) in -let has_def def = Common.defined_value_safe common_ctx def <>"" in -let result = -{ - ctx_common = common_ctx; - ctx_writer = null_file; - ctx_file_id = ref (-1); - ctx_type_ids = Hashtbl.create 0; - ctx_is_header = false; - ctx_output = (null_file#write); - ctx_interface_slot = ref (Hashtbl.create 0); - ctx_interface_slot_count = ref 2; - ctx_debug_level = if has_def Define.AnnotateSource then 3 else - if has_def Define.HxcppDebugger then 2 else - debug; - ctx_real_this_ptr = true; - ctx_class_member_types = member_types; - ctx_file_info = file_info; -} in -result - - -let file_context ctx writer debug header = - { ctx with - ctx_writer = writer; - ctx_output = (writer#write); - ctx_is_header = header; - ctx_file_id = ref (-1); - } -;; - - -(* The internal header files are also defined in the hx/Object.h file, so you do - #include them separately. However, Math classes has its - own header file (under the hxcpp tree) so these should be included *) -let include_class_header = function - | ([],"@Main") -> false - | ([],"Math") -> true - | path -> not ( is_internal_class path ) - - -let is_cpp_class = function - | ("cpp"::_ , _) -> true - | ( [] , "EReg" ) -> true - | ( ["haxe"] , "Log" ) -> true - | _ -> false;; - -let is_block exp = match exp.eexpr with | TBlock _ -> true | _ -> false ;; - -(* todo - is this how it's done? *) -let hash_keys hash = - let key_list = ref [] in - Hashtbl.iter (fun key value -> key_list := key :: !key_list ) hash; - !key_list;; - -let pmap_keys pmap = - let key_list = ref [] in - PMap.iter (fun key _ -> key_list := key :: !key_list ) pmap; - !key_list;; - -let pmap_values pmap = - let value_list = ref [] in - PMap.iter (fun _ value -> value_list := value :: !value_list ) pmap; - !value_list;; - - - -(* The Hashtbl structure seems a little odd - but here is a helper function *) -let hash_iterate hash visitor = - let result = ref [] in - Hashtbl.iter (fun key value -> result := (visitor key value) :: !result ) hash; - !result - - - - - -let is_internal_member member = - member = "toString" || ( - (String.length member > 1) && (String.sub member 0 2 = "__") && - (match member with - | "__ArgCount" | "__ArrayImplRef" | "__CStr" | "__Compare" | "__Create" - | "__CreateEmpty" | "__FieldRef" | "__FindArgCount" - | "__GetFieldMap" | "__GetHandle" | "__GetItem" - | "__GetScriptCallable" | "__GetScriptVTable" - | "__Param" | "__Remove" | "__SGetClass" - | "__Set" | "__SetItem" | "__TArrayImplRef" - | "__ToDouble" | "__ToInt" | "__ToInterface" | "__ToObject" - | "__Visit" | "__WCStr" | "__a" | "__blit" | "__boot" - | "__boot_all" | "__compare" | "__concat" | "__construct" | "__copy" - | "__filter" | "__get_args" | "__hx_dump_stack" | "__hx_field_iter" | "__hxt_gc_new" - | "__indexOf" | "__insert" | "__instanceof" | "__int" | "__iterator" - | "__join" | "__lastIndexOf" | "__loadprim" | "__mClass" | "__mDynamicFields" - | "__map" | "__memcmp" | "__new" | "__pop" | "__prime" - | "__push" | "__qsort" | "__unshift" | "__unsafeStringReference" | "__time_stamp" - | "__superString" | "__splice" | "__shift" | "__slice" | "__sort" - | "__s_id" | "__run" | "__root" | "__register" | "__remove" - | "__removeAt" | "__reverse" | "__zero" - | "__Field" | "__IField" | "__Run" | "__Is" | "__GetClass" | "__GetType" | "__ToString" - | "__s" | "__GetPtr" | "__SetField" | "__length" | "__IsArray" | "__SetThis" | "__Internal" - | "__EnumParams" | "__Index" | "__Tag" | "__GetFields" | "__HasField" - | "__get" | "__set" | "__unsafe_get" | "__unsafe_set" | "__global__" - | "__SetSize" | "__trace" | "__GetRealObject" | "__SetSizeExact" | "__cpp__" - | "__URLEncode" | "__URLDecode" | "__IsEnum" - -> true - | _ -> (String.length member > 4) && (String.sub member 0 4 = "__hx") ) );; - -let is_known_member member = - match member with - | "__meta__" | "__rtti" | "_Compare" - -> true - | _ -> false;; - -(* Convert function names that can't be written in c++ ... *) -let keyword_remap name = - if (is_internal_member name) || (is_known_member name) then - name - else if (String.length name > 1) && (String.sub name 0 2 = "__") then - "_hx_" ^ name - else match name with - | "int" | "Int" | "Bool" | "super" - | "auto" | "char" | "const" | "delete" | "double" | "Float" | "enum" - | "extern" | "float" | "friend" | "goto" | "long" | "operator" | "protected" - | "register" | "short" | "signed" | "sizeof" | "template" | "typedef" - | "union" | "unsigned" | "void" | "volatile" | "or" | "and" | "xor" | "or_eq" | "not" - | "and_eq" | "xor_eq" | "typeof" | "stdin" | "stdout" | "stderr" | "system" - | "BIG_ENDIAN" | "LITTLE_ENDIAN" | "assert" | "NULL" | "wchar_t" | "EOF" - | "bool" | "const_cast" | "dynamic_cast" | "explicit" | "export" | "mutable" | "namespace" - | "reinterpret_cast" | "static_cast" | "typeid" | "typename" | "virtual" - | "_Complex" | "INFINITY" | "NAN" - | "INT_MIN" | "INT_MAX" | "INT8_MIN" | "INT8_MAX" | "UINT8_MAX" | "INT16_MIN" - | "INT16_MAX" | "UINT16_MAX" | "INT32_MIN" | "INT32_MAX" | "UINT32_MAX" - | "asm" | "near" | "far" | "_w64" - | "HX_" | "HXLINE" | "HXDLIN" - | "NO" | "YES" - | "abstract" | "decltype" | "finally" | "nullptr" | "static_assert" - | "struct" | "_Atomic" - | "constexpr" | "consteval" | "constinit" - | "co_await" | "co_return" | "co_yield" - | "alignas" | "alignof" - | "_Alignas" | "_Alignof" - | "requires" -> "_hx_" ^ name - | x -> x -;; - -let remap_class_path class_path = - let path_remap with_keywords name = - let len = String.length name in - if (len > 3) && (String.sub name 0 3 = " ::") then - String.sub name 3 (len-3) - else if (len > 2) && (String.sub name 0 2 = "::") then - String.sub name 2 (len-2) - else if with_keywords then - keyword_remap name - else - name - in - (List.map (path_remap true) (fst class_path)) , path_remap false (snd class_path) -;; - -let join_class_path_remap path separator = - match join_class_path (remap_class_path path) separator with - | "Class" -> "hx::Class" - | x -> x -;; - -let make_path_absolute path pos = - try - if (String.sub path 0 2) = "./" then begin - let base = if (Filename.is_relative pos.pfile) then - Filename.concat (Sys.getcwd()) pos.pfile - else - pos.pfile - in - Path.normalize_path (Filename.concat (Filename.dirname base) (String.sub path 2 ((String.length path) -2))) - end else - path - with Invalid_argument _ -> path -;; - -let get_meta_string meta key = - let rec loop = function - | [] -> "" - | (k,[Ast.EConst (Ast.String(name,_)),_],_) :: _ when k=key-> name - | _ :: l -> loop l - in - loop meta -;; - -let get_meta_string_path meta key = - let rec loop = function - | [] -> "" - | (k,[Ast.EConst (Ast.String(name,_)),_], pos) :: _ when k=key-> - make_path_absolute name pos - | _ :: l -> loop l - in - loop meta -;; - -let get_all_meta_string_path meta_list key = - let extract_path pos expr = - match expr with - | (Ast.EConst (Ast.String(name, _)), _) -> make_path_absolute name pos - | _ -> "" in - let extract_meta meta = - match meta with - | (k, exprs, pos) when k = key -> Some (extract_path pos (List.hd exprs)) - | _ -> None in - ExtList.List.filter_map extract_meta meta_list -;; - -let get_meta_string_full_filename meta key = - let rec loop = function - | [] -> "" - | (k,_, pos) :: _ when k=key-> - if (Filename.is_relative pos.pfile) then - Path.normalize_path (Filename.concat (Sys.getcwd()) pos.pfile) - else - pos.pfile - | _ :: l -> loop l - in - loop meta -;; - -let get_meta_string_full_dirname meta key = - let name = get_meta_string_full_filename meta key in - try - Path.normalize_path (Filename.dirname name) - with Invalid_argument _ -> "" -;; - - -let get_field_access_meta field_access key = -match field_access with - | FInstance(_,_,class_field) - | FStatic(_,class_field) -> get_meta_string class_field.cf_meta key - | _ -> "" -;; - -let format_code code = - String.concat "\n" (ExtString.String.nsplit code "\r\n") - -let get_code meta key = - let code = get_meta_string meta key in - let magic_var = "${GENCPP_SOURCE_DIRECTORY}" in - let code = if ExtString.String.exists code magic_var then begin - let source_directory = get_meta_string_full_dirname meta key in - let _,code = ExtString.String.replace code magic_var source_directory in - code - end else - code - in - if (code<>"") then format_code code ^ "\n" else code -;; - -let has_meta_key meta key = - List.exists (fun m -> match m with | (k,_,_) when k=key-> true | _ -> false ) meta -;; - -let type_has_meta_key haxe_type key = - match follow haxe_type with - | TInst (klass,_) -> has_meta_key klass.cl_meta key - | TType (type_def,_) -> has_meta_key type_def.t_meta key - | TEnum (enum_def,_) -> has_meta_key enum_def.e_meta key - | _ -> false -;; - - -(* -let dump_meta meta = - List.iter (fun m -> match m with | (k,_,_) -> print_endline ((fst (Meta.to_string k)) ^ "=" ^ (get_meta_string meta k) ) | _ -> () ) meta;; -*) - -let get_class_code class_def key = match class_def.cl_kind with - | KAbstractImpl abstract_def -> - let value = (get_code abstract_def.a_meta key) in - value - | _ -> get_code class_def.cl_meta key -;; - - -(* Add include to source code *) -let add_include writer class_path = - writer#add_include class_path;; - -let list_num l = string_of_int (List.length l);; - - -(* This gets the class include order correct. In the header files, we forward declare - the class types so the header file does not have any undefined variables. - In the cpp files, we include all the required header files, providing the actual - types for everything. This way there is no problem with circular class references. -*) -let gen_forward_decl writer class_path isNative = - begin - let output = writer#write in - match class_path with - | (["@verbatim"],file) -> - writer#write (guarded_include file) - | _ -> - let name = fst (remap_class_path class_path) in - output ((if isNative then "HX_DECLARE_NATIVE" else "HX_DECLARE_CLASS") ^ list_num name ^ "("); - List.iter (fun package_part -> output (package_part ^ ",") ) name; - output ( (snd class_path) ^ ")\n") -end;; - -let real_interfaces = -List.filter (function (t,pl) -> - match t, pl with - | { cl_path = ["cpp";"rtti"],_ },[] -> false - | _ -> true -);; - - -let is_var_field field = - match field.cf_kind with - | Var _ -> true - | Method MethDynamic -> true - | _ -> false -;; - -let rec has_rtti_interface c interface = - List.exists (function (t,pl) -> - (snd t.cl_path) = interface && (match fst t.cl_path with | ["cpp";"rtti"] -> true | _ -> false ) - ) c.cl_implements || - (match c.cl_super with None -> false | Some (c,_) -> has_rtti_interface c interface);; - -let has_field_integer_lookup class_def = - has_rtti_interface class_def "FieldIntegerLookup";; - -let has_field_integer_numeric_lookup class_def = - has_rtti_interface class_def "FieldNumericIntegerLookup";; - -(* Output required code to place contents in required namespace *) -let gen_open_namespace output class_path = - List.iter (fun namespace -> output ("namespace " ^ namespace ^ "{\n")) (List.map keyword_remap (fst class_path));; - -let gen_close_namespace output class_path = - List.iter - (fun namespace -> output ( "}" ^ " // end namespace " ^ namespace ^"\n")) - (fst class_path);; - -(* The basic types can have default values and are passesby value *) -let is_numeric = function - | "Int" | "Bool" | "Float" | "unsigned char" -> true - | "::cpp::UInt8" | "::cpp::Int8" | "::cpp::Char" - | "::cpp::UInt16" | "::cpp::Int16" - | "::cpp::UInt32" | "::cpp::Int32" - | "::cpp::UInt64" | "::cpp::Int64" - | "::cpp::Float32" | "::cpp::Float64" - | "int" | "bool" | "double" | "float" | "Single" -> true - | _ -> false - - -let rec remove_parens expression = - match expression.eexpr with - | TParenthesis e -> remove_parens e - | TMeta(_,e) -> remove_parens e - | _ -> expression -;; - - -let rec remove_parens_cast expression = - match expression.eexpr with - | TParenthesis e -> remove_parens_cast e - | TMeta(_,e) -> remove_parens_cast e - | TCast ( e,None) -> remove_parens_cast e - | _ -> expression -;; - -let is_interface_type t = - match follow t with - | TInst (klass,params) -> (has_class_flag klass CInterface) - | _ -> false -;; - - -let is_cpp_function_instance haxe_type = - match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_path with - | ["cpp"] , "Function" -> true - | _ -> false ) - | _ -> false - ;; - - -let is_objc_class klass = - (has_class_flag klass CExtern) && Meta.has Meta.Objc klass.cl_meta -;; - -let rec is_objc_type t = - match t with - | TInst(cl,_) -> (has_class_flag cl CExtern) && Meta.has Meta.Objc cl.cl_meta - | TType(td,_) -> (Meta.has Meta.Objc td.t_meta) - | TAbstract (a,_) -> (Meta.has Meta.Objc a.a_meta) - | TMono r -> (match r.tm_type with | Some t -> is_objc_type t | _ -> false) - | TLazy f -> is_objc_type (lazy_type f) - | _ -> false -;; - - -let is_lvalue var = - match (remove_parens var).eexpr with - | TLocal _ -> true - | TField (_,FStatic(_,field) ) | TField (_,FInstance(_,_,field) ) -> is_var_field field - | _ -> false -;; - - - -let is_pointer haxe_type includeRaw = - match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_path with - | ["cpp"] , "Pointer" - | ["cpp"] , "ConstPointer" - | ["cpp"] , "Function" -> true - | ["cpp"] , "RawPointer" when includeRaw -> true - | ["cpp"] , "RawConstPointer" when includeRaw -> true - | _ -> false ) - | TType (type_def,params) -> - (match type_def.t_path with - | ["cpp"] , "Pointer" - | ["cpp"] , "ConstPointer" - | ["cpp"] , "Function" -> true - | ["cpp"] , "RawPointer" when includeRaw -> true - | ["cpp"] , "RawConstPointer" when includeRaw -> true - | _ -> false ) - | _ -> false - ;; - -let is_dynamic_type_param class_kind = - match class_kind with - | KTypeParameter _ -> true - | _ -> false -;; - - -let is_native_gen_class class_def = - (has_meta_key class_def.cl_meta Meta.NativeGen) || - (match class_def.cl_kind with - | KAbstractImpl abstract_def -> (has_meta_key abstract_def.a_meta Meta.NativeGen) - | _ -> false ); -;; - -let is_native_gen_module = function - | TClassDecl class_def -> is_native_gen_class class_def - | _ -> false -;; - -let is_extern_class class_def = - (has_class_flag class_def CExtern) || (has_meta_key class_def.cl_meta Meta.Extern) || - (match class_def.cl_kind with - | KAbstractImpl abstract_def -> (has_meta_key abstract_def.a_meta Meta.Extern) - | _ -> false ); -;; - -let is_extern_enum enum_def = - (has_enum_flag enum_def EnExtern) || (has_meta_key enum_def.e_meta Meta.Extern) -;; - -let is_native_class class_def = - ((is_extern_class class_def) || (is_native_gen_class class_def)) && (not (is_internal_class class_def.cl_path)) -;; - -let cpp_enum_path_of enum = - (* - let rename = get_meta_string enum.e_meta Meta.Native in - if rename <> "" then - rename - else - *) - let globalNamespace = if (get_meta_string enum.e_meta Meta.Native)<>"" then "" else "::" in - globalNamespace ^ (join_class_path_remap enum.e_path "::") -;; - -(* Get a string to represent a type. - The "suffix" will be nothing or "_obj", depending if we want the name of the - pointer class or the pointee (_obj class *) -let rec class_string klass suffix params remap = - let type_string = type_string_remap remap in - let join_class_path_remap = if remap then join_class_path_remap else join_class_path in - (match klass.cl_path with - (* Array class *) - | ([],"Array") when is_dynamic_array_param (List.hd params) -> - "cpp::ArrayBase" ^ suffix - (*"cpp::VirtualArray" ^ suffix*) - | ([],"Array") -> (snd klass.cl_path) ^ suffix ^ "< " ^ (String.concat "," - (List.map array_element_type params) ) ^ " >" - (* FastIterator class *) - | (["cpp"],"FastIterator") -> "::cpp::FastIterator" ^ suffix ^ "< " ^ (String.concat "," - (List.map type_string params) ) ^ " >" - | (["cpp"],"Pointer") - | (["cpp"],"ConstPointer") -> - "::cpp::Pointer< " ^ (String.concat "," (List.map type_string params) ) ^ " >" - | (["cpp"],"RawPointer") -> - " " ^ (String.concat "," (List.map type_string params) ) ^ " * " - | (["cpp"],"RawConstPointer") -> - " const " ^ (String.concat "," (List.map type_string params) ) ^ " * " - | (["cpp"],"Function") -> - "::cpp::Function< " ^ (cpp_function_signature_params params) ^ " >" - | _ when is_dynamic_type_param klass.cl_kind -> "Dynamic" - | ([],"#Int") -> "/* # */int" - | (["cpp"],"UInt8") -> "unsigned char" - | ([],"Class") -> "::hx::Class" - | ([],"EnumValue") -> "Dynamic" - | ([],"Null") -> (match params with - | [t] -> - (match follow t with - | TAbstract ({ a_path = [],"Int" },_) - | TAbstract ({ a_path = [],"Float" },_) - | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" - | TAbstract ({ a_path = ["cpp"],"UInt8" },_) -> "Dynamic" - | t when type_has_meta_key t Meta.NotNull -> "Dynamic" - | _ -> "/*NULL*/" ^ (type_string t) ) - | _ -> die "" __LOC__); - (* Objective-C class *) - | path when is_objc_type (TInst(klass,[])) -> - let str = join_class_path_remap klass.cl_path "::" in - if suffix = "_obj" then - str - else if (has_class_flag klass CInterface) then - "id < " ^ str ^ ">" - else - str ^ " *" - (* Native interface - use pointer *) - | _ when (has_class_flag klass CInterface) && is_native_gen_class klass -> - (join_class_path_remap klass.cl_path "::") ^ " *" - (* Normal class *) - | _ when is_native_class klass -> - let class_params = match params with - | [] -> "" - | _ -> "< " ^ (String.concat "," (List.map type_string params)) ^ " >" in - (join_class_path_remap klass.cl_path "::") ^ class_params - | _ -> - let globalNamespace = if (get_meta_string klass.cl_meta Meta.Native)<>"" then "" else "::" in - globalNamespace ^ (join_class_path_remap klass.cl_path "::") ^ suffix - ) -and type_string_suff suffix haxe_type remap = - let type_string = type_string_remap remap in - let join_class_path_remap = if remap then join_class_path_remap else join_class_path in - (match haxe_type with - | TMono r -> (match r.tm_type with None -> "Dynamic" ^ suffix | Some t -> type_string_suff suffix t remap) - | TAbstract ({ a_path = ([],"Void") },[]) -> "Void" - | TAbstract ({ a_path = ([],"Bool") },[]) -> "bool" - | TAbstract ({ a_path = ([],"Float") },[]) -> "Float" - | TAbstract ({ a_path = ([],"Int") },[]) -> "int" - | TAbstract ({ a_path = (["cpp"],"UInt8") },[]) -> "unsigned char" - | TAbstract( { a_path = ([], "EnumValue") }, _ ) -> "Dynamic" - | TAbstract ({ a_path = ([],"Null") }, [t]) -> - (match follow t with - | TAbstract ({ a_path = [],"Int" },_) - | TAbstract ({ a_path = [],"Float" },_) - | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" ^ suffix - | t when type_has_meta_key t Meta.NotNull -> "Dynamic" ^ suffix - | _ -> type_string_suff suffix t remap) - | TEnum (enum,_) -> (cpp_enum_path_of enum) ^ suffix - | TInst (klass,params) -> (class_string klass suffix params remap) - | TType (type_def,params) -> - (match type_def.t_path with - | [] , "Array" -> - (match params with - | [t] when (type_string (follow t) ) = "Dynamic" -> "Dynamic" - | [t] -> "Array< " ^ (type_string (follow t) ) ^ " >" - | _ -> die "" __LOC__) - | ["cpp"] , "FastIterator" -> - (match params with - | [t] -> "::cpp::FastIterator< " ^ (type_string (follow t) ) ^ " >" - | _ -> die "" __LOC__) - | ["cpp"] , "Pointer" - | ["cpp"] , "ConstPointer" -> - (match params with - | [t] -> "::cpp::Pointer< " ^ (type_string (follow t) ) ^ " >" - | _ -> die "" __LOC__) - | ["cpp"] , "RawPointer" -> - (match params with - | [t] -> " " ^ (type_string (follow t) ) ^ " *" - | _ -> die "" __LOC__) - | ["cpp"] , "RawConstPointer" -> - (match params with - | [t] -> "const " ^ (type_string (follow t) ) ^ " *" - | _ -> die "" __LOC__) - | ["cpp"] , "Function" -> - "::cpp::Function< " ^ (cpp_function_signature_params params ) ^ " >" - | _ -> type_string_suff suffix (apply_typedef type_def params) remap - ) - | TFun (args,haxe_type) -> "Dynamic" ^ suffix - | TAnon a -> "Dynamic" - (* - (match !(a.a_status) with - | ClassStatics c -> type_string_suff suffix (TInst (c,List.map snd c.cl_params)) - | EnumStatics e -> type_string_suff suffix (TEnum (e,List.map snd e.e_params)) - | _ -> "Dynamic" ^ suffix ) - *) - | TDynamic haxe_type -> "Dynamic" ^ suffix - | TLazy func -> type_string_suff suffix (lazy_type func) remap - | TAbstract (abs,pl) when abs.a_impl <> None -> - type_string_suff suffix (Abstract.get_underlying_type abs pl) remap - | TAbstract (abs,pl) -> - "::" ^ (join_class_path_remap abs.a_path "::") ^ suffix - ) - -and type_string_remap remap haxe_type = - type_string_suff "" haxe_type remap - -and type_string haxe_type = - type_string_suff "" haxe_type true - -and array_element_type haxe_type = - match type_string haxe_type with - | x when cant_be_null haxe_type -> x - | x when is_interface_type (follow haxe_type) -> x - | "::String" -> "::String" - | _ -> "::Dynamic" - -and is_dynamic_array_param haxe_type = - if (type_string (follow haxe_type)) = "Dynamic" then true - else (match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_path with - | ([],"Array") | ([],"Class") | (["cpp"],"FastIterator") - | (["cpp"],"RawPointer") |(["cpp"],"ConstRawPointer") - | (["cpp"],"Pointer") |(["cpp"],"ConstPointer")|(["cpp"],"Function") -> false - | _ -> (match klass.cl_kind with KTypeParameter _ -> true | _ -> false) - ) - | _ -> false - ) -and cpp_function_signature tfun abi = - match follow tfun with - | TFun(args,ret) -> (type_string ret) ^ " " ^ abi ^ "(" ^ (gen_tfun_interface_arg_list args) ^ ")" - | _ -> "void *" - -and cpp_function_signature_params params = match params with - | [t; abi] -> (match follow abi with - | TInst (klass,_) -> cpp_function_signature t (get_meta_string klass.cl_meta Meta.Abi) - | _ -> print_endline (type_string abi); - die "" __LOC__ ) - | _ -> - print_endline ("Params:" ^ (String.concat "," (List.map type_string params) )); - die "" __LOC__; - -and gen_interface_arg_type_name name opt typ = - let type_str = (type_string typ) in - (* type_str may have already converted Null to Dynamic because of NotNull tag ... *) - (if (opt && (cant_be_null typ) && type_str<>"Dynamic" ) then - "::hx::Null< " ^ type_str ^ " > " - else - type_str ) ^ " " ^ (keyword_remap name) - -and gen_tfun_interface_arg_list args = - String.concat "," (List.map (fun (name,opt,typ) -> gen_interface_arg_type_name name opt typ) args) -and cant_be_null haxe_type = - is_numeric (type_string haxe_type) || (type_has_meta_key haxe_type Meta.NotNull ) -;; - - - -let is_array haxe_type = - match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_path with - | [] , "Array" -> not (is_dynamic_array_param (List.hd params)) - | _ -> false ) - | TType (type_def,params) -> - (match type_def.t_path with - | [] , "Array" -> not (is_dynamic_array_param (List.hd params)) - | _ -> false ) - | _ -> false - ;; - -let is_array_or_dyn_array haxe_type = - match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_path with | [] , "Array" -> true | _ -> false ) - | TType (type_def,params) -> - (match type_def.t_path with | [] , "Array" -> true | _ -> false ) - | _ -> false - ;; - - - -let is_array_implementer haxe_type = - match follow haxe_type with - | TInst (klass,params) -> - (match klass.cl_array_access with - | Some _ -> true - | _ -> false ) - | _ -> false - ;; - - - -let is_static_access obj = - match (remove_parens obj).eexpr with - | TTypeExpr _ -> true - | _ -> false -;; - -let is_native_with_space func = - match (remove_parens func).eexpr with - | TField(obj,field) when is_static_access obj -> - String.contains (get_field_access_meta field Meta.Native) ' ' - | _ -> false -;; - - -let is_native_pointer expr = - let t = type_string expr.etype in - let l = String.length t in - l>1 && (String.sub t (l-1) 1) = "*" -;; - - -let rec is_cpp_function_member func = - match (remove_parens func).eexpr with - | TField(obj,field) when is_cpp_function_instance obj.etype -> true - | TCall(obj,_) -> is_cpp_function_member obj - | _ -> false -;; - - - - -(* Get the type and output it to the stream *) -(* -let gen_type ctx haxe_type = - ctx.ctx_output (type_string haxe_type) -;; - -let member_type ctx field_object member = - let name = (if (is_array field_object.etype) then "::Array" - else (type_string field_object.etype)) ^ "." ^ member in - try ( Hashtbl.find ctx.ctx_class_member_types name ) - with Not_found -> "?";; - -*) -let is_interface obj = is_interface_type obj.etype;; - -let should_implement_field x = is_physical_field x;; - -let is_scalar_abstract abstract_def = - Meta.has Meta.Scalar abstract_def.a_meta && Meta.has Meta.CoreType abstract_def.a_meta -;; - - -let real_non_native_interfaces = -List.filter (function (t,pl) -> - match t, pl with - | { cl_path = ["cpp";"rtti"],_ },[] -> false - | _ -> not (is_native_gen_class t) -);; - - - -let is_extern_class_instance obj = - match follow obj.etype with - | TInst (klass,params) -> (has_class_flag klass CExtern) - | _ -> false -;; - - -let rec is_dynamic_accessor name acc field class_def = - ( ( acc ^ "_" ^ field.cf_name) = name ) && - ( not (List.exists (fun f -> f.cf_name=name) class_def.cl_ordered_fields) ) - && (match class_def.cl_super with None -> true | Some (parent,_) -> is_dynamic_accessor name acc field parent ) -;; - -let gen_hash32 seed str = - let h = ref (Int32.of_int seed) in - let cycle = Int32.of_int 223 in - for i = 0 to String.length str - 1 do - h := Int32.add (Int32.mul !h cycle) (Int32.of_int (int_of_char (String.unsafe_get str i))); - done; - !h -;; - -let gen_hash seed str = - Printf.sprintf "0x%08lx" (gen_hash32 seed str) -;; - -let gen_hash_small seed str = - Printf.sprintf "%08lx" (gen_hash32 seed str) -;; - -let gen_qstring_hash str = - let h = gen_hash32 0 str in - Printf.sprintf "%02lx,%02lx,%02lx,%02lx" - (Int32.shift_right_logical (Int32.shift_left h 24) 24) - (Int32.shift_right_logical (Int32.shift_left h 16) 24) - (Int32.shift_right_logical (Int32.shift_left h 8) 24) - (Int32.shift_right_logical h 24) -;; - -let gen_wqstring_hash str = - let h = gen_hash32 0 str in - Printf.sprintf "%04lx,%04lx" - (Int32.shift_right_logical (Int32.shift_left h 16) 16) - (Int32.shift_right_logical h 16) -;; - - - - - -let special_to_hex s = - let l = String.length s in - let b = Buffer.create 0 in - for i = 0 to l - 1 do - match Char.code (String.unsafe_get s i) with - | c when (c>127) || (c<32) -> - Buffer.add_string b (Printf.sprintf "\\x%02x\"\"" c) - | c -> Buffer.add_char b (Char.chr c) - done; - Buffer.contents b;; - -let escape_extern s = - let l = String.length s in - let b = Buffer.create 0 in - for i = 0 to l - 1 do - match Char.code (String.unsafe_get s i) with - | c when (c>127) || (c<32) || (c=34) || (c=92) -> - Buffer.add_string b (Printf.sprintf "\\x%02x" c) - | c -> Buffer.add_char b (Char.chr c) - done; - Buffer.contents b;; - - - -let has_utf8_chars s = - let result = ref false in - for i = 0 to String.length s - 1 do - result := !result || ( Char.code (String.unsafe_get s i) > 127 ) - done; - !result;; - -let escape_command s = - let b = Buffer.create 0 in - String.iter (fun ch -> if (ch=='"' || ch=='\\' ) then Buffer.add_string b "\\"; Buffer.add_char b ch ) s; - Buffer.contents b;; - -let gen_str macro gen s = - let rec split s plus = - let escaped = StringHelper.s_escape ~hex:false s in - let hexed = (special_to_hex escaped) in - if (String.length hexed <= 16000 ) then - plus ^ " HX_CSTRING(\"" ^ hexed ^ "\")" - else begin - let len = String.length s in - let half = len lsr 1 in - (split (String.sub s 0 half) plus ) ^ (split (String.sub s half (len-half)) "+" ) - end - in - let escaped = StringHelper.s_escape ~hex:false s in - let hexed = (special_to_hex escaped) in - if (String.length hexed <= 16000 ) then - macro ^ "(\"" ^ hexed ^ "\"," ^ (gen s) ^ ")" - else - "(" ^ (split s "" ) ^ ")" -;; - - -let strq ctx s = - if (Common.defined ctx Define.HxcppSmartStings) && (has_utf8_chars s) then - let b = Buffer.create 0 in - - let add ichar = - match ichar with - | 92 (* \ *) -> Buffer.add_string b "\\\\" - | 39 (* ' *) -> Buffer.add_string b "\\\'" - | 34 -> Buffer.add_string b "\\\"" - | 13 (* \r *) -> Buffer.add_string b "\\r" - | 10 (* \n *) -> Buffer.add_string b "\\n" - | 9 (* \t *) -> Buffer.add_string b "\\t" - | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%04x" c) - | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\U%08x" c) - | c -> Buffer.add_char b (Char.chr c) - in - UTF8.iter (fun c -> add (UCharExt.code c) ) s; - "HX_W(u\"" ^ (Buffer.contents b) ^ "\"," ^ (gen_wqstring_hash s) ^ ")" - else - gen_str "HX_" gen_qstring_hash s -;; - - -let const_char_star s = - let escaped = StringHelper.s_escape ~hex:false s in - "\"" ^ special_to_hex escaped ^ "\""; -;; - - - - -(* Convert an array to a comma separated list of values *) -let array_arg_list inList = - let i = ref (0-1) in - String.concat "," (List.map (fun _ -> incr i; "inArgs[" ^ (string_of_int !i) ^ "]" ) inList) - - -(* See if there is a haxe break statement that will be swollowed by c++ break *) -exception BreakFound;; - -(* Decide is we should look the field up by name *) -let dynamic_internal = function | "__Is" -> true | _ -> false - - -let rec is_null expr = - match expr.eexpr with - | TConst TNull -> true - | TParenthesis expr | TMeta (_,expr) -> is_null expr - | TCast (e,None) -> is_null e - | _ -> false -;; - - -let is_virtual_array expr = (type_string expr.etype="cpp::VirtualArray") ;; - -let is_real_function field = - match field.cf_kind with - | Method MethNormal | Method MethInline-> true - | _ -> false -;; - - -let is_this expression = - match (remove_parens expression).eexpr with - | TConst TThis -> true - | _ -> false -;; - -let is_super expression = - match (remove_parens expression).eexpr with - | TConst TSuper -> true - | _ -> false -;; - - -let rec is_dynamic_in_cpp ctx expr = - let expr_type = type_string ( match follow expr.etype with TFun (args,ret) -> ret | _ -> expr.etype) in - if ( expr_type="Dynamic" || expr_type="cpp::ArrayBase") then - true - else begin - let result = ( - match expr.eexpr with - | TEnumParameter( obj, _, index ) -> true (* TODO? *) - | TField( obj, field ) -> - (is_dynamic_member_lookup_in_cpp ctx obj field) || - (is_dynamic_member_return_in_cpp ctx obj field) - | TArray (obj,index) -> (is_dynamic_in_cpp ctx obj || is_virtual_array obj) - | TTypeExpr _ -> false - | TCall(func,args) -> - let is_IaCall = - (match (remove_parens_cast func).eexpr with - | TField ( { eexpr = TIdent "__global__" }, field ) -> false - | TField (obj,FStatic (class_def,field) ) when is_real_function field -> false - | TField (obj,FInstance (_,_,field) ) when (is_this obj) && (is_real_function field) -> false - | TField (obj,FInstance (_,_,field) ) when is_super obj -> false - | TField (obj,FInstance (_,_,field) ) when field.cf_name = "_hx_getIndex" -> false - | TField (obj,FInstance (_,_,field) ) when field.cf_name = "__Index" || (not (is_dynamic_in_cppia ctx obj) && is_real_function field) -> false - | TField (obj,FDynamic (name) ) when (is_internal_member name || (type_string obj.etype = "::String" && name="cca") ) -> false - | TConst TSuper -> false - | TField (_,FEnum (enum,field)) -> false - | _ -> true - ) in - if is_IaCall then - true - else - (match follow func.etype with - | TFun (args,ret) -> is_dynamic_in_cpp ctx func - | _ -> true - ); - | TParenthesis(expr) | TMeta(_,expr) -> is_dynamic_in_cpp ctx expr - | TCast (e,None) -> (type_string expr.etype) = "Dynamic" - | TIdent "__global__" -> false - | TConst TNull -> true - | _ -> false (* others ? *) ) - in - result - end - -and is_dynamic_member_lookup_in_cpp ctx field_object field = - let member = field_name field in - if (is_internal_member member) then false else - if (is_native_pointer field_object) then false else - if (is_pointer field_object.etype true) then false else - if (match field_object.eexpr with | TTypeExpr _ -> true | _ -> false) then false else - if (is_dynamic_in_cpp ctx field_object) then true else - if (is_array field_object.etype) then false else ( - let tstr = type_string field_object.etype in - match tstr with - (* Internal classes have no dynamic members *) - | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math" | "::ArrayAccess" -> false - | "Dynamic" -> true - | name -> - let full_name = name ^ "." ^ member in - if Hashtbl.mem ctx.ctx_class_member_types full_name then - false - else - not (is_extern_class_instance field_object) - ) -and is_dynamic_member_return_in_cpp ctx field_object field = - let member = field_name field in - if (is_array field_object.etype) then false else - if (is_pointer field_object.etype true) then false else - if (is_internal_member member) then false else - match field_object.eexpr with - | TTypeExpr t -> - let full_name = "::" ^ (join_class_path_remap (t_path t) "::" ) ^ "." ^ member in - ( try ( let mem_type = (Hashtbl.find ctx.ctx_class_member_types full_name) in - mem_type="Dynamic" || mem_type="cpp::ArrayBase" || mem_type="cpp::VirtualArray" ) - with Not_found -> true ) - | _ -> - let tstr = type_string field_object.etype in - (match tstr with - (* Internal classes have no dynamic members *) - | "::String" | "Null" | "::hx::Class" | "::Enum" | "::Math" | "::ArrayAccess" -> false - | "Dynamic" | "cpp::ArrayBase" | "cpp::VirtualArray" -> true - | name -> - let full_name = name ^ "." ^ member in - try ( let mem_type = (Hashtbl.find ctx.ctx_class_member_types full_name) in - mem_type="Dynamic" || mem_type="cpp::ArrayBase" || mem_type="cpp::VirtualArray" ) - with Not_found -> true ) -and is_dynamic_in_cppia ctx expr = - match expr.eexpr with - | TCast(_,None) -> true - | _ -> is_dynamic_in_cpp ctx expr -;; - -let cast_if_required ctx expr to_type = - if (is_dynamic_in_cpp ctx expr) then - ctx.ctx_output (".Cast< " ^ to_type ^ " >()" ) -;; - - -let is_matching_interface_type t0 t1 = - (match (follow t0),(follow t1) with - | TInst (k0,_), TInst(k1,_) -> k0==k1 - | _ -> false - ) -;; - - - - -let get_nth_type field index = - match follow field.ef_type with - | TFun (args,_) -> - let rec nth l index = match l with - | [] -> raise Not_found - | (_,_,t)::rest -> - if index = 0 then t - else nth rest (index-1) - in - nth args index - | _ -> raise Not_found -;; - - - -exception PathFound of string;; - - -let strip_file ctx file = (match Common.defined ctx Common.Define.AbsolutePath with - | true -> file - | false -> ctx.class_paths#relative_path file) -;; - -let with_debug ctx metadata run = - let old_debug = ctx.ctx_debug_level in - let no_debug = has_meta_key metadata Meta.NoDebug in - if no_debug then ctx.ctx_debug_level <- 0; - run no_debug; - ctx.ctx_debug_level <- old_debug; -;; - -let hx_stack_push ctx output clazz func_name pos gc_stack = - if ctx.ctx_debug_level > 0 then begin - let stripped_file = strip_file ctx.ctx_common pos.pfile in - let esc_file = (StringHelper.s_escape stripped_file) in - ctx.ctx_file_info := PMap.add stripped_file pos.pfile !(ctx.ctx_file_info); - let full_name = clazz ^ "." ^ func_name ^ ( - if (clazz="*") then - (" (" ^ esc_file ^ ":" ^ (string_of_int (Lexer.get_error_line pos) ) ^ ")") - else "") in - - let hash_class_func = gen_hash 0 (clazz^"."^func_name) in - let hash_file = gen_hash 0 stripped_file in - - let lineName = (string_of_int (Lexer.get_error_line pos) ) in - incr ctx.ctx_file_id; - let classId = hash64 (clazz ^ "." ^ stripped_file) in - let varName = "_hx_pos_" ^ classId ^ "_" ^ lineName ^ "_" ^func_name in - let decl = ( varName ^ ",\"" ^ clazz ^ "\",\"" ^ func_name ^ "\"," ^ hash_class_func ^ ",\"" ^ - full_name ^ "\",\"" ^ esc_file ^ "\"," ^ lineName ^ "," ^ hash_file ) in - if ctx.ctx_is_header then - ctx.ctx_writer#write_h_unique ("HX_DECLARE_STACK_FRAME" ^ "(" ^ varName ^ ")\n") - else - ctx.ctx_writer#write_h_unique ( (if func_name="new" then "HX_DEFINE_STACK_FRAME" else "HX_LOCAL_STACK_FRAME") ^ "(" ^ decl ^ ")\n"); - output ( (if gc_stack then "HX_GC_STACKFRAME" else "HX_STACKFRAME") ^ "(&" ^ varName ^ ")\n"); - end else if gc_stack then - output ("HX_JUST_GC_STACKFRAME\n") -;; - - - -(* { *) - -type tcpp = - | TCppDynamic - | TCppUnchanged - | TCppObject - | TCppObjectPtr - | TCppVoid - | TCppNull - | TCppEnum of tenum - | TCppScalar of string - | TCppString - | TCppFastIterator of tcpp - | TCppPointer of string * tcpp - | TCppRawPointer of string * tcpp - | TCppFunction of tcpp list * tcpp * string - | TCppObjCBlock of tcpp list * tcpp - | TCppRest of tcpp - | TCppReference of tcpp - | TCppStruct of tcpp - | TCppStar of tcpp * bool - | TCppVoidStar - | TCppVarArg - | TCppAutoCast - | TCppDynamicArray - | TCppObjectArray of tcpp - | TCppWrapped of tcpp - | TCppScalarArray of tcpp - | TCppObjC of tclass - | TCppNativePointer of tclass - | TCppVariant - | TCppCode of tcpp - | TCppInst of tclass * tcpp list - | TCppInterface of tclass - | TCppProtocol of tclass - | TCppClass - | TCppGlobal - - -and tcppexpr = { - cppexpr : tcpp_expr_expr; - cpptype : tcpp; - cpppos : pos; -} - - -and tcpp_closure = { - close_type : tcpp; - close_args : (tvar * texpr option) list; - close_expr : tcppexpr; - close_id : int; - close_undeclared : (string,tvar) Hashtbl.t; - close_this : tcppthis option; -} - - -and tcppcrementop = - | CppIncrement - | CppDecrement - -and tcppunop = - | CppNeg - | CppNegBits - | CppNot - -and tcppthis = - | ThisReal - | ThisFake - | ThisDynamic - -and tcppvarloc = - | VarLocal of tvar - | VarClosure of tvar - | VarThis of tclass_field * tcpp - | VarInstance of tcppexpr * tclass_field * string * string - | VarInterface of tcppexpr * tclass_field - | VarStatic of tclass * bool * tclass_field - | VarInternal of tcppexpr * string * string - -and tcppinst = - | InstPtr - | InstObjC - | InstStruct - -and tcppfuncloc = - | FuncThis of tclass_field * tcpp - | FuncInstance of tcppexpr * tcppinst * tclass_field - | FuncStatic of tclass * bool * tclass_field - | FuncTemplate of tclass * tclass_field * path * bool - | FuncInterface of tcppexpr * tclass * tclass_field - | FuncEnumConstruct of tenum * tenum_field - | FuncSuperConstruct of tcpp - | FuncSuper of tcppthis * tcpp * tclass_field - | FuncNew of tcpp - | FuncExpression of tcppexpr - | FuncInternal of tcppexpr * string * string - | FuncExtern of string * bool - | FuncFromStaticFunction - -and tcpparrayloc = - | ArrayTyped of tcppexpr * tcppexpr * tcpp - | ArrayPointer of tcppexpr * tcppexpr - | ArrayRawPointer of tcppexpr * tcppexpr - | ArrayObject of tcppexpr * tcppexpr * tcpp - | ArrayVirtual of tcppexpr * tcppexpr - | ArrayImplements of tclass * tcppexpr * tcppexpr - | ArrayDynamic of tcppexpr * tcppexpr - -and tcpplvalue = - | CppVarRef of tcppvarloc - | CppArrayRef of tcpparrayloc - | CppDynamicRef of tcppexpr * string - | CppExternRef of string * bool - - -and tcpp_expr_expr = - | CppInt of int32 - | CppFloat of string - | CppString of string - | CppBool of bool - | CppNull - | CppNullAccess - | CppNil - | CppThis of tcppthis - | CppSuper of tcppthis - | CppCode of string * tcppexpr list - | CppClosure of tcpp_closure - | CppVar of tcppvarloc - | CppExtern of string * bool - | CppDynamicField of tcppexpr * string - | CppFunction of tcppfuncloc * tcpp - | CppEnumIndex of tcppexpr - | CppEnumField of tenum * tenum_field - | CppCall of tcppfuncloc * tcppexpr list - | CppFunctionAddress of tclass * tclass_field - | CppNewNative of tcppexpr - | CppAddressOf of tcppexpr - | CppDereference of tcppexpr - | CppArray of tcpparrayloc - | CppCrement of tcppcrementop * Ast.unop_flag * tcpplvalue - | CppSet of tcpplvalue * tcppexpr - | CppModify of Ast.binop * tcpplvalue * tcppexpr - | CppBinop of Ast.binop * tcppexpr * tcppexpr - | CppCompare of string * tcppexpr * tcppexpr * Ast.binop - | CppNullCompare of string * tcppexpr - | CppObjectDecl of (string * tcppexpr) list * bool - | CppPosition of string * int32 * string * string - | CppArrayDecl of tcppexpr list - | CppUnop of tcppunop * tcppexpr - | CppVarDecl of tvar * tcppexpr option - | CppBlock of tcppexpr list * tcpp_closure list * bool - | CppFor of tvar * tcppexpr * tcppexpr - | CppIf of tcppexpr * tcppexpr * tcppexpr option - | CppWhile of tcppexpr * tcppexpr * Ast.while_flag * int - | CppIntSwitch of tcppexpr * (Int32.t list * tcppexpr) list * tcppexpr option - | CppSwitch of tcppexpr * tcpp * (tcppexpr list * tcppexpr) list * tcppexpr option * int - | CppTry of tcppexpr * (tvar * tcppexpr) list - | CppBreak - | CppContinue - | CppClassOf of path * bool - | CppGoto of int - | CppReturn of tcppexpr option - | CppThrow of tcppexpr - | CppEnumParameter of tcppexpr * tenum_field * int - | CppTCast of tcppexpr * tcpp - | CppCast of tcppexpr * tcpp - | CppCastStatic of tcppexpr * tcpp - | CppCastScalar of tcppexpr * string - | CppCastVariant of tcppexpr - | CppCastObjC of tcppexpr * tclass - | CppCastObjCBlock of tcppexpr * tcpp list * tcpp - | CppCastProtocol of tcppexpr * tclass - | CppCastNative of tcppexpr - -let rec s_tcpp = function - | CppInt _ -> "CppInt" - | CppFloat _ -> "CppFloat" - | CppString _ -> "CppString" - | CppBool _ -> "CppBool" - | CppNull -> "CppNull" - | CppNil -> "CppNil" - | CppThis _ -> "CppThis" - | CppSuper _ -> "CppSuper" - | CppCode _ -> "CppCode" - | CppClosure _ -> "CppClosure" - | CppVar VarLocal(_) -> "CppVarLocal" - | CppVar VarClosure(_) -> "CppVarClosure" - | CppVar VarThis(_) -> "CppVarThis" - | CppVar VarInstance(expr,field,clazz,op) -> "CppVarInstance(" ^ clazz ^ "::" ^ op ^ field.cf_name ^ ")" - | CppVar VarInterface(_) -> "CppVarInterface" - | CppVar VarStatic(_,true,_) -> "CppObjcVarStatic" - | CppVar VarStatic(_) -> "CppVarStatic" - | CppVar VarInternal(_) -> "CppVarInternal" - | CppDynamicField _ -> "CppDynamicField" - | CppExtern _ -> "CppExtern" - | CppFunction _ -> "CppFunction" - | CppEnumIndex _ -> "CppEnumIndex" - | CppEnumField _ -> "CppEnumField" - | CppNullAccess -> "CppNullAccess" - - | CppCall (FuncThis _,_) -> "CppCallThis" - | CppCall (FuncInstance (obj,inst,field),_) -> - (match inst with InstObjC -> "CppCallObjCInstance(" | InstPtr-> "CppCallInstance(" | _ -> "CppCallStruct(") ^ - tcpp_to_string obj.cpptype ^ "," ^ field.cf_name ^ ")" - | CppCall (FuncInterface _,_) -> "CppCallInterface" - | CppCall (FuncStatic (_,objC,_),_) -> if objC then "CppCallStaticObjC" else "CppCallStatic" - | CppCall (FuncTemplate _,_) -> "CppCallTemplate" - | CppCall (FuncEnumConstruct _,_) -> "CppCallEnumConstruct" - | CppCall (FuncSuperConstruct _,_) -> "CppCallSuperConstruct" - | CppCall (FuncSuper _,_) -> "CppCallSuper" - | CppCall (FuncNew _,_) -> "CppCallNew" - | CppCall (FuncExpression _,_) -> "CppCallExpression" - | CppCall (FuncInternal _,_) -> "CppCallInternal" - | CppCall (FuncExtern _,_) -> "CppCallExtern" - | CppCall (FuncFromStaticFunction,_) -> "CppCallFromStaticFunction" - | CppNewNative _ -> "CppNewNative" - | CppAddressOf _ -> "CppAddressOf" - | CppDereference _ -> "CppDereference" - | CppFunctionAddress _ -> "CppFunctionAddress" - | CppArray _ -> "CppArray" - | CppCrement _ -> "CppCrement" - | CppSet _ -> "CppSet" - | CppModify _ -> "CppModify" - | CppBinop _ -> "CppBinop" - | CppCompare _ -> "CppCompare" - | CppNullCompare _ -> "CppNullCompare" - | CppObjectDecl _ -> "CppObjectDecl" - | CppPosition _ -> "CppPosition" - | CppArrayDecl _ -> "CppArrayDecl" - | CppUnop _ -> "CppUnop" - | CppVarDecl _ -> "CppVarDecl" - | CppBlock _ -> "CppBlock" - | CppFor _ -> "CppFor" - | CppIf _ -> "CppIf" - | CppWhile _ -> "CppWhile" - | CppIntSwitch _ -> "CppIntSwitch" - | CppSwitch _ -> "CppSwitch" - | CppTry _ -> "CppTry" - | CppBreak -> "CppBreak" - | CppContinue -> "CppContinue" - | CppClassOf _ -> "CppClassOf" - | CppGoto _ -> "CppGoto" - | CppReturn _ -> "CppReturn" - | CppThrow _ -> "CppThrow" - | CppEnumParameter _ -> "CppEnumParameter" - | CppTCast _ -> "CppTCast" - | CppCast _ -> "CppCast" - | CppCastStatic _ -> "CppCastStatic" - | CppCastScalar _ -> "CppCastScalar" - | CppCastVariant _ -> "CppCastVariant" - | CppCastObjC _ -> "CppCastObjC" - | CppCastObjCBlock _ -> "CppCastObjCBlock" - | CppCastProtocol _ -> "CppCastProtocol" - | CppCastNative _ -> "CppCastNative" - -and tcpp_to_string_suffix suffix tcpp = match tcpp with - | TCppDynamic -> " ::Dynamic" - | TCppUnchanged -> " ::Dynamic/*Unchanged*/" - | TCppObject -> " ::Dynamic" - | TCppObjectPtr -> " ::hx::Object *" - | TCppReference t -> (tcpp_to_string t) ^" &" - | TCppStruct t -> "cpp::Struct< " ^ (tcpp_to_string t) ^" >" - | TCppStar(t,const) -> (if const then "const " else "" ) ^ (tcpp_to_string t) ^" *" - | TCppVoid -> "void" - | TCppVoidStar -> "void *" - | TCppRest _ -> "vaarg_list" - | TCppVarArg -> "vararg" - | TCppAutoCast -> "::cpp::AutoCast" - | TCppVariant -> "::cpp::Variant" - | TCppEnum(enum) -> " ::" ^ (join_class_path_remap enum.e_path "::") ^ suffix - | TCppScalar(scalar) -> scalar - | TCppString -> "::String" - | TCppFastIterator it -> "::cpp::FastIterator" ^ suffix ^ "< " ^ (tcpp_to_string it) ^ " >"; - | TCppPointer(ptrType,valueType) -> "::cpp::" ^ ptrType ^ "< " ^ (tcpp_to_string valueType) ^ " >" - | TCppRawPointer(constName,valueType) -> constName ^ (tcpp_to_string valueType) ^ "*" - | TCppFunction(argTypes,retType,abi) -> - let args = (String.concat "," (List.map tcpp_to_string argTypes)) in - "::cpp::Function< " ^ (tcpp_to_string retType) ^ " " ^ abi ^ " (" ^ args ^ ") >" - | TCppObjCBlock(argTypes,retType) -> - (tcpp_objc_block_struct argTypes retType) ^ "::t" - | TCppDynamicArray -> "::cpp::VirtualArray" ^ suffix - | TCppObjectArray _ -> "::Array" ^ suffix ^ "< ::Dynamic>" - | TCppWrapped _ -> " ::Dynamic" - | TCppScalarArray(value) -> "::Array" ^ suffix ^ "< " ^ (tcpp_to_string value) ^ " >" - | TCppObjC klass -> - let path = join_class_path_remap klass.cl_path "::" in - if (has_class_flag klass CInterface) then - "id < " ^ path ^ ">" - else - path ^ " *" - | TCppProtocol interface -> - let path = get_meta_string interface.cl_meta Meta.ObjcProtocol in - let path = if path<>"" then path else join_class_path_remap interface.cl_path "::" in - "id < " ^ path ^ ">" - | TCppNativePointer klass -> - let name = (join_class_path_remap klass.cl_path "::") in - if suffix="_obj" then - name - else - "::hx::Native< " ^ name ^ "* >"; - | TCppInst (klass, p) -> - (cpp_class_path_of klass p) ^ (if is_native_class klass then "" else suffix) - | TCppInterface klass when suffix="_obj" -> - (cpp_class_path_of klass []) ^ suffix - | TCppInterface _ -> "::Dynamic" - | TCppClass -> "::hx::Class" ^ suffix; - | TCppGlobal -> "::Dynamic"; - | TCppNull -> " ::Dynamic"; - | TCppCode _ -> "Code" - -and tcpp_objc_block_struct argTypes retType = - let args = (String.concat "," (List.map tcpp_to_string argTypes)) in - let ret = tcpp_to_string retType in - let suffix = (string_of_int (List.length argTypes)) in - if (ret="void") then begin - if (List.length argTypes) = 0 then - "::hx::TObjcBlockVoidVoid" - else - "::hx::TObjcBlockVoidArgs" ^ suffix ^ "< " ^ args ^ " >" - end else begin - if (List.length argTypes) = 0 then - "::hx::TObjcBlockRetVoid< " ^ ret ^ " >" - else - "::hx::TObjcBlockRetArgs" ^ suffix ^ "< " ^ ret ^ "," ^ args ^ " >" - end - -and tcpp_to_string tcpp = - tcpp_to_string_suffix "" tcpp - -and cpp_class_path_of klass params = - match (get_meta_string klass.cl_meta Meta.Native)<>"" with - | true -> - let typeParams = match params with - | [] -> "" - | _ -> "< " ^ String.concat "," (List.map tcpp_to_string params) ^ " >" in - (" " ^ (join_class_path_remap klass.cl_path "::") ^ typeParams) - | false -> " ::" ^ (join_class_path_remap klass.cl_path "::") -;; - - -let cpp_const_type cval = match cval with - | TInt i -> CppInt(i) , TCppScalar("int") - | TBool b -> CppBool(b) , TCppScalar("bool") - | TFloat f -> CppFloat(replace_float_separators f) , TCppScalar("Float") - | TString s -> CppString(s) , TCppString - | _ -> (* TNull, TThis & TSuper should already be handled *) - CppNull, TCppNull -;; - - -let is_cpp_scalar cpp_type = - match cpp_type with - | TCppScalar(_) -> true - | _ -> false -;; - - -let is_cpp_array_implementer cppType = - match cppType with - | TCppInst (klass, _) - | TCppInterface (klass) -> - (match klass.cl_array_access with - | Some _ -> true - | _ -> false ) - | _ -> false -;; - -let rec const_int_of expr = - match expr.eexpr with - | TConst TInt x -> x - | TConst TBool x -> Int32.of_int (if x then 1 else 0) - | TParenthesis e -> const_int_of e - | _ -> raise Not_found -;; - -let rec const_float_of expr = - match expr.eexpr with - | TConst TInt x -> Printf.sprintf "%ld" x - | TConst TFloat x -> (replace_float_separators x) - | TConst TBool x -> if x then "1" else "0" - | TParenthesis e -> const_float_of e - | _ -> raise Not_found -;; - - -let rec const_string_of expr = - match expr.eexpr with - | TConst TString x -> x - | TParenthesis e -> const_string_of e - | _ -> raise Not_found -;; - - -let rec cpp_is_struct_access t = - match t with - | TCppFunction _ -> true - | TCppStruct _-> false - | TCppInst (class_def, _) -> (has_meta_key class_def.cl_meta Meta.StructAccess) - | TCppReference (r) -> cpp_is_struct_access r - | _ -> false -;; - -let rec cpp_is_native_array_access t = - match t with - | TCppStruct s -> cpp_is_native_array_access s - | TCppReference s -> cpp_is_native_array_access s - | TCppInst ({ cl_array_access = Some _ } as klass, _) when is_extern_class klass && has_meta_key klass.cl_meta Meta.NativeArrayAccess -> true - | _ -> false -;; - -let cpp_is_dynamic_type = function - | TCppDynamic | TCppObject | TCppVariant | TCppWrapped _ | TCppGlobal | TCppNull - | TCppInterface _ - -> true - | _ -> false -;; - - -let rec cpp_type_of stack ctx haxe_type = - if List.exists (fast_eq haxe_type) stack then - TCppDynamic - else begin - let stack = haxe_type :: stack in - (match haxe_type with - | TMono r -> (match r.tm_type with None -> TCppDynamic | Some t -> cpp_type_of stack ctx t) - - | TEnum (enum,params) -> TCppEnum(enum) - - | TInst ({ cl_path=([],"Array"); cl_kind = KTypeParameter _},_) - -> TCppObject - - | TInst ({ cl_kind = KTypeParameter _},_) - -> TCppDynamic - - | TInst (klass,params) -> - cpp_instance_type stack ctx klass params - - | TAbstract (abs,pl) when not (Meta.has Meta.CoreType abs.a_meta) -> - cpp_type_from_path stack ctx abs.a_path pl (fun () -> - cpp_type_of stack ctx (Abstract.get_underlying_type ~return_first:true abs pl) ) - - | TAbstract (a,params) -> - cpp_type_from_path stack ctx a.a_path params (fun () -> - if is_scalar_abstract a then begin - let native = get_meta_string a.a_meta Meta.Native in - TCppScalar(if native="" then join_class_path a.a_path "::" else native) - end else - TCppDynamic) - - | TType (type_def,params) -> - cpp_type_from_path stack ctx type_def.t_path params (fun () -> - cpp_type_of stack ctx (apply_typedef type_def params) ) - - | TFun _ -> TCppObject - | TAnon _ -> TCppObject - | TDynamic _ -> TCppDynamic - | TLazy func -> cpp_type_of stack ctx (lazy_type func) - ) - end - and cpp_type_from_path stack ctx path params default = - match path,params with - | ([],"Void"),_ -> TCppVoid - | ([],"void"),_ -> TCppVoid (* for old code with @:void *) - | ([],"Bool"),_ -> TCppScalar("bool") - | ([],"Float"),_ -> TCppScalar("Float") - | ([],"Int"),_ -> TCppScalar("int") - | ([], "EnumValue"),_ -> TCppObject - | ([], "Class"),_ -> TCppClass - | ([], "Enum"),_ -> TCppClass - | ([], "Single"),_ -> TCppScalar("float") - | (["cpp"], "Char"),_ -> TCppScalar("char") - | (["cpp"], "Object"),_ -> TCppObjectPtr - | (["cpp"], "Float32"),_ -> TCppScalar("float") - | (["cpp"], "Float64"),_ -> TCppScalar("double") - | (["cpp"], "Int8"),_ -> TCppScalar("signed char") - | (["cpp"], "Int16"),_ -> TCppScalar("short") - | (["cpp"], "Int32"),_ -> TCppScalar("int") - | (["cpp"], "Int64"),_ -> TCppScalar("::cpp::Int64") - | (["cpp"], "UInt8"),_ -> TCppScalar("unsigned char") - | (["cpp"], "UInt16"),_ -> TCppScalar("unsigned short") - | (["cpp"], "UInt32"),_ -> TCppScalar("unsigned int") - | (["cpp"], "UInt64"),_ -> TCppScalar("::cpp::UInt64") - | (["cpp"], "VarArg"),_ -> TCppVarArg - | (["cpp"], "AutoCast"),_ -> TCppAutoCast - - | ([],"String"), [] -> - TCppString - - (* Things with type parameters hxcpp knows about ... *) - | (["cpp"],"FastIterator"), [p] -> - TCppFastIterator(cpp_type_of stack ctx p) - | (["cpp"],"Pointer"), [p] -> - TCppPointer("Pointer", cpp_type_of stack ctx p) - | (["cpp"],"ConstPointer"), [p] -> - TCppPointer("ConstPointer", cpp_type_of stack ctx p) - | (["cpp"],"RawPointer"), [p] -> - TCppRawPointer("", cpp_type_of stack ctx p) - | (["cpp"],"RawConstPointer"), [p] -> - TCppRawPointer("const ", cpp_type_of stack ctx p) - | (["cpp"],"Function"), [function_type; abi] -> - cpp_function_type_of stack ctx function_type abi; - | (["cpp"],"Callable"), [function_type] - | (["cpp"],"CallableData"), [function_type] -> - cpp_function_type_of_string stack ctx function_type ""; - | (("cpp"::["objc"]),"ObjcBlock"), [function_type] -> - let args,ret = (cpp_function_type_of_args_ret stack ctx function_type) in - TCppObjCBlock(args,ret) - | ((["cpp"]), "Rest"),[rest] -> - TCppRest(cpp_type_of stack ctx rest) - | (("cpp"::["objc"]),"Protocol"), [interface_type] -> - (match follow interface_type with - | TInst (klass,[]) when (has_class_flag klass CInterface) -> - TCppProtocol(klass) - (* TODO - get the line number here *) - | _ -> print_endline "cpp.objc.Protocol must refer to an interface"; - die "" __LOC__; - ) - | (["cpp"],"Reference"), [param] -> - TCppReference(cpp_type_of stack ctx param) - | (["cpp"],"Struct"), [param] -> - TCppStruct(cpp_type_of stack ctx param) - | (["cpp"],"Star"), [param] -> - TCppStar(cpp_type_of_pointer stack ctx param,false) - | (["cpp"],"ConstStar"), [param] -> - TCppStar(cpp_type_of_pointer stack ctx param,true) - - | ([],"Array"), [p] -> - let arrayOf = cpp_type_of stack ctx p in - (match arrayOf with - | TCppVoid (* ? *) - | TCppDynamic -> - TCppDynamicArray - - | TCppObject - | TCppObjectPtr - | TCppReference _ - | TCppStruct _ - | TCppStar _ - | TCppEnum _ - | TCppInst _ - | TCppInterface _ - | TCppProtocol _ - | TCppClass - | TCppDynamicArray - | TCppObjectArray _ - | TCppScalarArray _ - -> TCppObjectArray(arrayOf) - | _ -> - TCppScalarArray(arrayOf) - ) - - | ([],"Null"), [p] -> - cpp_type_of_null stack ctx p - - | _ -> default () - - and cpp_type_of_null stack ctx p = - let baseType = cpp_type_of stack ctx p in - if (type_has_meta_key p Meta.NotNull) || (is_cpp_scalar baseType) then - TCppObject - else - baseType - and cpp_type_of_pointer stack ctx p = - match p with - | TAbstract ({ a_path = ([],"Null") },[t]) -> cpp_type_of stack ctx t - | x -> cpp_type_of stack ctx x - (* Optional types are Dynamic if they norally could not be null *) - and cpp_fun_arg_type_of stack ctx tvar opt = - match opt with - | Some _ -> cpp_type_of_null stack ctx tvar.t_type - | _ -> cpp_type_of stack ctx tvar.t_type - - and cpp_tfun_arg_type_of stack ctx opt t = - if opt then cpp_type_of_null stack ctx t else cpp_type_of stack ctx t - - and cpp_function_type_of stack ctx function_type abi = - let abi = (match follow abi with - | TInst (klass1,_) -> get_meta_string klass1.cl_meta Meta.Abi - | _ -> die "" __LOC__ ) - in - cpp_function_type_of_string stack ctx function_type abi - and cpp_function_type_of_string stack ctx function_type abi_string = - let args,ret = cpp_function_type_of_args_ret stack ctx function_type in - TCppFunction(args, ret, abi_string) - - and cpp_function_type_of_args_ret stack ctx function_type = - match follow function_type with - | TFun(args,ret) -> - (* Optional types are Dynamic if they norally could not be null *) - let cpp_arg_type_of = fun(_,optional,haxe_type) -> - if optional then - cpp_type_of_null stack ctx haxe_type - else - cpp_type_of stack ctx haxe_type - in - List.map cpp_arg_type_of args, cpp_type_of stack ctx ret - | _ -> (* ? *) - [TCppVoid], TCppVoid - - and cpp_instance_type stack ctx klass params = - cpp_type_from_path stack ctx klass.cl_path params (fun () -> - if is_objc_class klass then - TCppObjC(klass) - else if (has_class_flag klass CInterface) && is_native_gen_class klass then - TCppNativePointer(klass) - else if (has_class_flag klass CInterface) then - TCppInterface(klass) - else if (has_class_flag klass CExtern) && (not (is_internal_class klass.cl_path) ) then - let tcpp_params = List.map (cpp_type_of stack ctx) params in - TCppInst(klass, tcpp_params) - else - let tcpp_params = List.map (cpp_type_of stack ctx) params in - TCppInst(klass, tcpp_params) - ) - -let cpp_type_of ctx = cpp_type_of [] ctx -and cpp_type_from_path ctx = cpp_type_from_path [] ctx -and cpp_type_of_null ctx = cpp_type_of_null [] ctx -and cpp_type_of_pointer ctx = cpp_type_of_pointer [] ctx -and cpp_fun_arg_type_of ctx = cpp_fun_arg_type_of [] ctx -and cpp_tfun_arg_type_of ctx = cpp_tfun_arg_type_of [] ctx -and cpp_function_type_of ctx = cpp_function_type_of [] ctx -and cpp_function_type_of_string ctx = cpp_function_type_of_string [] ctx -and cpp_function_type_of_args_ret ctx = cpp_function_type_of_args_ret [] ctx -and cpp_instance_type ctx = cpp_instance_type [] ctx -;; - - -let cpp_return_type ctx haxe_type = - match haxe_type with - | TFun (_,ret) -> cpp_type_of ctx ret - | _ -> TCppDynamic -;; - - -let cpp_member_return_type ctx member = - cpp_return_type ctx member.cf_type -;; - -let is_cpp_objc_type cpptype = match cpptype with - | TCppObjC(_) -> true; - | _ -> false -;; - - - -(* -let rec cpp_object_name = function - | TCppString -> "::String" - | TCppDynamicArray -> "::cpp::VirtualArray_obj" - | TCppObjectArray _ -> "::Array_obj< ::Dynamic>" - | TCppScalarArray(value) -> "::Array_obj< " ^ (tcpp_to_string value) ^ " >" - | TCppObjC klass -> (cpp_class_path_of klass) ^ "_obj" - | TCppInst klass -> (cpp_class_path_of klass) ^ "_obj" - | TCppClass -> "::hx::Class_obj"; - | TCppDynamic -> "Dynamic" - | TCppVoid -> "void" - | TCppVoidStar -> "void *" - | TCppEnum(enum) -> "::hx::EnumBase" - | TCppScalar(scalar) -> scalar - | TCppFastIterator it -> "::cpp::FastIterator< " ^ (tcpp_to_string it) ^ " >"; - | TCppPointer(ptrType,valueType) -> "::cpp::" ^ ptrType ^ "< " ^ (tcpp_to_string valueType) ^ " >" - | TCppRawPointer(constName,valueType) -> constName ^ (tcpp_to_string valueType) ^ "*" - | TCppFunction(argTypes,retType,abi) -> - let args = (String.concat "," (List.map tcpp_to_string argTypes)) in - "::cpp::Function< " ^ abi ^ " " ^ (tcpp_to_string retType) ^ "(" ^ args ^ ") >" - | TCppWrapped _ -> "Dynamic" - | TCppNativePointer klass -> (cpp_class_path_of klass) ^ " *" - | TCppGlobal -> ""; - | TCppNull -> "Dynamic"; - | TCppCode -> "/* code */" -;; -*) - -let cpp_class_name klass = - (* - let rename = get_meta_string klass.cl_meta Meta.Native in - if rename <> "" then - rename ^ "_obj" - else - *) - let globalNamespace = if (get_meta_string klass.cl_meta Meta.Native)<>"" then "" else "::" in - let path = globalNamespace ^ (join_class_path_remap klass.cl_path "::") in - if (is_native_class klass) || path="::String" then path else path ^ "_obj" -;; - - -let cpp_variant_type_of t = match t with - | TCppDynamic - | TCppUnchanged - | TCppObject - | TCppObjectPtr - | TCppReference _ - | TCppStruct _ - | TCppStar _ - | TCppVoid - | TCppFastIterator _ - | TCppDynamicArray - | TCppObjectArray _ - | TCppScalarArray _ - | TCppWrapped _ - | TCppObjC _ - | TCppObjCBlock _ - | TCppRest _ - | TCppInst _ - | TCppInterface _ - | TCppProtocol _ - | TCppCode _ - | TCppClass - | TCppGlobal - | TCppNull - | TCppEnum _ -> TCppDynamic - | TCppString -> TCppString - | TCppFunction _ - | TCppNativePointer _ - | TCppPointer _ - | TCppRawPointer _ - | TCppAutoCast - | TCppVarArg - | TCppVoidStar -> TCppVoidStar - | TCppScalar "Int" - | TCppScalar "bool" - | TCppScalar "Float" -> t - | TCppScalar "::cpp::Int64" -> TCppScalar("Int64") - | TCppScalar "double" - | TCppScalar "float" -> TCppScalar("Float") - | TCppScalar _ -> TCppScalar("int") - | TCppVariant -> TCppVariant -;; - -let cpp_cast_variant_type_of t = match t with - | TCppObjectArray _ - | TCppScalarArray _ - | TCppDynamicArray - | TCppClass - | TCppEnum _ - | TCppInst _ -> t - | _ -> cpp_variant_type_of t; -;; - -let enum_getter_type t = - match cpp_variant_type_of t with - | TCppString -> "String" - | TCppScalar "int" -> "Int" - | TCppScalar "bool" -> "Bool" - | TCppScalar x -> x - | _ -> "Object" -;; - -let ctx_type_string ctx haxe_type = - tcpp_to_string (cpp_type_of ctx haxe_type) -;; - - -let ctx_cant_be_null ctx haxe_type = - match cpp_type_of ctx haxe_type with - | TCppScalar _ -> true - | _ -> false - -let is_complex_compare = function - | TCppScalar _ -> false - | TCppString -> false - | _ -> true -;; - -let is_pointer_compare = function - | TCppObjectArray _ - | TCppScalarArray _ - | TCppDynamicArray - | TCppClass - | TCppEnum _ -> true - | _ -> false -;; - -let is_instance_compare = function - | TCppInterface _ - | TCppInst _ -> true - | _ -> false -;; - -let ctx_arg_type_name ctx name default_val arg_type prefix = - let remap_name = keyword_remap name in - let type_str = (ctx_type_string ctx arg_type) in - match default_val with - | Some {eexpr = TConst TNull} -> (type_str,remap_name) - | Some constant when (ctx_cant_be_null ctx arg_type) -> ("::hx::Null< " ^ type_str ^ " > ",prefix ^ remap_name) - | Some constant -> (type_str,prefix ^ remap_name) - | _ -> (type_str,remap_name);; - - - -(* Generate prototype text, including allowing default values to be null *) -let ctx_arg ctx name default_val arg_type prefix = - let pair = ctx_arg_type_name ctx name default_val arg_type prefix in - (fst pair) ^ " " ^ (snd pair);; - - -(* Generate prototype text, including allowing default values to be null *) -let ctx_arg_name ctx name default_val arg_type prefix = - let pair = ctx_arg_type_name ctx name default_val arg_type prefix in - (snd pair);; - - -let ctx_arg_list ctx arg_list prefix = - String.concat "," (List.map (fun (v,o) -> (ctx_arg ctx v.v_name o v.v_type prefix) ) arg_list) - -let ctx_arg_list_name ctx arg_list prefix = - String.concat "," (List.map (fun (v,o) -> (ctx_arg_name ctx v.v_name o v.v_type prefix) ) arg_list) - -let cpp_arg_names args = - String.concat "," (List.map (fun (name,_,_) -> keyword_remap name) args) -;; - -let rec ctx_tfun_arg_list ctx include_names arg_list = - let oType o arg_type = - let type_str = (ctx_type_string ctx arg_type) in - (* type_str may have already converted Null to Dynamic because of NotNull tag ... *) - if o && (ctx_cant_be_null ctx arg_type) && type_str<>"Dynamic" then - "::hx::Null< " ^ type_str ^ " > " - else - type_str - in - match arg_list with - | [] -> "" - | [(name,o,arg_type)] -> (oType o arg_type) ^ (if include_names then " " ^ (keyword_remap name) else "") - | (name,o,arg_type) :: remaining -> - (oType o arg_type) ^ (if include_names then " " ^ (keyword_remap name) else "") ^ "," ^ (ctx_tfun_arg_list ctx include_names remaining) - -let cpp_var_type_of ctx var = - tcpp_to_string (cpp_type_of ctx var.v_type) -;; - - -let cpp_macro_var_type_of ctx var = - let t = tcpp_to_string (cpp_type_of ctx var.v_type) in - if String.contains t ',' then - Str.global_replace (Str.regexp ",") " HX_COMMA " t - else - t -;; - - - - -let ctx_function_signature ctx include_names tfun abi = - match follow tfun with - | TFun(args,ret) -> (ctx_type_string ctx ret) ^ " " ^ abi ^ "(" ^ (ctx_tfun_arg_list ctx include_names args) ^ ")" - | _ -> "void *" - - - -let cpp_var_name_of var = - let rename = get_meta_string var.v_meta Meta.Native in - if rename <> "" then - rename - else - keyword_remap var.v_name -;; - -let cpp_var_debug_name_of v = - let rec loop meta = match meta with - | (Meta.RealPath,[EConst (String(s,_)),_],_) :: _ -> s - | _ :: meta -> loop meta - | [] -> v.v_name - in - loop v.v_meta -;; - - -let cpp_no_debug_synbol ctx var = - (ctx.ctx_debug_level<=1) || (match var.v_kind with VUser _ -> false | _ -> true) || - match cpp_type_of ctx var.v_type with - | TCppStar _ | TCppReference _ -> true - | TCppInst (class_def, _) when (has_meta_key class_def.cl_meta Meta.StructAccess) -> true - | TCppInst (class_def, _) when (has_meta_key class_def.cl_meta Meta.Unreflective) -> true - | _-> - let name = cpp_var_debug_name_of var in - (String.length name) >4 && (String.sub name 0 4) = "_hx_" -;; - -let cpp_debug_name_of var = - keyword_remap var.v_name -;; - -let cpp_debug_var_visible ctx var = - not (cpp_no_debug_synbol ctx (fst var)) -;; - - -let only_stack_access ctx haxe_type = - let tcpp = cpp_type_of ctx haxe_type in - match tcpp with - | TCppInst(klass, _) -> has_meta_key klass.cl_meta Meta.StackOnly - | _ -> false; -;; - -let cpp_is_real_array obj = - match obj.cpptype with - | TCppScalarArray _ - | TCppObjectArray _ -> true - | _ -> false -;; - - -let is_array_splice_call obj member = - match obj.cpptype, member.cf_name with - | TCppScalarArray _, "splice" - | TCppObjectArray _, "splice" -> true - | _,_ -> false -;; - -let is_map_get_call obj member = - member.cf_name="get" && - (match obj.cpptype with - | TCppInst({cl_path=(["cpp"],"Int64Map")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"IntMap")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"StringMap")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"ObjectMap")}, _) -> true - | _ -> false - ) -;; - -let is_map_set_call obj member = - member.cf_name="set" && - (match obj.cpptype with - | TCppInst({cl_path=(["cpp"],"Int64Map")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"IntMap")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"StringMap")}, _) -> true - | TCppInst({cl_path=(["haxe";"ds"],"ObjectMap")}, _) -> true - | _ -> false - ) -;; - - - -let is_array_concat_call obj member = - match obj.cpptype, member.cf_name with - | TCppScalarArray _, "concat" - | TCppObjectArray _, "concat" -> true - | _,_ -> false -;; - -let cpp_can_static_cast funcType inferredType = - match funcType with - | TCppReference(_) | TCppStar(_) | TCppStruct(_) -> false - | _ -> - (match inferredType with - | TCppInst (cls, _) when is_extern_class cls -> false - | TCppEnum e when is_extern_enum e -> false - | TCppInst _ - | TCppClass - | TCppEnum _ - -> (tcpp_to_string funcType) <> (tcpp_to_string inferredType) - | _ -> false - ) -;; - -let cpp_member_name_of member = - let rename = get_meta_string member.cf_meta Meta.Native in - if rename <> "" then - rename - else - keyword_remap member.cf_name -;; - -let cpp_is_templated_call ctx member = - has_meta_key member.cf_meta Meta.TemplatedCall -;; - -let cpp_is_static_extension ctx member = - has_meta_key member.cf_meta Meta.NativeStaticExtension -;; - - -let cpp_template_param path native = - let path = "::" ^ (join_class_path_remap (path) "::" ) in - if (native) then - path - else match path with - | "::Array" -> "::hx::ArrayBase" - | "::Int" -> "int" - | "::Bool" -> "bool" - | x -> x -;; - - -let cpp_append_block block expr = - match block.cppexpr with - | CppBlock(expr_list, closures, gc_stack) -> - { block with cppexpr = CppBlock( expr_list @ [expr], closures, gc_stack) } - | _ -> abort "Internal error appending expression" block.cpppos -;; - - - -let cpp_enum_name_of field = - let rename = get_meta_string field.ef_meta Meta.Native in - if rename <> "" then - rename - else - keyword_remap field.ef_name -;; - -let is_object_element ctx member_type = - match member_type with - | TCppInst (x, _) - | TCppInterface x - -> not (is_extern_class x) - | TCppDynamic - | TCppObject - | TCppObjectPtr - | TCppEnum _ - | TCppString - | TCppFunction _ - | TCppDynamicArray - | TCppObjectArray _ - | TCppWrapped _ - | TCppScalarArray _ - | TCppClass - -> true - | _ -> false -;; - -let is_gc_element ctx member_type = - Common.defined ctx.ctx_common Define.HxcppGcGenerational && - (is_object_element ctx member_type) -;; - -let retype_expression ctx request_type function_args function_type expression_tree forInjection = - let rev_closures = ref [] in - let closureId = ref 0 in - let declarations = ref (Hashtbl.create 0) in - let undeclared = ref (Hashtbl.create 0) in - let uses_this = ref None in - let gc_stack = ref false in - let injection = ref forInjection in - let this_real = ref (if ctx.ctx_real_this_ptr then ThisReal else ThisDynamic) in - let file_id = ctx.ctx_file_id in - let function_return_type = ref (cpp_type_of ctx function_type) in - let loop_stack = ref [] in - let forCppia = Common.defined ctx.ctx_common Define.Cppia in - let alloc_file_id () = - incr file_id; - !file_id - in - let begin_loop () = - loop_stack := (alloc_file_id (),ref false) :: !loop_stack; - (fun () -> match !loop_stack with - | (label_id,used) :: tl -> - loop_stack := tl; - if !used then label_id else -1 - | [] -> - abort "Invalid inernal loop handling" expression_tree.epos - ) - in - - (* '__trace' is at the top-level *) - Hashtbl.add !declarations "__trace" (); - List.iter (fun arg -> Hashtbl.add !declarations arg.v_name () ) function_args; - - let rec to_lvalue value = - match value.cppexpr with - | CppVar( VarClosure(var) as varloc) when is_gc_element ctx (cpp_type_of ctx var.v_type) -> - CppVarRef(varloc), true - | CppVar( VarThis(member,_) as varloc) when is_gc_element ctx (cpp_type_of ctx member.cf_type) -> - CppVarRef(varloc), true - | CppVar( VarInstance(obj,member,_,"->") as varloc) when is_gc_element ctx (cpp_type_of ctx member.cf_type) -> - CppVarRef(varloc), true - | CppVar varloc -> CppVarRef(varloc), false - - | CppArray arrayloc -> - CppArrayRef(arrayloc), (match arrayloc with - | ArrayObject(arrayObj, index, _) when (is_gc_element ctx TCppDynamic) -> true - | ArrayTyped(arrayObj, index, t) when (is_gc_element ctx t) -> true - | _ -> false) - - | CppDynamicField(expr, name) -> CppDynamicRef(expr,name), false - | CppTCast(cppExpr,_) - | CppCast(cppExpr,_) - | CppCastStatic(cppExpr,_) - | CppCastObjC(cppExpr,_) - | CppCastObjCBlock(cppExpr,_,_) - | CppCastScalar(cppExpr,_) -> to_lvalue cppExpr - | CppCastVariant(cppExpr) -> to_lvalue cppExpr - | CppExtern(name,isGlobal) -> CppExternRef(name,isGlobal), false - - | _ -> abort ("Could not convert expression to l-value (" ^ s_tcpp value.cppexpr ^ ")") value.cpppos - in - - let rec retype return_type expr = - let cpp_type_of t = cpp_type_of ctx t in - let mk_cppexpr newExpr newType = { cppexpr = newExpr; cpptype = newType; cpppos = expr.epos } in - let retype_function_args args arg_types = - let rec map_pair args types result= - match args, types with - | args, [TCppRest(rest)] -> (List.rev (List.map (retype rest) args) ) @ result - | [], [] -> result - | a::arest, t::trest -> map_pair arest trest ((retype t a) :: result ) - | _, [] -> abort ("Too many args") expr.epos - | [], _ -> abort ("Too many types") expr.epos - in - List.rev (map_pair args arg_types []) - in - - let retypedExpr, retypedType = - match expr.eexpr with - | TEnumParameter( enumObj, enumField, enumIndex ) -> - let retypedObj = retype TCppDynamic enumObj in - CppEnumParameter( retypedObj, enumField, enumIndex ), cpp_cast_variant_type_of (cpp_type_of (get_nth_type enumField enumIndex)) - - | TEnumIndex enumObj -> - let retypedObj = retype TCppDynamic enumObj in - CppEnumIndex retypedObj, TCppScalar "int" - - | TConst TThis -> - uses_this := Some !this_real; - CppThis(!this_real), if !this_real=ThisDynamic then TCppDynamic else cpp_type_of expr.etype - - | TConst TSuper -> - uses_this := Some !this_real; - CppSuper(!this_real), if !this_real=ThisDynamic then TCppDynamic else cpp_type_of expr.etype - - | TConst TNull when is_objc_type expr.etype -> - CppNil, TCppNull - - | TConst x -> - cpp_const_type x - - | TIdent "__global__" -> - (* functions/vars will appear to be members of the virtual global object *) - CppClassOf(([],""),false), TCppGlobal - - | TLocal tvar -> - let name = tvar.v_name in - if (Hashtbl.mem !declarations name) then begin - (*print_endline ("Using existing tvar " ^ tvar.v_name);*) - CppVar(VarLocal(tvar)), cpp_type_of tvar.v_type - end else begin - (*print_endline ("Missing tvar " ^ tvar.v_name);*) - Hashtbl.replace !undeclared name tvar; - if has_var_flag tvar VCaptured then - CppVar(VarClosure(tvar)), cpp_type_of tvar.v_type - else - CppExtern(name,false), cpp_type_of tvar.v_type - end - - | TIdent name -> - CppExtern(name,false), return_type - - | TBreak -> - if forCppia then - CppBreak, TCppVoid - else begin match !loop_stack with - | [] -> - CppBreak, TCppVoid - | (label_id,used) :: _ -> - used := true; - (CppGoto label_id),TCppVoid - end - - | TContinue -> - CppContinue, TCppVoid - - | TThrow e1 -> - CppThrow(retype TCppDynamic e1), TCppVoid - - | TMeta( (Meta.Fixed,_,_),e) -> - let cppType = retype return_type e in - (match cppType.cppexpr with - | CppObjectDecl(def,false) -> CppObjectDecl(def,true), cppType.cpptype - | _ -> cppType.cppexpr, cppType.cpptype - ) - - | TMeta(_,e) - | TParenthesis e -> - let cppType = retype return_type e in - cppType.cppexpr, cppType.cpptype - - | TField( obj, field ) -> - (match field with - | FInstance (clazz,params,member) - | FClosure (Some (clazz,params),member) -> - let funcReturn = cpp_member_return_type ctx member in - let clazzType = cpp_instance_type ctx clazz params in - let retypedObj = retype clazzType obj in - let exprType = cpp_type_of member.cf_type in - let is_objc = is_cpp_objc_type retypedObj.cpptype in - - if retypedObj.cpptype=TCppNull then - CppNullAccess, TCppDynamic - else if retypedObj.cpptype=TCppDynamic && not (has_class_flag clazz CInterface) then begin - if is_internal_member member.cf_name then - CppFunction( FuncInstance(retypedObj,InstPtr,member), funcReturn ), exprType - else - CppDynamicField(retypedObj, member.cf_name), TCppVariant - end else if cpp_is_struct_access retypedObj.cpptype then begin - - match retypedObj.cppexpr with - | CppThis ThisReal -> - CppVar(VarThis(member, retypedObj.cpptype)), exprType - | CppSuper this -> - CppFunction( FuncSuper(this, retypedObj.cpptype,member), funcReturn ), exprType - | _ -> if (is_var_field member) then - CppVar( VarInstance(retypedObj,member,tcpp_to_string clazzType, ".") ), exprType - else - CppFunction( FuncInstance(retypedObj,InstStruct,member), funcReturn ), exprType - - end else if is_var_field member then begin - - let exprType = match retypedObj.cpptype, exprType with - | TCppPointer(_,t), TCppDynamic - | TCppRawPointer(_,t), TCppDynamic (* the 'type parameter' will show up as Dynamic *) - -> t - | _ -> exprType - in - - match retypedObj.cppexpr with - | CppThis ThisReal -> - CppVar(VarThis(member, retypedObj.cpptype) ), exprType - | _ -> - (match retypedObj.cpptype, member.cf_name with - (* Special variable remapping ... *) - | TCppDynamicArray, "length" when ( not forCppia )-> - CppCall(FuncInternal(retypedObj,"get_length","->"),[]), exprType - - | TCppInterface _,_ - | TCppDynamic,_ -> - CppDynamicField(retypedObj, member.cf_name), TCppVariant - | TCppObjC _,_ -> - CppVar(VarInstance(retypedObj,member,tcpp_to_string clazzType, ".") ), exprType - - | _ -> - let operator = if cpp_is_struct_access retypedObj.cpptype || retypedObj.cpptype=TCppString then "." else "->" in - CppVar(VarInstance(retypedObj,member,tcpp_to_string clazzType, operator) ), exprType - ) - end else if ((has_class_flag clazz CInterface) && not is_objc (* Use instance call for objc interfaces *)) then - CppFunction( FuncInterface(retypedObj,clazz,member), funcReturn ), exprType - else begin - let isArrayObj = match retypedObj.cpptype with - | TCppDynamicArray - | TCppObjectArray _ - | TCppScalarArray _ - -> true - | _ -> false in - (* Special array return values *) - let funcReturn = - if isArrayObj then match member.cf_name with - | "map" -> TCppDynamicArray - | "splice" - | "slice" - | "concat" - | "copy" - | "filter" -> retypedObj.cpptype - | _ -> funcReturn - else match retypedObj.cpptype, funcReturn with - | TCppPointer(_,t), TCppDynamic - | TCppRawPointer(_,t), TCppDynamic (* the 'type parameter' will show up as Dynamic *) - -> t - | _ -> funcReturn - in - (match retypedObj.cppexpr with - | CppThis ThisReal -> - CppFunction( FuncThis(member, retypedObj.cpptype), funcReturn ), exprType - | CppSuper this -> - CppFunction( FuncSuper(this, retypedObj.cpptype,member), funcReturn ), exprType - | _ -> - CppFunction( FuncInstance(retypedObj,(if is_objc then InstObjC else InstPtr),member), funcReturn ), exprType - ) - end - - | FStatic ( _, ({cf_name="nativeFromStaticFunction"} as member) ) -> - let funcReturn = cpp_member_return_type ctx member in - let exprType = cpp_type_of member.cf_type in - CppFunction( FuncFromStaticFunction, funcReturn ), exprType - - | FStatic (clazz,member) -> - let funcReturn = cpp_member_return_type ctx member in - let exprType = cpp_type_of member.cf_type in - let objC = is_objc_class clazz in - if is_var_field member then - CppVar(VarStatic(clazz, objC, member)), exprType - else - CppFunction( FuncStatic(clazz,objC,member), funcReturn ), exprType - | FClosure (None,field) - | FAnon field -> - let obj = retype TCppDynamic obj in - let fieldName = field.cf_name in - if obj.cpptype=TCppGlobal then - CppExtern(fieldName,true), cpp_type_of expr.etype - else if obj.cpptype=TCppNull then - CppNullAccess, TCppDynamic - else if is_internal_member fieldName then begin - let cppType = cpp_return_type ctx expr.etype in - if obj.cpptype=TCppString then - CppFunction( FuncInternal(obj,fieldName,"."), cppType), cppType - else - CppFunction( FuncInternal(obj,fieldName,"->"), cppType), cppType - end else - CppDynamicField(obj, field.cf_name), TCppVariant - - | FDynamic fieldName -> - let obj = retype TCppDynamic obj in - if obj.cpptype=TCppNull then - CppNullAccess, TCppDynamic - else if fieldName="cca" && obj.cpptype=TCppString then - CppFunction( FuncInternal(obj,"cca","."), TCppScalar("int")), TCppDynamic - else if fieldName="__s" && obj.cpptype=TCppString then - CppVar( VarInternal(obj,".","utf8_str()")), TCppRawPointer("const ", TCppScalar("char")) - else if fieldName="__Index" then - CppEnumIndex(obj), TCppScalar("int") - else if is_internal_member fieldName || cpp_is_real_array obj then begin - let cppType = cpp_return_type ctx expr.etype in - if obj.cpptype=TCppString then - CppFunction( FuncInternal(obj,fieldName,"."), cppType), cppType - else - CppFunction( FuncInternal(obj,fieldName,"->"), cppType), cppType - end else if (obj.cpptype=TCppGlobal) then - CppExtern(fieldName,true), cpp_type_of expr.etype - else if (obj.cpptype=TCppClass) then begin - match obj.cppexpr with - | CppClassOf(path,_) -> - CppExtern ( (join_class_path_remap path "::" ) ^ "_obj::" ^ fieldName, true ), cpp_type_of expr.etype - | _ -> - CppVar( VarInternal(obj,"->",fieldName)), cpp_type_of expr.etype - end else - CppDynamicField(obj, fieldName), TCppVariant - - | FEnum (enum, enum_field) -> - CppEnumField(enum, enum_field), TCppEnum(enum) - ) - - | TCall( {eexpr = TIdent "__cpp__"}, arg_list ) -> - let cppExpr = match arg_list with - | [{ eexpr = TConst (TString code) }] -> CppCode(code, []) - | ({ eexpr = TConst (TString code) }) :: remaining -> - let retypedArgs = List.map (fun arg -> retype (TCppCode(cpp_type_of arg.etype)) arg) remaining in - CppCode(code, retypedArgs) - | _ -> abort "__cpp__'s first argument must be a string" expr.epos; - in - cppExpr, TCppCode(cpp_type_of expr.etype) - - | TCall( func, args ) -> - let retypedFunc = retype TCppUnchanged func in - (match retypedFunc.cpptype with - | TCppNull -> - CppNullAccess, TCppDynamic - | TCppFunction(argTypes,retType,_) -> - let retypedArgs = retype_function_args args argTypes in - CppCall( FuncExpression(retypedFunc) ,retypedArgs), retType - | TCppObjCBlock(argTypes,retType) -> - let retypedArgs = retype_function_args args argTypes in - CppCall( FuncExpression(retypedFunc) ,retypedArgs), retType - - | _ -> - let cppType = cpp_type_of expr.etype in - (match retypedFunc.cppexpr with - | CppFunction(FuncFromStaticFunction ,returnType) -> - let retypedArgs = List.map (retype TCppDynamic ) args in - ( match retypedArgs with - | [ {cppexpr=CppFunction( FuncStatic(clazz,false,member), funcReturn)} ] -> - CppFunctionAddress(clazz,member), funcReturn - | _ -> abort "cpp.Function.fromStaticFunction must be called on static function" expr.epos; - ) - | CppEnumIndex(_) -> - (* Not actually a TCall...*) - retypedFunc.cppexpr, retypedFunc.cpptype - - | CppFunction( FuncInstance(obj, InstPtr, member), _ ) when not forCppia && return_type=TCppVoid && is_array_splice_call obj member -> - let retypedArgs = List.map (retype TCppDynamic ) args in - CppCall( FuncInstance(obj, InstPtr, {member with cf_name="removeRange"}), retypedArgs), TCppVoid - - | CppFunction( FuncInstance(obj, InstPtr, member), _ ) when is_array_concat_call obj member -> - let retypedArgs = List.map (retype obj.cpptype) args in - CppCall( FuncInstance(obj, InstPtr, member), retypedArgs), return_type - - | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "::hx::AddressOf" -> - let arg = retype TCppUnchanged (List.hd args) in - let rawType = match arg.cpptype with | TCppReference(x) -> x | x -> x in - CppAddressOf(arg), TCppRawPointer("", rawType) - - | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "::hx::StarOf" -> - let arg = retype TCppUnchanged (List.hd args) in - let rawType = match arg.cpptype with | TCppReference(x) -> x | x -> x in - CppAddressOf(arg), TCppStar(rawType,false) - - | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "::hx::Dereference" -> - let arg = retype TCppUnchanged (List.hd args) in - let rawType = match arg.cpptype with | TCppStar(x,_) -> x | x -> x in - CppDereference(arg), TCppReference(rawType) - - | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "_hx_create_array_length" -> - let retypedArgs = List.map (retype TCppDynamic ) args in - (* gc_stack - not needed yet *) - (match return_type with - | TCppObjectArray _ - | TCppScalarArray _ -> CppCall( FuncNew(return_type), retypedArgs), return_type - | _ -> CppCall( FuncNew(TCppDynamicArray), retypedArgs), return_type - ) - - | CppFunction( FuncStatic(obj, false, member), returnType ) when cpp_is_templated_call ctx member -> - let retypedArgs = List.map (retype TCppDynamic ) args in - (match retypedArgs with - | {cppexpr = CppClassOf(path,native) }::rest -> - CppCall( FuncTemplate(obj,member,path,native), rest), returnType - | _ -> abort "First parameter of template function must be a Class" retypedFunc.cpppos - ) - - | CppFunction( FuncInstance(obj, InstPtr, member), _ ) when is_map_get_call obj member -> - let retypedArgs = List.map (retype TCppDynamic ) args in - let fname, cppType = match return_type with - | TCppVoid | TCppScalar("bool") -> (if forCppia then "getBool" else "get_bool"), return_type - | TCppScalar("int") -> (if forCppia then "getInt" else "get_int"), return_type - | TCppScalar("::cpp::Int64") -> (if forCppia then "getInt64" else "get_int64"), return_type - | TCppScalar("Float") -> (if forCppia then "getFloat" else "get_float"), return_type - | TCppString -> (if forCppia then "getString" else "get_string"), return_type - | _ -> "get", TCppDynamic - in - let func = FuncInstance(obj, InstPtr, {member with cf_name=fname}) in - (* - if cpp_can_static_cast cppType return_type then begin - let call = mk_cppexpr (CppCall(func,retypedArgs)) cppType in - CppCastStatic(call, cppType), cppType - end else - *) - CppCall( func, retypedArgs), cppType - - - | CppFunction( FuncInstance(obj, InstPtr, member), _ ) when forCppia && is_map_set_call obj member -> - let retypedArgs = List.map (retype TCppDynamic ) args in - let fname = match retypedArgs with - | [_;{cpptype=TCppScalar("bool")}] -> "setBool" - | [_;{cpptype=TCppScalar("int")}] -> "setInt" - | [_;{cpptype=TCppScalar("::cpp::Int64")}] -> "setInt64" - | [_;{cpptype=TCppScalar("Float")}] -> "setFloat" - | [_;{cpptype=TCppString}] -> "setString" - | _ -> "set" - in - let func = FuncInstance(obj, InstPtr, {member with cf_name=fname}) in - CppCall( func, retypedArgs), cppType - - - | CppFunction( FuncInstance(obj,InstPtr,member) as func, returnType ) when cpp_can_static_cast returnType cppType -> - let retypedArgs = List.map (retype TCppDynamic ) args in - let call = mk_cppexpr (CppCall(func,retypedArgs)) returnType in - CppCastStatic(call, cppType), cppType - (* - let error_printer file line = Printf.sprintf "%s:%d:" file line in - let epos = Lexer.get_error_pos error_printer expr.epos in - print_endline ( "fixed override " ^ member.cf_name ^ " @ " ^ epos ^ " " ^ (tcpp_to_string returnType) ^ "->" ^ (ctx_type_string ctx expr.etype) ); - CppCall(func,retypedArgs), returnType - *) - - (* Other functions ... *) - | CppFunction( FuncInstance(_, InstStruct, {cf_type=TFun(arg_types,_)}) as func, return_type) -> - (* For struct access classes use the types of the arguments instead of the function argument types *) - (* In the case of generic extern classes a TFun arg type could be `MyClass.T` instead of the real type *) - let map_args func_arg passed_arg = - let (name, opt, _) = func_arg in - name, opt, passed_arg.etype in - let real_types = List.map2 map_args arg_types args in - let arg_types = List.map (fun (_,opt,t) -> cpp_tfun_arg_type_of ctx opt t) real_types in - let retypedArgs = retype_function_args args arg_types in - CppCall(func,retypedArgs), return_type - - | CppFunction( FuncInstance(_,_,{cf_type=TFun(arg_types,_)} ) as func, returnType ) - | CppFunction( FuncStatic(_,_,{cf_type=TFun(arg_types,_)} ) as func, returnType ) - | CppFunction( FuncThis({cf_type=TFun(arg_types,_)},_ ) as func, returnType ) -> - let arg_types = List.map (fun (_,opt,t) -> cpp_tfun_arg_type_of ctx opt t) arg_types in - (* retype args specifically (not just CppDynamic) *) - let retypedArgs = retype_function_args args arg_types in - CppCall(func,retypedArgs), returnType - - | CppFunction(func,returnType) -> - let retypedArgs = List.map (retype TCppDynamic ) args in - CppCall(func,retypedArgs), returnType - - | CppEnumField(enum, field) -> - (* TODO - proper re-typing *) - let retypedArgs = List.map (retype TCppDynamic ) args in - CppCall( FuncEnumConstruct(enum,field),retypedArgs), cppType - - | CppSuper(_) -> - (* TODO - proper re-typing *) - let retypedArgs = List.map (retype TCppDynamic ) args in - CppCall( FuncSuperConstruct(retypedFunc.cpptype) ,retypedArgs), TCppVoid - - | CppDynamicField(expr,name) -> - let retypedArgs = List.map (retype TCppDynamic ) args in - (* Special function calls *) - (match expr.cpptype, name with - | TCppGlobal, _ -> - let retypedArgs = List.map (retype TCppUnchanged ) args in - CppCall( FuncExtern(name,true),retypedArgs), cppType - - | TCppString, _ -> - CppCall( FuncInternal(expr,name,"."),retypedArgs), cppType - - | _, "__Tag" -> - CppCall( FuncInternal(expr,"_hx_getTag","->"),retypedArgs), cppType - - | _, name when is_internal_member name -> - CppCall( FuncInternal(expr,name,"->"),retypedArgs), cppType - - | _ -> (* not special *) - CppCall( FuncExpression(retypedFunc), retypedArgs), TCppDynamic - ) - - | CppExtern(name,isGlobal) -> - let retypedArgs = List.map (retype TCppUnchanged ) args in - CppCall( FuncExtern(name,isGlobal) ,retypedArgs), cppType - - | _ -> - let retypedArgs = List.map (retype TCppDynamic ) args in - CppCall( FuncExpression(retypedFunc), retypedArgs), TCppDynamic - ) - ) - - | TNew (class_def,params,args) -> - let constructor_type = match OverloadResolution.maybe_resolve_constructor_overload class_def params args with - | None -> abort "Could not find overload" expr.epos - | Some (_,constructor,_) -> constructor.cf_type - in - let arg_types, _ = cpp_function_type_of_args_ret ctx constructor_type in - let retypedArgs = retype_function_args args arg_types in - let created_type = cpp_type_of expr.etype in - gc_stack := !gc_stack || (match created_type with | TCppInst(t, _) -> not (is_native_class t) | _ -> false ); - CppCall( FuncNew(created_type), retypedArgs), created_type - - | TFunction func -> - let old_this_real = !this_real in - this_real := ThisFake; - (* TODO - this_dynamic ? *) - let old_undeclared = Hashtbl.copy !undeclared in - let old_declarations = Hashtbl.copy !declarations in - let old_uses_this = !uses_this in - let old_gc_stack = !gc_stack in - let old_return_type = !function_return_type in - let ret =cpp_type_of func.tf_type in - function_return_type := ret; - uses_this := None; - undeclared := Hashtbl.create 0; - declarations := Hashtbl.create 0; - List.iter ( fun (tvar,_) -> - Hashtbl.add !declarations tvar.v_name () ) func.tf_args; - let cppExpr = retype TCppVoid (mk_block func.tf_expr) in - let result = { close_expr=cppExpr; - close_id= !closureId; - close_undeclared= !undeclared; - close_type= ret; - close_args= func.tf_args; - close_this= !uses_this; - } in - incr closureId; - declarations := old_declarations; - undeclared := old_undeclared; - Hashtbl.iter (fun name tvar -> - if not (Hashtbl.mem !declarations name) then - Hashtbl.replace !undeclared name tvar; - ) result.close_undeclared; - function_return_type := old_return_type; - this_real := old_this_real; - uses_this := if !uses_this != None then Some old_this_real else old_uses_this; - gc_stack := old_gc_stack; - rev_closures := result:: !rev_closures; - CppClosure(result), TCppDynamic - - | TArray (e1,e2) -> - let arrayExpr, elemType = match cpp_is_native_array_access (cpp_type_of e1.etype) with - | true -> - let retypedObj = retype TCppUnchanged e1 in - let retypedIdx = retype (TCppScalar("int")) e2 in - CppArray( ArrayRawPointer(retypedObj, retypedIdx) ), cpp_type_of expr.etype - | false -> - let retypedObj = retype TCppDynamic e1 in - let retypedIdx = retype (TCppScalar("int")) e2 in - (match retypedObj.cpptype with - | TCppScalarArray scalar -> - CppArray( ArrayTyped(retypedObj,retypedIdx,scalar) ), scalar - | TCppPointer (_,elem) -> - CppArray( ArrayPointer(retypedObj, retypedIdx) ), elem - | TCppRawPointer (_,elem) -> - CppArray( ArrayRawPointer(retypedObj, retypedIdx) ), elem - | TCppObjectArray TCppDynamic -> - CppArray( ArrayObject(retypedObj,retypedIdx,TCppDynamic) ), TCppDynamic - | TCppObjectArray elem -> - CppArray( ArrayObject(retypedObj,retypedIdx,elem) ), elem - | TCppInst({cl_array_access = Some _ } as klass, _) -> - CppArray( ArrayImplements(klass, retypedObj,retypedIdx) ), cpp_type_of expr.etype - | TCppDynamicArray -> - CppArray( ArrayVirtual(retypedObj, retypedIdx) ), TCppDynamic - | _ -> - CppArray( ArrayDynamic(retypedObj, retypedIdx) ), TCppDynamic) - in - let returnType = cpp_type_of expr.etype in - if cpp_can_static_cast elemType returnType then - CppCastStatic(mk_cppexpr arrayExpr returnType, returnType), returnType - else - arrayExpr, elemType - - | TTypeExpr module_type -> - (* If we try and use the coreType / runtimeValue cpp.Int64 abstract with Class then we get a class decl of the abstract *) - (* as that abstract has functions in its declaration *) - (* Intercept it and replace it with the path of the actual int64 type so the generated cpp is correct *) - let path = match module_type with - | TClassDecl ({ cl_path = ["cpp";"_Int64"],"Int64_Impl_" }) -> ["cpp"],"Int64" - | _ -> t_path module_type in - CppClassOf(path, is_native_gen_module module_type), TCppClass - - | TBinop (op,left,right) -> - let binOpType = match op with - | OpDiv -> TCppScalar("Float") - | OpBoolAnd | OpBoolOr -> TCppScalar("bool") - | OpAnd | OpOr | OpXor | OpShl | OpShr | OpUShr -> TCppScalar("int") - | OpAssign -> (retype TCppUnchanged left).cpptype - | OpMult | OpSub -> cpp_type_of expr.etype - | _ -> TCppUnchanged - in - let e1 = retype binOpType left in - let e2 = retype binOpType right in - - let complex = (is_complex_compare e1.cpptype) || (is_complex_compare e2.cpptype) in - let pointer = (is_pointer_compare e1.cpptype) || (is_pointer_compare e2.cpptype) in - let instance = (is_instance_compare e1.cpptype) || (is_instance_compare e2.cpptype) in - let e1_null = e1.cpptype=TCppNull in - let e2_null = e2.cpptype=TCppNull in - let reference = match op with - | OpAssign -> - let lvalue, gc = to_lvalue e1 in - if gc then gc_stack := true; - CppSet(lvalue, e2) - | OpAssignOp op -> - let lvalue, gc = to_lvalue e1 in - if gc then gc_stack := true; - CppModify(op, lvalue, e2) - | OpEq when e1_null && e2_null-> CppBool(true) - | OpGte when e1_null && e2_null-> CppBool(true) - | OpLte when e1_null && e2_null-> CppBool(true) - | OpNotEq when e1_null && e2_null-> CppBool(false) - | _ when e1_null && e2_null-> CppBool(false) - - | OpEq when e1_null -> CppNullCompare("IsNull", e2) - | OpGte when e1_null -> CppNullCompare("IsNull", e2) - | OpLte when e1_null -> CppNullCompare("IsNull", e2) - | OpNotEq when e1_null -> CppNullCompare("IsNotNull", e2) - - | OpEq when e2_null -> CppNullCompare("IsNull", e1) - | OpGte when e2_null -> CppNullCompare("IsNull", e1) - | OpLte when e2_null -> CppNullCompare("IsNull", e1) - | OpNotEq when e2_null -> CppNullCompare("IsNotNull", e1) - - | OpEq when instance -> CppCompare("IsInstanceEq", e1, e2, op) - | OpNotEq when instance -> CppCompare("IsInstanceNotEq", e1, e2, op) - - | OpEq when pointer -> CppCompare("IsPointerEq", e1, e2, op) - | OpNotEq when pointer -> CppCompare("IsPointerNotEq", e1, e2, op) - - | OpEq when complex -> CppCompare("IsEq", e1, e2, op) - | OpNotEq when complex -> CppCompare("IsNotEq", e1, e2, op) - | OpGte when complex -> CppCompare("IsGreaterEq", e1, e2, op) - | OpLte when complex -> CppCompare("IsLessEq", e1, e2, op) - | OpGt when complex -> CppCompare("IsGreater", e1, e2, op) - | OpLt when complex -> CppCompare("IsLess", e1, e2, op) - - | _ -> CppBinop(op,e1,e2) - in - (match op,e1.cpptype,e2.cpptype with - (* Variant + Variant = Variant *) - | OpAdd, _, TCppVariant | OpAdd, TCppVariant, _ - -> reference, TCppVariant - | _,_,_ -> reference, cpp_type_of expr.etype - ) - - | TUnop (op,pre,e1) -> - let targetType = match op with - | Not -> TCppScalar("bool") - | NegBits -> TCppScalar("int") - | _ -> cpp_type_of e1.etype - in - - let e1 = retype targetType e1 in - let reference = match op with - | Increment -> - let lvalue, gc = to_lvalue e1 in - if gc then gc_stack := true; - CppCrement( CppIncrement, pre, lvalue) - | Decrement -> - let lvalue, gc = to_lvalue e1 in - if gc then gc_stack := true; - CppCrement( CppDecrement, pre, lvalue) - | Neg -> CppUnop(CppNeg,e1) - | Not -> CppUnop(CppNot,e1) - | NegBits -> CppUnop(CppNegBits,e1) - | Spread -> die ~p:expr.epos "Unexpected spread operator" __LOC__ - in reference, cpp_type_of expr.etype - - | TFor (v,init,block) -> - let old_declarations = Hashtbl.copy !declarations in - Hashtbl.add !declarations v.v_name (); - let init = retype (cpp_type_of v.v_type) init in - let block = retype TCppVoid (mk_block block) in - declarations := old_declarations; - CppFor(v,init,block), TCppVoid - - | TWhile (e1,e2,flag) -> - let condition = retype (TCppScalar("bool")) e1 in - let close = begin_loop() in - let block = retype TCppVoid (mk_block e2) in - CppWhile(condition, block, flag, close()), TCppVoid - - | TArrayDecl el -> - let retypedEls = List.map (retype TCppDynamic) el in - CppArrayDecl(retypedEls), cpp_type_of expr.etype - - | TBlock expr_list -> - let inject = !injection in - injection := false; - if (return_type<>TCppVoid) && not forCppia then - print_endline ("Value from a block not handled " ^ - (expr.epos.pfile ) ^ " " ^ (string_of_int (Lexer.get_error_line expr.epos) )); - - let old_declarations = Hashtbl.copy !declarations in - let old_closures = !rev_closures in - rev_closures := []; - let local_closures = ref [] in - let remaining = ref (List.length expr_list) in - let cppExprs = List.map ( fun expr -> - let targetType = if inject && (!remaining=1) then cpp_type_of expr.etype else TCppVoid in - decr remaining; - let result = retype targetType expr in - local_closures := !rev_closures @ !local_closures; - rev_closures := []; - result - ) expr_list in - declarations := old_declarations; - rev_closures := old_closures; - - CppBlock(cppExprs, List.rev !local_closures, !gc_stack ), TCppVoid - - | TObjectDecl ( - (("fileName",_,_) , { eexpr = (TConst (TString file)) }) :: - (("lineNumber",_,_) , { eexpr = (TConst (TInt line)) }) :: - (("className",_,_) , { eexpr = (TConst (TString class_name)) }) :: - (("methodName",_,_), { eexpr = (TConst (TString meth)) }) :: [] ) -> - CppPosition(file,line,class_name,meth), TCppDynamic - - | TObjectDecl el -> - let retypedEls = List.map ( fun((v,_,_),e) -> v, retype TCppDynamic e) el in - (match return_type with - | TCppVoid -> CppObjectDecl(retypedEls,false), TCppVoid - | _ -> CppObjectDecl(retypedEls,false), TCppDynamic - ) - - | TVar (v,eo) -> - let varType = cpp_type_of v.v_type in - let init = match eo with None -> None | Some e -> Some (retype varType e) in - Hashtbl.add !declarations v.v_name (); - CppVarDecl(v, init), varType - - | TIf (ec,e1,e2) -> - let ec = retype (TCppScalar("bool")) ec in - let blockify = if return_type!=TCppVoid then fun e -> e else mk_block in - let e1 = retype return_type (blockify e1) in - let e2 = match e2 with None->None | Some e -> Some (retype return_type (blockify e)) - in - CppIf(ec, e1, e2), if return_type=TCppVoid then TCppVoid else cpp_type_of expr.etype - - (* Switch internal return - wrap whole thing in block *) - | TSwitch {switch_subject = condition;switch_cases = cases;switch_default = def} -> - if return_type<>TCppVoid then - abort "Value from a switch not handled" expr.epos; - - let conditionType = cpp_type_of condition.etype in - let condition = retype conditionType condition in - let cppDef = match def with None -> None | Some e -> Some (retype TCppVoid (mk_block e)) in - if forCppia then begin - let cases = List.map (fun {case_patterns = el;case_expr = e2} -> - let cppBlock = retype TCppVoid (mk_block e2) in - (List.map (retype conditionType) el), cppBlock ) cases in - CppSwitch(condition, conditionType, cases, cppDef, -1), TCppVoid - end else (try - (match conditionType with TCppScalar("int") | TCppScalar("bool") -> () | _ -> raise Not_found ); - let cases = List.map (fun {case_patterns = el;case_expr = e2} -> - (List.map const_int_of el), (retype TCppVoid (mk_block e2)) ) cases in - CppIntSwitch(condition, cases, cppDef), TCppVoid - with Not_found -> - let label = alloc_file_id () in - (* do something better maybe ... *) - let cases = List.map (fun {case_patterns = el;case_expr = e2} -> - let cppBlock = retype TCppVoid (mk_block e2) in - let gotoExpr = { cppexpr = CppGoto(label); cpptype = TCppVoid; cpppos = e2.epos } in - let cppBlock = cpp_append_block cppBlock gotoExpr in - (List.map (retype conditionType) el), cppBlock ) cases in - CppSwitch(condition, conditionType, cases, cppDef, label), TCppVoid - ) - - | TTry (try_block,catches) -> - (* TTry internal return - wrap whole thing in block ? *) - if return_type<>TCppVoid then - abort "Value from a try-block not handled" expr.epos; - let cppBlock = retype TCppVoid try_block in - let cppCatches = List.map (fun (tvar,catch_block) -> - let old_declarations = Hashtbl.copy !declarations in - Hashtbl.add !declarations tvar.v_name (); - let cppCatchBlock = retype TCppVoid catch_block in - declarations := old_declarations; - tvar, cppCatchBlock; - ) catches in - CppTry(cppBlock, cppCatches), TCppVoid - - | TReturn eo -> - CppReturn(match eo with None -> None | Some e -> Some (retype (!function_return_type) e)), TCppVoid - - | TCast (base,None) -> (* Use auto-cast rules *) - let return_type = cpp_type_of expr.etype in - let baseCpp = retype (return_type) base in - let baseStr = (tcpp_to_string baseCpp.cpptype) in - let returnStr = (tcpp_to_string return_type) in - if baseStr=returnStr then - baseCpp.cppexpr, baseCpp.cpptype (* nothing to do *) - else (match return_type with - | TCppObjC(k) -> CppCastObjC(baseCpp,k), return_type - | TCppPointer(_,_) - | TCppRawPointer(_,_) - | TCppStar(_) - | TCppInst(_) -> CppCast(baseCpp,return_type), return_type - | TCppString -> CppCastScalar(baseCpp,"::String"), return_type - | TCppCode(t) when baseStr <> (tcpp_to_string t) -> - CppCast(baseCpp, t), t - | TCppNativePointer(klass) -> CppCastNative(baseCpp), return_type - | TCppObjCBlock(args,ret) -> CppCastObjCBlock(baseCpp,args,ret), return_type - | TCppProtocol(p) -> CppCastProtocol(baseCpp,p), return_type - | TCppDynamic when baseCpp.cpptype=TCppClass -> CppCast(baseCpp,TCppDynamic), TCppDynamic - | _ -> baseCpp.cppexpr, baseCpp.cpptype (* use autocasting rules *) - ) - - | TCast (base,Some t) -> - let baseCpp = retype (cpp_type_of base.etype) base in - let baseStr = (tcpp_to_string baseCpp.cpptype) in - let default_return_type = if return_type=TCppUnchanged then cpp_type_of expr.etype else return_type in - let return_type = cpp_type_from_path ctx (t_path t) [] (fun () -> default_return_type ) in - let returnStr = (tcpp_to_string return_type) in - - if baseStr=returnStr then - baseCpp.cppexpr, baseCpp.cpptype (* nothing to do *) - else (match return_type with - | TCppNativePointer(klass) -> CppCastNative(baseCpp), return_type - | TCppVoid -> - CppTCast(baseCpp, cpp_type_of expr.etype), return_type - | TCppDynamic -> - baseCpp.cppexpr, baseCpp.cpptype - | _ -> - CppTCast(baseCpp, return_type), return_type - ) - in - let cppExpr = mk_cppexpr retypedExpr retypedType in - - (* Autocast rules... *) - if return_type=TCppVoid then - mk_cppexpr retypedExpr TCppVoid - else if return_type=TCppVarArg then begin - match cpp_variant_type_of cppExpr.cpptype with - | TCppVoidStar - | TCppScalar _ -> cppExpr - | TCppString -> mk_cppexpr (CppVar(VarInternal(cppExpr,".","raw_ptr()"))) (TCppPointer("ConstPointer", TCppScalar("char"))) - | TCppDynamic -> mk_cppexpr (CppCastNative(cppExpr)) TCppVoidStar - | _ -> let toDynamic = mk_cppexpr (CppCast(cppExpr, TCppDynamic)) TCppDynamic in - mk_cppexpr (CppCastNative(toDynamic)) TCppVoidStar - end else if (cppExpr.cpptype=TCppVariant || cppExpr.cpptype=TCppDynamic || cppExpr.cpptype==TCppObject) then begin - match return_type with - | TCppUnchanged -> cppExpr - | TCppInst(t, _) when (has_meta_key t.cl_meta Meta.StructAccess) -> - let structType = TCppStruct( TCppInst(t, []) ) in - let structCast = mk_cppexpr (CppCast(cppExpr,structType)) structType in - mk_cppexpr (CppCast(structCast,(TCppInst (t, [])))) (TCppInst (t, [])) - - | TCppObjectArray _ - | TCppScalarArray _ - | TCppNativePointer _ - | TCppDynamicArray - | TCppObjectPtr - | TCppVarArg - | TCppInst _ - -> mk_cppexpr (CppCast(cppExpr,return_type)) return_type - - | TCppObjC k - -> mk_cppexpr (CppCastObjC(cppExpr,k)) return_type - - | TCppObjCBlock(ret,args) - -> mk_cppexpr (CppCastObjCBlock(cppExpr,ret,args)) return_type - - | TCppScalar(scalar) - -> mk_cppexpr (CppCastScalar(cppExpr,scalar)) return_type - - | TCppString - -> mk_cppexpr (CppCastScalar(cppExpr,"::String")) return_type - - | TCppInterface _ when cppExpr.cpptype=TCppVariant - -> mk_cppexpr (CppCastVariant(cppExpr)) return_type - - | TCppDynamic when cppExpr.cpptype=TCppVariant - -> mk_cppexpr (CppCastVariant(cppExpr)) return_type - - | TCppStar(t,const) -> - let ptrType = TCppPointer((if const then "ConstPointer" else "Pointer"),t) in - let ptrCast = mk_cppexpr (CppCast(cppExpr,ptrType)) ptrType in - mk_cppexpr (CppCast(ptrCast,TCppStar(t,const))) (TCppStar(t,const)) - - | _ -> cppExpr - end else match cppExpr.cpptype, return_type with - | _, TCppUnchanged -> cppExpr - (* - Using the 'typedef hack', where we use typedef X = T, allows the - haxe compiler to use these types interchangeably. We then work - out the correct way to convert between them when one is expected, but another provided. - - TCppFunction: these do not really interact with the haxe function type, T - Since they are implemented with cpp::Function, conversion to/from Dynamic should happen automatically - CallableData = T; - FunctionData = T; - - TCppObjCBlock can move in and out of Dyanmic - ObjcBlock = T; - - TCppProtocol can move in and out of Dyanmic, via delegate creation - Protocol = T; - - Explicitly wrapped type - already interacts well with Dynamic and T - Struct = T; - - TCppStar, TCppStruct, TCppReference - for interacting with native code - Star = T; - ConstStar = T; - Reference = T; - T may be an extern class, with @:structAccess - in which case - Dynamic interaction must be handled explicitly - These types, plus Dynamic can be used interchangeably by haxe - Derived/inherited types may also be mixed in - *) - | TCppAutoCast, _ - | TCppObjC(_), TCppDynamic - | TCppObjCBlock(_), TCppDynamic - -> mk_cppexpr (CppCast(cppExpr,return_type)) return_type - - (* Infer type from right-hand-side for pointer or reference to Dynamic *) - | TCppReference(TCppDynamic), TCppReference(_) -> cppExpr - | TCppReference(TCppDynamic), t -> - mk_cppexpr retypedExpr (TCppReference(t)) - | TCppStar(TCppDynamic,_), TCppStar(_,_) -> cppExpr - | TCppStar(TCppDynamic,const), t -> - mk_cppexpr retypedExpr (TCppStar(t,const)) - - | TCppStar(t,const), TCppDynamic -> - let ptrType = TCppPointer((if const then "ConstPointer" else "Pointer"),t) in - let ptrCast = mk_cppexpr (CppCast(cppExpr,ptrType)) ptrType in - mk_cppexpr (CppCast(ptrCast,TCppDynamic)) TCppDynamic - - | TCppStar(t,const), TCppReference _ - | TCppStar(t,const), TCppInst _ - | TCppStar(t,const), TCppStruct _ -> - mk_cppexpr (CppDereference(cppExpr)) return_type - - | TCppInst(t, _), TCppStar _ when (is_native_class t) && (match cppExpr.cppexpr with - | CppCall(FuncNew(_), _) -> true - | _ -> false) -> - mk_cppexpr (CppNewNative(cppExpr)) return_type - - | TCppInst _, TCppStar(p,const) - | TCppStruct _, TCppStar(p,const) -> - mk_cppexpr (CppAddressOf(cppExpr)) return_type - - | TCppObjectPtr, TCppObjectPtr -> cppExpr - | TCppObjectPtr, _ -> - mk_cppexpr (CppCast(cppExpr,TCppDynamic)) TCppDynamic - - | TCppProtocol _, TCppProtocol _ -> cppExpr - | t, TCppProtocol protocol -> - mk_cppexpr (CppCastProtocol(cppExpr,protocol)) return_type - - | TCppInst(t, _), TCppDynamic when (has_meta_key t.cl_meta Meta.StructAccess) -> - let structType = TCppStruct( TCppInst(t, []) ) in - let structCast = mk_cppexpr (CppCast(cppExpr,structType)) structType in - mk_cppexpr (CppCast(structCast,TCppDynamic)) TCppDynamic - - | _, TCppObjectPtr -> - mk_cppexpr (CppCast(cppExpr,TCppObjectPtr)) TCppObjectPtr - - | TCppDynamicArray, TCppScalarArray _ - | TCppDynamicArray, TCppObjectArray _ - | TCppScalarArray _, TCppDynamicArray - | TCppObjectArray _, TCppDynamicArray when forCppia -> - mk_cppexpr (CppCast(cppExpr,return_type)) return_type - | TCppScalar(from), TCppScalar(too) when from<>too -> - mk_cppexpr (CppCastScalar(cppExpr,too)) return_type - - | _ -> cppExpr - in - retype request_type expression_tree -;; - -type tinject = { - inj_prologue : bool -> unit; - inj_setvar : string; - inj_tail : string; -} - -let mk_injection prologue set_var tail = - Some { inj_prologue=prologue; inj_setvar=set_var; inj_tail=tail } -;; - - -let cpp_arg_type_name ctx tvar default_val prefix = - let remap_name = (cpp_var_name_of tvar) in - let type_str = (cpp_var_type_of ctx tvar) in - match default_val with - | Some {eexpr = TConst TNull} -> (tcpp_to_string (cpp_type_of_null ctx tvar.v_type)),remap_name - | Some constant -> (tcpp_to_string (cpp_type_of_null ctx tvar.v_type)),prefix ^ remap_name - | _ -> type_str,remap_name -;; - - - -let string_of_path path = - "::" ^ (join_class_path_remap path "::") ^ "_obj" -;; - -let default_value_string ctx value = -match value.eexpr with - | TConst (TInt i) -> Printf.sprintf "%ld" i - | TConst (TFloat float_as_string) -> "((Float)" ^ (replace_float_separators float_as_string) ^ ")" - | TConst (TString s) -> strq ctx s - | TConst (TBool b) -> (if b then "true" else "false") - | TConst TNull -> "null()" - | TField (_, FEnum(enum,field) ) -> (string_of_path enum.e_path) ^ "::" ^ (cpp_enum_name_of field) ^ "_dyn()" - | _ -> "/* Hmmm " ^ (s_expr_kind value) ^ " */" -;; - - - -let cpp_gen_default_values ctx args prefix = - List.iter ( fun (tvar,o) -> - let vtype = cpp_type_of ctx tvar.v_type in - let not_null = (type_has_meta_key tvar.v_type Meta.NotNull) || (is_cpp_scalar vtype) in - match o with - | Some {eexpr = TConst TNull} -> () - | Some const -> - let name = cpp_var_name_of tvar in - let spacer = if (ctx.ctx_debug_level>0) then " \t" else "" in - let pname = prefix ^ name in - ctx.ctx_output ( spacer ^ "\t" ^ (tcpp_to_string vtype) ^ " " ^ name ^ " = " ^ pname ); - ctx.ctx_output ( if not_null then - ".Default(" ^ (default_value_string ctx.ctx_common const) ^ ");\n" - else - ";\n" ^ spacer ^ "\tif (::hx::IsNull(" ^ pname ^ ")) " ^ name ^ " = " ^ (default_value_string ctx.ctx_common const) ^ ";\n" - ); - | _ -> () - ) args; -;; - -let ctx_default_values ctx args prefix = - cpp_gen_default_values ctx args prefix -;; - -let cpp_class_hash interface = - gen_hash 0 (join_class_path interface.cl_path "::" ) -;; - - -let rec is_constant_zero expr = - match expr.cppexpr with - | CppFloat x when (float_of_string x) = 0.0 -> true - | CppInt i when i = Int32.zero -> true - | CppCastScalar(expr,_) -> is_constant_zero(expr) - | _ -> false -;; - -let cpp_is_const_scalar_array arrayType expressions = - List.length expressions>0 && (match arrayType with - | TCppScalarArray _ -> - List.for_all (fun expr -> match expr.cppexpr with - | CppInt _ | CppFloat _ | CppString _ | CppBool _ -> true - | _ -> false - ) expressions - | _ -> false) -;; - - - -(* Generate prototype text, including allowing default values to be null *) -let cpp_arg_string ctx tvar default_val prefix = - let t,n = cpp_arg_type_name ctx tvar default_val prefix in - t ^ " " ^ n -;; - -let cpp_arg_list ctx args prefix = - String.concat "," (List.map (fun (v,o) -> (cpp_arg_string ctx v o prefix) ) args) -;; - - -let gen_type ctx haxe_type = - ctx.ctx_output (ctx_type_string ctx haxe_type) -;; - - - - - -let rec implements_native_interface class_def = - List.exists (fun (intf_def,_) -> - is_native_gen_class intf_def || - implements_native_interface intf_def - ) class_def.cl_implements || - (match class_def.cl_super with - | Some (i,_) -> implements_native_interface i - | _ -> false ) -;; - -let can_quick_alloc klass = - (not (is_native_class klass)) && (not (implements_native_interface klass)) -;; - - -let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_type injection tree = - let writer = ctx.ctx_writer in - let out = ctx.ctx_output in - let lastLine = ref (-1) in - let tempId = ref 0 in - let strq = strq ctx.ctx_common in - - let spacer = if (ctx.ctx_debug_level>0) then " \t" else "" in - let output_i value = out spacer; writer#write_i value in - - let output_p expr value = - if (ctx.ctx_debug_level>0) then begin - let line = Lexer.get_error_line expr.cpppos in - let lineName = Printf.sprintf "%4d" line in - let macro = if (line != !lastLine) then "HXLINE" else "HXDLIN" in - out (macro ^ "(" ^ lineName ^ ")\t" ); - lastLine := line; - end; - writer#write_i value - in - - let forInjection = match injection with Some inject -> inject.inj_setvar<>"" | _ -> false in - - let cppTree = retype_expression ctx TCppVoid function_args function_type tree forInjection in - let label_name i = Printf.sprintf "_hx_goto_%i" i in - let class_hash = gen_hash_small 0 class_name in - (*let genGc = Common.defined ctx.ctx_common Define.HxcppGcGenerational in*) - - let rec gen_with_injection injection expr new_line = - (match expr.cppexpr with - | CppBlock(exprs,closures,gc_stack) -> - writer#begin_block; - List.iter gen_closure closures; - (match injection with Some inject -> inject.inj_prologue gc_stack | _ -> () ); - let remaining = ref (List.length exprs) in - lastLine := Lexer.get_error_line tree.epos; - List.iter (fun e -> - output_p e ""; - if (!remaining=1) then - (match injection with Some inject -> out inject.inj_setvar | _ -> () ); - gen e; - decr remaining; - writer#terminate_line; - ) exprs; - (match injection with Some inject -> out inject.inj_tail | _ -> () ); - out spacer; - if new_line then writer#end_block else writer#end_block_line; - - | CppInt i -> out (Printf.sprintf (if i> Int32.of_int(-1000000000) && i< Int32.of_int(1000000000) then "%ld" else "(int)%ld") i) - | CppFloat float_as_string -> out ("((Float)" ^ float_as_string ^")") - | CppString s -> out (strq s) - | CppBool b -> out (if b then "true" else "false") - | CppNull -> out "null()" - | CppNil -> out "nil" - - | CppThis ThisReal -> out "::hx::ObjectPtr(this)" - | CppThis _ -> out "__this" - - | CppSuper thiscall -> - out ("::hx::ObjectPtr(" ^ (if thiscall=ThisReal then "this" else "__this.mPtr") ^ ")") - - | CppBreak -> out "break" - | CppContinue -> out "continue" - | CppGoto label -> out ("goto " ^ (label_name label)); - - | CppVarDecl(var,init) -> - let name = cpp_var_name_of var in - if cpp_no_debug_synbol ctx var then - out ( (cpp_var_type_of ctx var) ^ " " ^ name ) - else begin - let dbgName = cpp_var_debug_name_of var in - let macro = if init=None then "HX_VAR" else "HX_VARI" in - let varType = cpp_macro_var_type_of ctx var in - if name<>dbgName then - out ( macro ^ "_NAME( " ^ varType ^ "," ^ name ^ ",\"" ^ dbgName ^ "\")" ) - else - out ( macro ^ "( " ^ varType ^ "," ^ name ^ ")"); - end; - (match init with Some init -> out " = "; gen init | _ -> () ); - - | CppEnumIndex(obj) -> - gen obj; - if cpp_is_dynamic_type obj.cpptype then - out ".StaticCast< ::hx::EnumBase >()"; - out "->_hx_getIndex()" - - | CppNullAccess -> out ("::hx::Throw(" ^ strq "Null access" ^ ")") - | CppFunction(func,_) -> - (match func with - | FuncThis(field,_) -> - out ("this->" ^ (cpp_member_name_of field) ^ "_dyn()"); - | FuncInstance(expr,inst,field) -> - gen expr; out ((if expr.cpptype=TCppString || inst=InstStruct then "." else "->") ^ (cpp_member_name_of field) ^ "_dyn()"); - | FuncInterface(expr,_,field) -> - gen expr; - out ("->__Field(" ^ strq field.cf_name ^ ", ::hx::paccDynamic)") - | FuncStatic(clazz,_,field) -> - let rename = get_meta_string field.cf_meta Meta.Native in - if rename<>"" then - out rename - else - (out (cpp_class_name clazz); out ("::" ^ (cpp_member_name_of field) ^ "_dyn()")) - | FuncExpression(expr) -> - gen expr; - | FuncExtern(name, isGlobal) -> - if isGlobal then out " ::"; - out name; - | FuncInternal(expr,name,_) -> - gen expr; out ("->__Field(" ^ (strq name) ^ ",::hx::paccDynamic)") - | FuncSuper _ | FuncSuperConstruct _ -> abort "Can't create super closure" expr.cpppos - | FuncNew _ -> abort "Can't create new closure" expr.cpppos - | FuncEnumConstruct _ -> abort "Enum constructor outside of CppCall" expr.cpppos - | FuncFromStaticFunction -> abort "Can't create cpp.Function.fromStaticFunction closure" expr.cpppos - | FuncTemplate _ -> abort "Can't create template function closure" expr.cpppos - ); - | CppCall( FuncInterface(expr,clazz,field), args) when not (is_native_gen_class clazz)-> - out ( cpp_class_name clazz ^ "::" ^ cpp_member_name_of field ^ "("); - gen expr; - List.iter (fun arg -> out ","; gen arg ) args; - out ")"; - - | CppCall(FuncStatic(_,true,field) as func, arg_list) - | CppCall(FuncInstance(_,InstObjC,field) as func, arg_list) -> - out "[ "; - (match func with - | FuncStatic(cl,_,_) -> out (join_class_path_remap cl.cl_path "::") - | FuncInstance(expr,_,_) -> gen expr - | _ ->() ); - - let names = ExtString.String.nsplit field.cf_name ":" in - let field_name, arg_names = match names with - | name :: args -> name, args - | _ -> die "" __LOC__ (* per nsplit specs, this should never happen *) - in - out (" " ^ field_name); - (try match arg_list, arg_names with - | [], _ -> () - | [single_arg], _ -> out ": "; gen single_arg - | first_arg :: args, arg_names -> - out ": "; - gen first_arg; - List.iter2 (fun arg arg_name -> - out (" " ^ arg_name ^ ": "); - gen arg) args arg_names - with | Invalid_argument _ -> (* not all arguments names are known *) - abort ( - "The function called here with name " ^ (String.concat ":" names) ^ - " does not contain the right amount of arguments' names as required" ^ - " by the objective-c calling / naming convention:" ^ - " expected " ^ (string_of_int (List.length arg_list)) ^ - " and found " ^ (string_of_int (List.length arg_names))) - expr.cpppos); - out " ]" - - | CppCall(FuncNew( TCppInst (klass, p)), args) when can_quick_alloc klass -> - out ((cpp_class_path_of klass p) ^ "_obj::__alloc( HX_CTX "); - List.iter (fun arg -> out ","; gen arg ) args; - out (")") - - | CppCall(func, args) -> - let doCall = ref true in - let closeCall = ref "" in - let argsRef = ref args in - (match func with - | FuncThis(field,_) -> - out ("this->" ^ (cpp_member_name_of field) ); - | FuncInstance(expr,inst,field) -> - let operator = if (expr.cpptype = TCppString || inst=InstStruct) then "." else "->" in - gen expr; out (operator ^ (cpp_member_name_of field) ); - | FuncInterface(expr,_,field) -> - gen expr; out ("->" ^ (cpp_member_name_of field) ); - | FuncStatic(clazz,false,field) when cpp_is_static_extension ctx field -> - (match args with - | fst :: remaining -> - argsRef := remaining; - gen fst; out ("->" ^ (cpp_member_name_of field) ); - | _ -> abort "Native static extensions must have at least 1 argument" expr.cpppos - ); - - | FuncStatic(clazz,_,field) -> - let rename = get_meta_string field.cf_meta Meta.Native in - if rename<>"" then begin - (* This is the case if you use @:native('new foo'). c++ wil group the space undesirably *) - if String.contains rename ' ' then begin - out "("; - closeCall := ")" - end; - out rename - end else - (out (cpp_class_name clazz); out ("::" ^ (cpp_member_name_of field) )) - - | FuncTemplate(clazz,field,tpath,native) -> - let rename = get_meta_string field.cf_meta Meta.Native in - if rename<>"" then begin - (* This is the case if you use @:native('new foo'). c++ wil group the space undesirably *) - if String.contains rename ' ' then begin - out "("; - closeCall := ")" - end; - out rename - end else - (out (cpp_class_name clazz); out ("::" ^ (cpp_member_name_of field) )); - out ("< " ^ (cpp_template_param tpath native) ^ " >") - - | FuncFromStaticFunction -> - abort "Unexpected FuncFromStaticFunction" expr.cpppos - | FuncEnumConstruct(enum,field) -> - out ((string_of_path enum.e_path) ^ "::" ^ (cpp_enum_name_of field)); - - | FuncSuperConstruct(TCppInst (klass, _)) when is_native_class klass -> - doCall := false; - - | FuncSuperConstruct _ -> - out ((if not ctx.ctx_real_this_ptr then "__this->" else "") ^ "super::__construct") - - | FuncSuper(_,TCppInst(klass, p),field) when is_native_class klass -> - out ((cpp_class_path_of klass p) ^ "::" ^ (cpp_member_name_of field)); - - | FuncSuper(this,_,field) -> - out ( (if this==ThisReal then "this->" else "__->") ^ "super::" ^ (cpp_member_name_of field) ) - - | FuncNew(newType) -> - let objName = match newType with - | TCppString -> "::String" - | TCppDynamicArray -> "::cpp::VirtualArray_obj::__new" - | TCppObjectArray _ -> "::Array_obj< ::Dynamic>::__new" - | TCppScalarArray(value) -> "::Array_obj< " ^ (tcpp_to_string value) ^ " >::__new" - | TCppObjC klass -> (cpp_class_path_of klass []) ^ "_obj::__new" - | TCppNativePointer klass -> "new " ^ (cpp_class_path_of klass []); - | TCppInst (klass, p) when is_native_class klass -> cpp_class_path_of klass p - | TCppInst (klass, p) -> (cpp_class_path_of klass p) ^ "_obj::__new" - | TCppClass -> "::hx::Class_obj::__new"; - | TCppFunction _ -> tcpp_to_string newType - | _ -> abort ("Unknown 'new' target " ^ (tcpp_to_string newType)) expr.cpppos - in - out objName - - | FuncInternal(func,name,join) -> - gen func; out (join ^ name); - - | FuncExtern(name, isGlobal) -> - if isGlobal then out " ::"; - out name; - | FuncExpression(expr) -> - gen expr; - ); - if !doCall then begin - let sep = ref "" in - out "("; - List.iter (fun arg -> - out !sep; sep := ","; - gen arg; - ) !argsRef; - out (")" ^ !closeCall); - end - | CppNewNative(e) -> - out "new "; gen e; - | CppAddressOf(e) -> - out ("&("); gen e; out ")"; - | CppDereference(e) -> - out ("(*("); gen e; out "))"; - | CppFunctionAddress(klass, member) -> - let signature = ctx_function_signature ctx false member.cf_type "" in - let name = cpp_member_name_of member in - (*let void_cast = has_meta_key field.cf_meta Meta.Void in*) - out ("::cpp::Function< " ^ signature ^">(::hx::AnyCast("); - out ("&::" ^(join_class_path_remap klass.cl_path "::")^ "_obj::" ^ name ); - out " ))" - - | CppExtern(name,isGlobal) -> - if isGlobal then out " ::"; - out name; - - | CppDynamicField(obj,name) -> - gen obj; - out ("->__Field(" ^ (strq name) ^ ",::hx::paccDynamic)"); - - | CppArray(arrayLoc) -> (match arrayLoc with - | ArrayTyped(arrayObj,index,_) -> - gen arrayObj; out "->__get("; gen index; out ")" - - | ArrayPointer(arrayObj,index) -> - gen arrayObj; out ".ptr["; gen index; out "]" - - | ArrayRawPointer(arrayObj,index) -> - gen arrayObj; out "["; gen index; out "]" - - | ArrayObject(arrayObj,index,elem) -> - let close = if cpp_is_dynamic_type elem then - "" - else if elem=TCppDynamicArray then begin - out (tcpp_to_string elem ^ "( "); ")" - end else - ".StaticCast< " ^ tcpp_to_string elem ^ " >()" - in - gen arrayObj; out "->__get("; gen index; out (")" ^ close); - - | ArrayVirtual(arrayObj,index) -> - gen arrayObj; out "->__get("; gen index; out ")"; - - | ArrayDynamic(arrayObj,index) -> - gen arrayObj; out "->__GetItem("; gen index; out ")" - - | ArrayImplements(_,arrayObj,index) -> - gen arrayObj; out "->__get("; gen index; out ")"; - ) - - - | CppSet(lvalue,rvalue) -> - let close = if expr.cpptype=TCppVoid then "" else (out "("; ")" ) in - (match lvalue with - | CppVarRef( VarClosure(var)) when is_gc_element ctx (cpp_type_of ctx var.v_type) -> - out ("this->_hx_set_" ^ (cpp_var_name_of var) ^ "(HX_CTX, "); gen rvalue; out ")" - - | CppVarRef( VarThis(member,_)) when is_gc_element ctx (cpp_type_of ctx member.cf_type) -> - out ("this->_hx_set_" ^ (cpp_member_name_of member) ^ "(HX_CTX, "); gen rvalue; out ")" - - | CppVarRef( VarInstance(obj,member,_,"->")) when is_gc_element ctx (cpp_type_of ctx member.cf_type) -> - gen obj; out ("->_hx_set_" ^ (cpp_member_name_of member) ^ "(HX_CTX, "); gen rvalue; out ")" - | CppVarRef( VarInternal(obj,operator,member) ) -> - gen obj; out (operator ^ member) - - | CppVarRef varLoc -> - gen_val_loc varLoc true; out " = "; gen rvalue; - - - | CppArrayRef arrayLoc -> (match arrayLoc with - | ArrayObject(arrayObj, index, _) when (is_gc_element ctx TCppDynamic) -> - gen arrayObj; out "->setCtx( HX_CTX, "; gen index; out ","; gen rvalue; out ")" - | ArrayTyped(arrayObj, index, t) when (is_gc_element ctx t) -> - gen arrayObj; out "->setCtx( HX_CTX, "; gen index; out ","; gen rvalue; out ")" - | ArrayObject(arrayObj, index, _) - | ArrayTyped(arrayObj, index, _) - | ArrayRawPointer(arrayObj, index) -> - gen arrayObj; out "["; gen index; out "] = "; gen rvalue - | ArrayPointer(arrayObj, index) -> - gen arrayObj; out ".ptr["; gen index; out "] = "; gen rvalue - | ArrayVirtual(arrayObj, index) -> - gen arrayObj; out "->set("; gen index; out ","; gen rvalue; out ")" - - | ArrayDynamic(arrayObj, index) -> - gen arrayObj; out "->__SetItem("; gen index; out ","; gen rvalue; out ")" - - | ArrayImplements(_,arrayObj,index) -> - gen arrayObj; out "->__set("; gen index; out ","; gen rvalue; out ")" - ) - | CppDynamicRef(expr,name) -> - gen expr; out ("->__SetField(" ^ (strq name) ^ ","); gen rvalue; out ",::hx::paccDynamic)" - | CppExternRef(name, isGlobal) -> if isGlobal then out " ::"; out (name ^ " = "); - ); - out close; - - | CppCrement(incFlag,preFlag, lvalue) -> - let op = if incFlag==CppIncrement then "++" else "--" in - if (preFlag==Prefix) then out op; - gen_lvalue lvalue; - if (preFlag==Postfix) then out op - - | CppModify(op,lvalue,rvalue) -> - out (string_of_op_eq op expr.cpppos); - out "("; gen_lvalue lvalue; out ","; gen rvalue; out ")" - - | CppPosition(name,line,clazz,func) -> - out ("::hx::SourceInfo(" ^ strq name ^ "," ^ string_of_int(Int32.to_int line) ^ "," ^ strq clazz ^ "," ^ strq func ^ ")") - - | CppClassOf (path,native) -> - let path = "::" ^ (join_class_path_remap (path) "::" ) in - let path = match path with - | "::Int" -> "int" - | "::Bool" -> "bool" - | x -> x in - if (native) then - out "null()" - else if (path="::Array") then - out "::hx::ArrayBase::__mClass" - else - out ("::hx::ClassOf< " ^ path ^ " >()") - - | CppVar(loc) -> - gen_val_loc loc false; - - - | CppClosure closure -> - out (" ::Dynamic(new _hx_Closure_" ^ (string_of_int(closure.close_id)) ^ "("); - let separator = ref "" in - (match closure.close_this with - | Some this -> - out (if this=ThisReal then "this" else "__this"); - separator := ","; - | _ -> () ); - - Hashtbl.iter (fun name value -> - out !separator; separator := ","; - out (keyword_remap name) - ) closure.close_undeclared; - out "))"; - - | CppObjectDecl (values,isStruct) -> - let length = List.length values in - let lengthStr = string_of_int length in - if (expr.cpptype!=TCppVoid) then out " ::Dynamic("; - if (isStruct) && length>0 && length<=5 then begin - out ("::hx::AnonStruct" ^ lengthStr ^"_obj< " ^ - (String.concat "," (List.map (fun (_,value) -> tcpp_to_string value.cpptype) values) ) ^ - " >::Create(" ); - let sep = ref "" in - List.iter (fun (name,value) -> out (!sep ^ (strq name) ^ "," ); sep:=","; gen value ) values; - out ")"; - end else begin - out ("::hx::Anon_obj::Create(" ^ lengthStr ^")"); - let sorted = List.sort (fun (_,_,h0) (_,_,h1) -> Int32.compare h0 h1 ) - (List.map (fun (name,value) -> name,value,(gen_hash32 0 name ) ) values) in - writer#push_indent; - ExtList.List.iteri (fun idx (name,value,_) -> - out ("\n" ^ spacer); writer#write_i ("->setFixed(" ^ (string_of_int idx) ^ "," ^ (strq name) ^ ","); gen value; out ")"; - ) sorted; - end; - if (expr.cpptype!=TCppVoid) then out ")"; - writer#pop_indent; - - | CppArrayDecl(exprList) when cpp_is_const_scalar_array expr.cpptype exprList -> - let arrayType = match expr.cpptype with TCppScalarArray(value) -> value | _ -> assert false in - let typeName = tcpp_to_string arrayType in - incr ctx.ctx_file_id; - - let id = "_hx_array_data_" ^ class_hash ^ "_" ^ string_of_int( !(ctx.ctx_file_id) ) in - - let out_top = ctx.ctx_writer#write_h in - out_top ("static const " ^ typeName ^ " " ^ id ^ "[] = {\n\t"); - List.iter (fun expr -> match expr.cppexpr with - | CppInt i -> out_top (Printf.sprintf "(%s)%ld," typeName i) - | CppFloat f -> out_top ( f ^ "," ) - | CppString s -> out_top ( (strq s) ^ "," ) - | CppBool b -> out_top (if b then "1," else "0,") - | _ -> die "" __LOC__ - ) exprList; - out_top ("\n};\n"); - out ("::Array_obj< " ^ typeName ^ " >::fromData( " ^ id ^ "," ^ list_num exprList ^ ")"); - - | CppArrayDecl(exprList) -> - let count = List.length exprList in - let countStr = string_of_int count in - let arrayType,close = match expr.cpptype with - | TCppObjectArray _ -> "::Array_obj< ::Dynamic>","" - | TCppScalarArray(value) -> "::Array_obj< " ^ (tcpp_to_string value) ^ " >","" - | TCppDynamicArray -> "::cpp::VirtualArray_obj","" - | _ -> " ::Dynamic( ::cpp::VirtualArray_obj",")" - in - out (arrayType ^ "::__new(" ^ countStr ^ ")" ); - ExtList.List.iteri ( fun idx elem -> out ("->init(" ^ (string_of_int idx) ^ ","); - gen elem; out ")" ) exprList; - out close; - - - | CppBinop( Ast.OpUShr, left, right) -> - out "::hx::UShr("; gen left; out ","; gen right; out ")"; - - | CppBinop( Ast.OpMod, left, right) -> - if is_constant_zero right then begin - out "::hx::Mod("; gen left; out ",(double)( "; gen right; out " ))"; - end else begin - out "::hx::Mod("; gen left; out ","; gen right; out ")"; - end - - | CppBinop( Ast.OpDiv, left, right) when is_constant_zero right -> - out "::hx::DivByZero("; gen left; out ")"; - - | CppBinop(op, left, right) -> - let op = string_of_op op expr.cpppos in - out "("; - gen left; - out (" " ^ op ^ " "); - gen right; - out ")"; - | CppCompare(opName, left, right, _) -> - out ("::hx::" ^ opName ^ "( "); - gen left; - out (","); - gen right; - out (" )"); - | CppNullCompare(op, left) -> - out ("::hx::" ^ op ^ "( "); gen left; out (" )"); - - | CppThrow(value) -> - out "HX_STACK_DO_THROW("; gen value; out ")"; - - | CppReturn None -> out "return"; - | CppReturn Some value -> out "return "; gen value; - - | CppEnumField(enum,field) -> - out ((string_of_path enum.e_path) ^ "::" ^ (cpp_enum_name_of field) ^ "_dyn()" ); - - | CppEnumParameter(obj,field,index) -> - let valueType = cpp_type_of ctx (get_nth_type field index) in - let baseType = enum_getter_type valueType in - gen obj; - if cpp_is_dynamic_type obj.cpptype then - out ".StaticCast< ::hx::EnumBase >()"; - out ( "->_hx_get" ^ baseType ^ "(" ^ (string_of_int index) ^ ")"); - (match valueType with - | TCppObjectArray _ - | TCppScalarArray _ - | TCppDynamicArray - | TCppClass - | TCppEnum _ - | TCppInst _ -> out (".StaticCast< " ^ (tcpp_to_string valueType ) ^ " >()") - | _ ->() - ) - - | CppIntSwitch(condition, cases, defVal) -> - out "switch((int)("; gen condition; out "))"; - writer#begin_block; - List.iter (fun (values,expr) -> - out spacer; writer#write_i ""; - List.iter (fun value -> out ("case (int)" ^ (Printf.sprintf "%ld" value) ^ ": " ) ) values; - gen expr; - out spacer; writer#write_i "break;\n"; - ) cases; - (match defVal with - | Some expr -> output_i "default:"; gen expr; | _ -> () ); - out spacer; - writer#end_block; - | CppSwitch(condition, conditionType, cases, optional_default, label) -> - let tmp_name = "_hx_switch_" ^ (string_of_int !tempId) in - incr tempId; - out ( (tcpp_to_string conditionType) ^ " " ^ tmp_name ^ " = " ); - gen condition; - out ";\n"; - List.iter (fun (cases,expression) -> - output_i "if ( "; - let or_str = ref "" in - List.iter (fun value -> - out (!or_str ^ " (" ^ tmp_name ^ "=="); gen value; out ")"; - or_str := " || "; - ) cases; - out (" )"); - gen expression; - ) cases; - (match optional_default with | None -> () - | Some default -> - output_i "/* default */"; - gen default; - ); - output_i ((label_name label) ^ ":") - - | CppUnop(unop,value) -> - out (match unop with - | CppNot -> "!" - | CppNeg -> "-" - | CppNegBits -> "~" - ); - out "("; gen value; out ")" - - | CppWhile(condition, block, while_flag, loop_id) -> - (match while_flag with - | NormalWhile -> - out "while("; gen condition; out (")"); - lastLine := -1; - gen block; - | DoWhile -> - out ("do "); - lastLine := -1; - gen_with_injection None block false; - out " while("; gen condition; out ");\n" - ); - if loop_id > -1 then output_i ((label_name loop_id) ^ ":"); - - | CppIf (condition,block,None) -> - out "if ("; gen condition; out (") "); - gen block; - - | CppIf (condition,block,Some elze) when expr.cpptype = TCppVoid -> - out "if ("; gen condition; out (") "); - gen block; - output_i ("else "); - gen elze; - - | CppIf (condition,block,Some elze) -> - gen condition; out " ? "; gen block; out " : "; gen elze; - - | CppFor (tvar, init, loop) -> - let varType = cpp_var_type_of ctx tvar in - out ("for(::cpp::FastIterator_obj< " ^ varType ^ - " > *__it = ::cpp::CreateFastIterator< "^ varType ^ " >("); - gen init; - out ("); __it->hasNext(); )"); - let prologue = fun _ -> - output_i ( varType ^ " " ^ (cpp_var_name_of tvar) ^ " = __it->next();\n" ); - in - gen_with_injection (mk_injection prologue "" "") loop true; - - - | CppTry(block,catches) -> - let prologue = function _ -> - ExtList.List.iteri (fun idx (v,_) -> - output_i ("HX_STACK_CATCHABLE(" ^ cpp_macro_var_type_of ctx v ^ ", " ^ string_of_int idx ^ ");\n") - ) catches - in - out ("try "); - gen_with_injection (mk_injection prologue "" "" ) block (List.length catches < 0); - if (List.length catches > 0 ) then begin - out " catch( ::Dynamic _hx_e) "; - writer#begin_block; - - let seen_dynamic = ref false in - let else_str = ref "" in - List.iter (fun (v,catch) -> - let type_name = cpp_var_type_of ctx v in - (match cpp_type_of ctx v.v_type with - | TCppInterface(klass) -> - let hash = (cpp_class_hash klass) in - output_i (!else_str ^ "if (::hx::TIsInterface< (int)" ^ hash ^ " >(_hx_e.mPtr))") - | TCppString -> - output_i (!else_str ^ "if (_hx_e.IsClass< ::String >() && _hx_e->toString()!=null() )"); - | _ -> - if (type_name="Dynamic") then begin - seen_dynamic := true; - output_i !else_str; - end else - output_i (!else_str ^ "if (_hx_e.IsClass< " ^ type_name ^ " >() )"); - ); - - let prologue = function _ -> - output_i "HX_STACK_BEGIN_CATCH\n"; - output_i (type_name ^ " " ^ (cpp_var_name_of v) ^ " = _hx_e;\n"); - in - gen_with_injection (mk_injection prologue "" "") catch true; - else_str := "else "; - ) catches; - - if (not !seen_dynamic) then begin - output_i "else {\n"; - output_i "\tHX_STACK_DO_THROW(_hx_e);\n"; - output_i "}\n"; - end; - out spacer; - writer#end_block; - end - - | CppCode(value, exprs) -> - Codegen.interpolate_code ctx.ctx_common (format_code value) exprs out (fun e -> gen e) expr.cpppos - | CppTCast(expr,cppType) -> - (match cppType with - | TCppInterface(i) -> - out " ::hx::interface_check("; - gen expr; - out ("," ^ (cpp_class_hash i) ^")") - | _ -> begin - let toType = tcpp_to_string cppType in - if toType="Dynamic" then - (out " ::Dynamic("; gen expr; out ")") - else - (out ("::hx::TCast< " ^ toType ^ " >::cast("); gen expr; out ")") - end - ) - - | CppCastStatic(expr,toType) -> - let close = match expr.cpptype with - | TCppDynamic -> "" - | _ -> out "Dynamic( "; ")" - in - gen expr; out (close ^ ".StaticCast< " ^ tcpp_to_string toType ^" >()") - - | CppCast(expr,toType) -> - (match expr.cppexpr, expr.cpptype, toType with - | CppCall( FuncInternal _, _), _, _ -> - gen expr; out (".StaticCast< " ^ tcpp_to_string toType ^" >()") - | _, TCppObjC(_), _ - | _, TCppObjCBlock(_), _ -> - out ("( ("^ tcpp_to_string toType ^")((id) ( "); gen expr; out (") ))") - | _,_,TCppObjectPtr -> out ("::hx::DynamicPtr("); gen expr; out (")") - | _,TCppPointer(_,_), TCppStar(_,_) - | _,TCppPointer(_,_), TCppRawPointer(_,_) - -> out ("( ("^ tcpp_to_string toType ^")( ("); gen expr; out (").get_raw()) )") - | _ -> out ("( ("^ tcpp_to_string toType ^")("); gen expr; out (") )") - ) - - | CppCastScalar(expr,scalar) -> - out ("( ("^scalar^")("); gen expr; out (") )"); - - | CppCastVariant(expr) -> - out " ::Dynamic("; gen expr; out ")"; - - | CppCastObjC(expr,klass) -> - let path = join_class_path_remap klass.cl_path "::" in - let toType = if (has_class_flag klass CInterface) then "id < " ^ path ^ ">" else path ^ " *" in - out ("( (" ^ toType ^ ") (id) ("); gen expr; out ") )" - - | CppCastObjCBlock(expr,args,ret) -> - out (tcpp_objc_block_struct args ret ^ "::create( "); - gen expr; - out ")" - - | CppCastProtocol(expr,klass) -> - out ( (join_class_path_remap klass.cl_path "::" ) ^ "_obj::_hx_toProtocol( "); - gen expr; - out ")" - - | CppCastNative(expr) -> - out "("; gen expr; out ").mPtr" - ); - if (ctx.ctx_debug_level >= 3) then - out ("/* " ^ (s_tcpp expr.cppexpr) ^ ":" ^ tcpp_to_string expr.cpptype ^ " */") - - and gen expr = - gen_with_injection None expr true - - and gen_lvalue lvalue = - match lvalue with - | CppVarRef varLoc -> - gen_val_loc varLoc true - | CppArrayRef arrayLoc -> (match arrayLoc with - | ArrayObject(arrayObj, index, _) -> - out "::hx::IndexRef("; gen arrayObj; out ".mPtr,"; gen index; out ")"; - | ArrayTyped(arrayObj, index, _) -> - gen arrayObj; out "["; gen index; out "]"; - | ArrayPointer(arrayObj, index) -> - gen arrayObj; out ".ptr["; gen index; out "]"; - | ArrayRawPointer(arrayObj, index) -> - gen arrayObj; out "["; gen index; out "]"; - | ArrayVirtual(arrayObj, index) - | ArrayDynamic(arrayObj, index) -> - out "::hx::IndexRef("; gen arrayObj; out ".mPtr,"; gen index; out ")"; - | ArrayImplements(_,arrayObj,index) -> - out "::hx::__ArrayImplRef("; gen arrayObj; out ","; gen index; out ")"; - ) - | CppExternRef(name,isGlobal) -> if isGlobal then out " ::"; out name - | CppDynamicRef(expr,name) -> - let objPtr = match expr.cpptype with - | TCppVariant -> "getObject()" - | _ -> ".mPtr" - in - out "::hx::FieldRef(("; gen expr ; out (")" ^ objPtr ^ "," ^ strq name ^ ")") - - and gen_val_loc loc lvalue = - match loc with - | VarClosure(var) -> - out (cpp_var_name_of var) - | VarLocal(local) -> out (cpp_var_name_of local) - | VarStatic(clazz,objc,member) -> - let rename = get_meta_string member.cf_meta Meta.Native in - if rename <> "" then - out rename - else if objc then - (out ( (join_class_path_remap clazz.cl_path "::") ); out ("." ^ (cpp_member_name_of member))) - else - (out (cpp_class_name clazz ); out ("::" ^ (cpp_member_name_of member))) - | VarThis(member,_) -> - out ("this->" ^ (cpp_member_name_of member)) - | VarInstance(obj,member,_,operator) -> - gen obj; out (operator ^ (cpp_member_name_of member)) - | VarInternal(obj,operator,member) -> - gen obj; out (operator ^ member) - | VarInterface(obj,member) -> - gen obj; out ("->" ^ (cpp_member_name_of member) ^ "_get()" ) - - and string_of_op_eq op pos = match op with - | OpAdd -> "::hx::AddEq" - | OpMult -> "::hx::MultEq" - | OpDiv -> "::hx::DivEq" - | OpSub -> "::hx::SubEq" - | OpAnd -> "::hx::AndEq" - | OpOr -> "::hx::OrEq" - | OpXor -> "::hx::XorEq" - | OpShl -> "::hx::ShlEq" - | OpShr -> "::hx::ShrEq" - | OpUShr -> "::hx::UShrEq" - | OpMod -> "::hx::ModEq" - | _ -> abort "Bad assign op" pos - and string_of_op op pos = match op with - | OpAdd -> "+" - | OpMult -> "*" - | OpDiv -> "/" - | OpSub -> "-" - | OpEq -> "==" - | OpNotEq -> "!=" - | OpGt -> ">" - | OpGte -> ">=" - | OpLt -> "<" - | OpLte -> "<=" - | OpAnd -> "&" - | OpOr -> "|" - | OpXor -> "^" - | OpBoolAnd -> "&&" - | OpBoolOr -> "||" - | OpShl -> "<<" - | OpShr -> ">>" - | OpUShr -> ">>>" - | OpMod -> "%" - | OpInterval -> "..." - | OpArrow -> "->" - | OpIn -> " in " - | OpNullCoal -> "??" - | OpAssign | OpAssignOp _ -> abort "Unprocessed OpAssign" pos - - and gen_closure closure = - let argc = Hashtbl.length closure.close_undeclared in - let size = string_of_int argc in - if argc >= 62 then (* Limited by c++ macro size of 128 args *) - abort "Too many capture variables" closure.close_expr.cpppos; - if argc >= 20 || (List.length closure.close_args) >= 20 then - writer#add_big_closures; - let argsCount = list_num closure.close_args in - output_i ("HX_BEGIN_LOCAL_FUNC_S" ^ size ^ "("); - out (if closure.close_this != None then "::hx::LocalThisFunc," else "::hx::LocalFunc,"); - out ("_hx_Closure_" ^ (string_of_int closure.close_id) ); - Hashtbl.iter (fun name var -> - out ("," ^ (cpp_macro_var_type_of ctx var) ^ "," ^ (keyword_remap name)); - ) closure.close_undeclared; - out (") HXARGC(" ^ argsCount ^")\n"); - - let func_type = tcpp_to_string closure.close_type in - output_i (func_type ^ " _hx_run(" ^ (cpp_arg_list ctx closure.close_args "__o_") ^ ")"); - - let prologue = function gc_stack -> - cpp_gen_default_values ctx closure.close_args "__o_"; - hx_stack_push ctx output_i class_name func_name closure.close_expr.cpppos gc_stack; - if (ctx.ctx_debug_level>=2) then begin - if (closure.close_this != None) then - output_i ("HX_STACK_THIS(__this.mPtr)\n"); - List.iter (fun (v,_) -> output_i ("HX_STACK_ARG(" ^ (cpp_var_name_of v) ^ ",\"" ^ (cpp_debug_name_of v) ^"\")\n") ) - (List.filter (cpp_debug_var_visible ctx) closure.close_args); - - let line = Lexer.get_error_line closure.close_expr.cpppos in - let lineName = Printf.sprintf "%4d" line in - out ("HXLINE(" ^ lineName ^ ")\n" ); - end - in - gen_with_injection (mk_injection prologue "" "") closure.close_expr true; - - let return = match closure.close_type with TCppVoid -> "(void)" | _ -> "return" in - - output_i ("HX_END_LOCAL_FUNC" ^ argsCount ^ "(" ^ return ^ ")\n\n"); - in - - - (*out "\t";*) - - gen_with_injection injection cppTree true; - -;; - -(* } *) - - -let gen_cpp_function_body ctx clazz is_static func_name function_def head_code tail_code no_debug = - let output = ctx.ctx_output in - let dot_name = join_class_path clazz.cl_path "." in - if no_debug then ctx.ctx_debug_level <- 0; - let prologue = function gc_stack -> - let spacer = if no_debug then "\t" else " \t" in - let output_i = fun s -> output (spacer ^ s) in - ctx_default_values ctx function_def.tf_args "__o_"; - hx_stack_push ctx output_i dot_name func_name function_def.tf_expr.epos gc_stack; - if ctx.ctx_debug_level >= 2 then begin - if (not is_static) - then output_i ("HX_STACK_THIS(" ^ (if ctx.ctx_real_this_ptr then "this" else "__this") ^")\n"); - List.iter (fun (v,_) -> if not (cpp_no_debug_synbol ctx v) then - output_i ("HX_STACK_ARG(" ^ (cpp_var_name_of v) ^ ",\"" ^ v.v_name ^"\")\n") ) function_def.tf_args; - - let line = Lexer.get_error_line function_def.tf_expr.epos in - let lineName = Printf.sprintf "%4d" line in - output ("HXLINE(" ^ lineName ^ ")\n" ); - end; - if (head_code<>"") then - output_i (head_code ^ "\n"); - in - let args = List.map fst function_def.tf_args in - - let injection = mk_injection prologue "" tail_code in - gen_cpp_ast_expression_tree ctx dot_name func_name args function_def.tf_type injection (mk_block function_def.tf_expr); -;; - -let gen_cpp_init ctx dot_name func_name var_name expr = - let output = ctx.ctx_output in - let prologue = function gc_stack -> - let spacer = if ctx.ctx_debug_level > 0 then " \t" else "\t" in - let output_i = fun s -> output (spacer ^ s) in - hx_stack_push ctx output_i dot_name func_name expr.epos gc_stack; - in - let injection = mk_injection prologue var_name "" in - gen_cpp_ast_expression_tree ctx dot_name func_name [] t_dynamic injection (mk_block expr); -;; - - -(* -let is_dynamic_haxe_method f = - match follow f.cf_type with - | TFun _ when f.cf_expr = None -> true - | _ -> - (match f.cf_expr with - | Some { eexpr = TFunction fd } when f.cf_set = MethodAccess true -> true - | Some { eexpr = TFunction fd } when f.cf_set = NormalAccess -> true - | _ -> false);; -*) - -let is_dynamic_haxe_method f = - (match f.cf_expr, f.cf_kind with - | Some { eexpr = TFunction _ }, (Var _ | Method MethDynamic) -> true - | _ -> false);; - - -let is_data_member field = - match field.cf_kind with - | Var _ | Method MethDynamic -> true - | _ -> false;; - - -let is_override field = - has_class_field_flag field CfOverride -;; - -(* - Functions are added in reverse order (oldest on right), then list is reversed because this is easier in ocaml - The order is important because cppia looks up functions by index -*) - - -let current_virtual_functions_rev clazz base_functions = - List.fold_left (fun result elem -> match follow elem.cf_type, elem.cf_kind with - | _, Method MethDynamic -> result - | TFun (args,return_type), Method _ -> - if (is_override elem ) then - List.map (fun (e,a,r) -> if e.cf_name<>elem.cf_name then (e,a,r) else (elem,args,return_type) ) result - else - (elem,args,return_type) :: result - | _,_ -> result - ) base_functions clazz.cl_ordered_fields -;; - -let all_virtual_functions clazz = - let rec all_virtual_functions_rec clazz = - current_virtual_functions_rev clazz (match clazz.cl_super with - | Some def -> all_virtual_functions_rec (fst def) - | _ -> [] - ) - in - List.rev (all_virtual_functions_rec clazz) -;; - - - -(* -let current_virtual_functions clazz parents override_types = - List.fold_left (fun result elem -> match follow elem.cf_type, elem.cf_kind with - | _, Method MethDynamic -> result - | TFun (args,return_type), Method _ -> - if override_types then - (elem,args,return_type) :: (List.filter (fun (e,a,r) -> e.cf_name<>elem.cf_name) result) - else if (is_override clazz elem.cf_name ) then - result - else - (elem,args,return_type) :: result - | _,_ -> result ) parents (List.rev clazz.cl_ordered_fields) -;; - -let all_virtual_functions clazz override_types = - let rec all_virtual_functions clazz = - current_virtual_functions clazz (match clazz.cl_super with - | Some def -> all_virtual_functions (fst def) - | _ -> [] ) false - in - all_virtual_functions clazz -;; -*) - - -let rec unreflective_type t = - match follow t with - | TInst (klass,_) -> Meta.has Meta.Unreflective klass.cl_meta - | TFun (args,ret) -> - List.fold_left (fun result (_,_,t) -> result || (unreflective_type t)) (unreflective_type ret) args; - | _ -> false -;; - -let reflective class_def field = not ( - (Meta.has Meta.NativeGen class_def.cl_meta) || - (Meta.has Meta.Unreflective class_def.cl_meta) || - (Meta.has Meta.Unreflective field.cf_meta) || - unreflective_type field.cf_type - ) -;; - - - - - -let field_arg_count field = - match follow field.cf_type, field.cf_kind with - | _, Method MethDynamic -> -1 - | TFun (args,return_type), Method _ -> List.length args - | _,_ -> -1 -;; - -let native_field_name_remap is_static field = - let remap_name = keyword_remap field.cf_name in - if not is_static then - remap_name - else begin - let nativeImpl = get_meta_string field.cf_meta Meta.Native in - if nativeImpl<>"" then begin - let r = Str.regexp "^[a-zA-Z_0-9]+$" in - if Str.string_match r remap_name 0 then - "_hx_" ^ remap_name - else - "_hx_f" ^ (gen_hash 0 remap_name) - end else - remap_name - end -;; - - -let gen_field ctx class_def class_name ptr_name dot_name is_static is_interface field = - let output = ctx.ctx_output in - ctx.ctx_real_this_ptr <- not is_static; - let remap_name = keyword_remap field.cf_name in - let decl = get_meta_string field.cf_meta Meta.Decl in - let has_decl = decl <> "" in - if (is_interface) then begin - (* Just the dynamic glue - not even that ... *) - () - end else (match field.cf_expr with - (* Function field *) - | Some { eexpr = TFunction function_def } -> - let return_type_str = (ctx_type_string ctx function_def.tf_type) in - let nargs = string_of_int (List.length function_def.tf_args) in - let return_type = (cpp_type_of ctx function_def.tf_type ) in - let is_void = return_type = TCppVoid in - let ret = if is_void then "(void)" else "return " in - - let needsWrapper t = match t with - | TCppStar _ -> true - | TCppInst(t, _) -> has_meta_key t.cl_meta Meta.StructAccess - | _ -> false - in - let orig_debug = ctx.ctx_debug_level in - let no_debug = has_meta_key field.cf_meta Meta.NoDebug in - - if (not (is_dynamic_haxe_method field)) then begin - (* The actual function definition *) - let nativeImpl = get_meta_string field.cf_meta Meta.Native in - let remap_name = native_field_name_remap is_static field in - output (if is_void then "void" else return_type_str ); - output (" " ^ class_name ^ "::" ^ remap_name ^ "(" ); - output (ctx_arg_list ctx function_def.tf_args "__o_"); - output ")"; - ctx.ctx_real_this_ptr <- true; - let code = (get_code field.cf_meta Meta.FunctionCode) in - let tail_code = (get_code field.cf_meta Meta.FunctionTailCode) in - - if nativeImpl<>"" && is_static then begin - output " {\n"; - output ("\t" ^ ret ^ "::" ^ nativeImpl ^ "(" ^ (ctx_arg_list_name ctx function_def.tf_args "__o_") ^ ");\n"); - output "}\n\n"; - end else - gen_cpp_function_body ctx class_def is_static field.cf_name function_def code tail_code no_debug; - - output "\n\n"; - let nonVirtual = has_meta_key field.cf_meta Meta.NonVirtual in - let doDynamic = (nonVirtual || not (is_override field ) ) && (reflective class_def field ) in - (* generate dynamic version too ... *) - if ( doDynamic ) then begin - let tcpp_args = List.map (fun (v,_) -> cpp_type_of ctx v.v_type ) function_def.tf_args in - let wrap = (needsWrapper return_type) || (List.exists needsWrapper tcpp_args) in - if wrap then begin - let wrapName = "_hx_wrap" ^ class_name ^ "_" ^ remap_name in - output ("static ::Dynamic " ^ wrapName ^ "( " ); - let sep = ref " " in - if not is_static then begin - output "::hx::Object *obj"; - sep := ","; - end; - ExtList.List.iteri (fun i _ -> output (!sep ^ "const Dynamic &a" ^ (string_of_int i)) ; sep:=",") tcpp_args; - output ( ") {\n\t"); - if not is_void then begin - match return_type with - | TCppStar _ -> - output "return (cpp::Pointer) " - | TCppInst(t, _) when has_meta_key t.cl_meta Meta.StructAccess -> - output ("return (cpp::Struct< " ^ (tcpp_to_string return_type) ^ " >) "); - | _ -> output "return "; - end; - - if is_static then - output (class_name ^ "::" ^ remap_name ^ "(") - else - output ("reinterpret_cast< " ^ class_name ^ " *>(obj)->" ^ remap_name ^ "("); - - sep := ""; - ExtList.List.iteri (fun i arg -> - output !sep; sep := ","; - (match arg with - | TCppStar (t,const) -> - output ("(cpp::" ^ (if const then "Const" else "") ^"Pointer<" ^ (tcpp_to_string t)^" >) ") - | TCppInst(t, _) when has_meta_key t.cl_meta Meta.StructAccess -> - output ("(cpp::Struct< " ^ (tcpp_to_string arg) ^ " >) "); - | _ -> () ); - output ("a" ^ (string_of_int i)); - ) tcpp_args; - - output ");\n"; - - if is_void then output "\treturn null();\n"; - output "}\n"; - let nName = string_of_int (List.length tcpp_args) in - output ("::Dynamic " ^ class_name ^ "::" ^ remap_name ^ "_dyn() {\n\treturn "); - if is_static then - output ("::hx::CreateStaticFunction" ^ nName ^ "(\"" ^ remap_name ^ "\"," ^ wrapName ^ ");") - else - output ("::hx::CreateMemberFunction" ^ nName ^ "(\"" ^ remap_name ^ "\",this," ^ wrapName ^ ");"); - output "}\n"; - end else begin - if (is_static) then output "STATIC_"; - output ("HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," ^ remap_name ^ "," ^ ret ^ ")\n\n"); - end - end; - - end else begin - ctx.ctx_real_this_ptr <- false; - let func_name = "__default_" ^ (remap_name) in - output ("HX_BEGIN_DEFAULT_FUNC(" ^ func_name ^ "," ^ class_name ^ ")\n"); - output return_type_str; - output (" _hx_run(" ^ (ctx_arg_list ctx function_def.tf_args "__o_") ^ ")"); - gen_cpp_function_body ctx class_def is_static func_name function_def "" "" no_debug; - - output ("HX_END_LOCAL_FUNC" ^ nargs ^ "(" ^ ret ^ ")\n"); - output ("HX_END_DEFAULT_FUNC\n\n"); - - if (is_static) then - output ( "::Dynamic " ^ class_name ^ "::" ^ remap_name ^ ";\n\n"); - end; - ctx.ctx_debug_level <- orig_debug - - (* Data field *) - | _ when has_decl -> - if is_static then begin - output ( class_name ^ "::" ^ remap_name ^ "_decl "); - output ( " " ^ class_name ^ "::" ^ remap_name ^ ";\n\n"); - end - | _ -> - if is_static && is_physical_field field then begin - gen_type ctx field.cf_type; - output ( " " ^ class_name ^ "::" ^ remap_name ^ ";\n\n"); - end else if has_class_field_flag field CfAbstract then begin - let tl,tr = match follow field.cf_type with - | TFun(tl,tr) -> tl,tr - | _ -> die "" __LOC__ - in - let nargs = string_of_int (List.length tl) in - let return_type = (cpp_type_of ctx tr ) in - let is_void = return_type = TCppVoid in - let ret = if is_void then "(void)" else "return " in - output ("HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," ^ remap_name ^ "," ^ ret ^ ")\n\n"); - end - ) - ;; - - - - - -let gen_field_init ctx class_def field = - let dot_name = join_class_path class_def.cl_path "." in - let output = ctx.ctx_output in - let remap_name = keyword_remap field.cf_name in - match field.cf_expr with - (* Function field *) - | Some { eexpr = TFunction function_def } -> - if (is_dynamic_haxe_method field) then begin - let func_name = "__default_" ^ (remap_name) in - output ( "\t" ^ remap_name ^ " = new " ^ func_name ^ ";\n\n" ); - end - - (* Data field *) - | Some expr -> - let var_name = ( match remap_name with - | "__meta__" -> "__mClass->__meta__" - | "__rtti" -> "__mClass->__rtti__" - | _ -> remap_name ) in - - gen_cpp_init ctx dot_name "boot" (var_name ^ " = ") expr - | _ -> () -;; - - -let cpp_interface_impl_name ctx interface = - "_hx_" ^ (join_class_path interface.cl_path "_" ) -;; - - - - -let has_field_init field = - match field.cf_expr with - (* Function field *) - | Some { eexpr = TFunction function_def } -> is_dynamic_haxe_method field - (* Data field *) - | Some _ -> true - | _ -> false -;; - - -let gen_member_def ctx class_def is_static is_interface field = - let output = ctx.ctx_output in - let remap_name = keyword_remap field.cf_name in - let nativeGen = has_meta_key class_def.cl_meta Meta.NativeGen in - - if (is_interface) then begin - match follow field.cf_type, field.cf_kind with - | _, Method MethDynamic -> () - | TFun (args,return_type), Method _ -> - let gen_args = ctx_tfun_arg_list ctx true in - if is_static || nativeGen then begin - output ( (if (not is_static) then " virtual " else " " ) ^ (ctx_type_string ctx return_type) ); - output (" " ^ remap_name ^ "( " ); - output (gen_args args); - output (if (not is_static) then ")=0;\n" else ");\n"); - if (reflective class_def field) then begin - if (Common.defined ctx.ctx_common Define.DynamicInterfaceClosures) then - output (" inline ::Dynamic " ^ remap_name ^ "_dyn() { return __Field( " ^ (strq ctx.ctx_common field.cf_name) ^ ", ::hx::paccDynamic); }\n" ) - else - output (" virtual ::Dynamic " ^ remap_name ^ "_dyn()=0;\n" ); - end - end else begin - let argList = gen_args args in - let returnType = ctx_type_string ctx return_type in - let returnStr = if returnType = "void" then "" else "return " in - let commaArgList = if argList="" then argList else "," ^ argList in - let cast = "::hx::interface_cast< ::" ^ join_class_path_remap class_def.cl_path "::" ^ "_obj *>" in - output (" " ^ returnType ^ " (::hx::Object :: *_hx_" ^ remap_name ^ ")(" ^ argList ^ "); \n"); - output (" static inline " ^ returnType ^ " " ^ remap_name ^ "( ::Dynamic _hx_" ^ commaArgList ^ ") {\n"); - output (" #ifdef HXCPP_CHECK_POINTER\n"); - output (" if (::hx::IsNull(_hx_)) ::hx::NullReference(\"Object\", false);\n"); - output (" #ifdef HXCPP_GC_CHECK_POINTER\n"); - output (" GCCheckPointer(_hx_.mPtr);\n"); - output (" #endif\n"); - output (" #endif\n"); - output (" " ^ returnStr ^ "(_hx_.mPtr->*( " ^ cast ^ "(_hx_.mPtr->_hx_getInterface(" ^ (cpp_class_hash class_def) ^ ")))->_hx_" ^ remap_name ^ ")(" ^ cpp_arg_names args ^ ");\n }\n" ); - end - | _ -> ( ) - end else begin - let decl = get_meta_string field.cf_meta Meta.Decl in - let has_decl = decl <> "" in - let nonVirtual = has_meta_key field.cf_meta Meta.NonVirtual in - let doDynamic = (nonVirtual || not (is_override field ) ) && (reflective class_def field ) in - if (has_decl) then - output ( " typedef " ^ decl ^ ";\n" ); - output (if is_static then "\t\tstatic " else "\t\t"); - (match field.cf_expr with - | Some { eexpr = TFunction function_def } -> - if ( is_dynamic_haxe_method field ) then begin - if ( doDynamic ) then begin - output ("::Dynamic " ^ remap_name ^ ";\n"); - if (not is_static) && (is_gc_element ctx TCppDynamic) then - output ("\t\tinline ::Dynamic _hx_set_" ^ remap_name ^ "(::hx::StackContext *_hx_ctx,::Dynamic _hx_v) { HX_OBJ_WB(this,_hx_v.mPtr) return " ^ remap_name ^ "=_hx_v; }\n"); - output (if is_static then "\t\tstatic " else "\t\t"); - output ("inline ::Dynamic &" ^ remap_name ^ "_dyn() " ^ "{return " ^ remap_name^ "; }\n") - end - end else begin - let return_type = (ctx_type_string ctx function_def.tf_type) in - if ( not is_static && not nonVirtual ) then begin - let scriptable = Common.defined ctx.ctx_common Define.Scriptable in - if (not (is_internal_member field.cf_name) && not scriptable ) then begin - let key = (join_class_path class_def.cl_path ".") ^ "." ^ field.cf_name in - try output (Hashtbl.find ctx.ctx_class_member_types key) with Not_found -> () - end else - output "virtual "; - end; - output (if return_type="Void" then "void" else return_type ); - - let remap_name = native_field_name_remap is_static field in - output (" " ^ remap_name ^ "(" ); - output (ctx_arg_list ctx function_def.tf_args "" ); - output ");\n"; - if ( doDynamic ) then begin - output (if is_static then "\t\tstatic " else "\t\t"); - output ("::Dynamic " ^ remap_name ^ "_dyn();\n" ) - end; - end; - output "\n"; - | _ when has_class_field_flag field CfAbstract -> - let ctx_arg_list ctx arg_list prefix = - let get_default_value name = - try - match Meta.get Meta.Value field.cf_meta with - | (_,[ (EObjectDecl decls, _) ],_) -> - Some ((List.find (fun ((n,_,_), _) -> n = name) decls) |> snd |> (type_constant_value ctx.ctx_common.basic)); - | _ -> - None - with Not_found -> - None - in - - String.concat "," (List.map (fun (n,o,t) -> (ctx_arg ctx n (get_default_value n) t prefix) ) arg_list) - in - let tl,tr = match follow field.cf_type with - | TFun(tl,tr) -> tl,tr - | _ -> die "" __LOC__ - in - let return_type = (ctx_type_string ctx tr) in - let remap_name = native_field_name_remap is_static field in - output "virtual "; - output (if return_type="Void" then "void" else return_type ); - output (" " ^ remap_name ^ "(" ); - output (ctx_arg_list ctx tl "" ); - output (") " ^ (if return_type="void" then "{}" else "{ return 0; }" ) ^ "\n"); - if doDynamic then - output (" ::Dynamic " ^ remap_name ^ "_dyn();\n" ); - | _ when has_decl -> - output ( remap_name ^ "_decl " ^ remap_name ^ ";\n" ); - (* Variable access *) - | _ -> - (* Variable access *) - let tcpp = cpp_type_of ctx field.cf_type in - let tcppStr = tcpp_to_string tcpp in - if not is_static && only_stack_access ctx field.cf_type then - abort ("Variables of type " ^ tcppStr ^ " may not be used as members") field.cf_pos; - - output (tcppStr ^ " " ^ remap_name ^ ";\n" ); - if not is_static && (is_gc_element ctx tcpp) then begin - let getPtr = match tcpp with | TCppString -> ".raw_ref()" | _ -> ".mPtr" in - output ("\t\tinline " ^ tcppStr ^ " _hx_set_" ^ remap_name ^ "(::hx::StackContext *_hx_ctx," ^ tcppStr ^ " _hx_v) { HX_OBJ_WB(this,_hx_v" ^ getPtr ^ ") return " ^ remap_name ^ "=_hx_v; }\n"); - end; - - (* Add a "dyn" function for variable to unify variable/function access *) - (match follow field.cf_type with - | _ when nativeGen -> () - | TFun (_,_) -> - output (if is_static then "\t\tstatic " else "\t\t"); - output ("Dynamic " ^ remap_name ^ "_dyn() { return " ^ remap_name ^ ";}\n" ) - | _ -> (match field.cf_kind with - | Var { v_read = AccCall } when (not is_static) && (is_dynamic_accessor ("get_" ^ field.cf_name) "get" field class_def) -> - output ("\t\tDynamic get_" ^ field.cf_name ^ ";\n" ) - | _ -> () - ); - (match field.cf_kind with - | Var { v_write = AccCall } when (not is_static) && (is_dynamic_accessor ("set_" ^ field.cf_name) "set" field class_def) -> - output ("\t\tDynamic set_" ^ field.cf_name ^ ";\n" ) - | _ -> () - ) - ) - ); - end - ;; - -let path_of_string path = - ["@verbatim"], path -;; - - -(* - Get a list of all classes referred to by the class/enum definition - These are used for "#include"ing the appropriate header files, - or for building the dependencies in the Build.xml file -*) -let find_referenced_types_flags ctx obj field_name super_deps constructor_deps header_only for_depends include_super_args = - let types = ref PMap.empty in - if for_depends then begin - let include_files = get_all_meta_string_path (t_infos obj).mt_meta Meta.Depend in - let include_adder = fun inc -> types := (PMap.add ( path_of_string inc ) true !types) in - List.iter include_adder include_files; - end; - let rec add_type_flag isNative in_path = - if ( not (PMap.mem in_path !types)) then begin - types := (PMap.add in_path isNative !types); - try - List.iter (add_type_flag isNative) (Hashtbl.find super_deps in_path); - with Not_found -> () - end - and add_type in_path = - add_type_flag false in_path - in - let add_extern_type decl = - let tinfo = t_infos decl in - let include_files = get_all_meta_string_path tinfo.mt_meta (if for_depends then Meta.Depend else Meta.Include) in - if List.length include_files > 0 then - List.iter (fun inc -> add_type(path_of_string inc)) include_files - else if (not for_depends) && (has_meta_key tinfo.mt_meta Meta.Include) then - add_type tinfo.mt_path - in - - let add_extern_class klass = - add_extern_type (TClassDecl klass) - in - let add_extern_enum enum = - add_extern_type (TEnumDecl enum) - in - let add_native_gen_class klass = - let include_files = get_all_meta_string_path klass.cl_meta (if for_depends then Meta.Depend else Meta.Include) in - if List.length include_files > 0 then - List.iter (fun inc -> add_type ( path_of_string inc )) include_files - else if for_depends then - add_type klass.cl_path - else begin - let path = klass.cl_path in - if not (has_class_flag klass CInterface) then - (* Always include native struct headers directly ... *) - add_type ( path_of_string ( (join_class_path path "/") ^ ".h") ) - else begin - add_type_flag true klass.cl_path - end - end - in - let visited = ref [] in - let rec visit_type in_type = - if not (List.exists (fun t2 -> Type.fast_eq in_type t2) !visited) then begin - visited := in_type :: !visited; - begin match follow in_type with - | TMono r -> (match r.tm_type with None -> () | Some t -> visit_type t) - | TEnum (enum,_) -> - (match is_extern_enum enum with - | true -> add_extern_enum enum - | false -> add_type enum.e_path) - (* If a class has a template parameter, then we treat it as dynamic - except - for the Array, Class, FastIterator or Pointer classes, for which we do a fully typed object *) - | TInst (klass,params) -> - (match klass.cl_path with - | ([],"Array") | ([],"Class") | (["cpp"],"FastIterator") - | (["cpp"],"Pointer") | (["cpp"],"ConstPointer") | (["cpp"],"Function") - | (["cpp"],"RawPointer") | (["cpp"],"RawConstPointer") -> List.iter visit_type params - | _ when is_native_gen_class klass -> add_native_gen_class klass - | _ when is_extern_class klass -> - add_extern_class klass; - List.iter visit_type params; - | _ -> (match klass.cl_kind with KTypeParameter _ -> () | _ -> add_type klass.cl_path); - ) - | TAbstract (a,params) when is_scalar_abstract a -> - add_extern_type (TAbstractDecl a) - | TFun (args,haxe_type) -> visit_type haxe_type; - List.iter (fun (_,_,t) -> visit_type t; ) args; - | _ -> () - end; - visited := List.tl !visited; - end - in - let visit_params expression = - begin - let rec visit_expression = fun expression -> - (* Expand out TTypeExpr (ie, the name of a class, as used for static access etc ... *) - (match expression.eexpr with - | TTypeExpr type_def -> ( match type_def with - | TClassDecl class_def when is_native_gen_class class_def -> add_native_gen_class class_def - | TClassDecl class_def when is_extern_class class_def -> add_extern_class class_def - | TEnumDecl enum_def when is_extern_enum enum_def -> add_extern_enum enum_def - | _ -> add_type (t_path type_def) - ) - - (* Must visit the types, Type.iter will visit the expressions ... *) - | TTry (e,catches) -> - List.iter (fun (v,_) -> visit_type v.v_type) catches - (* Must visit type too, Type.iter will visit the expressions ... *) - | TNew (klass,params,_) -> begin - visit_type (TInst (klass,params)); - try - let construct_type = Hashtbl.find constructor_deps klass.cl_path in - visit_type construct_type.cf_type - with Not_found -> (); - end - (* Must visit type too, Type.iter will visit the expressions ... *) - | TVar (v,_) -> - visit_type v.v_type - (* Must visit enum type too, Type.iter will visit the expressions ... *) - | TEnumParameter (_,ef,_) -> visit_type (follow ef.ef_type) - (* Must visit args too, Type.iter will visit the expressions ... *) - | TFunction func_def -> - List.iter (fun (v,_) -> visit_type v.v_type) func_def.tf_args; - - | TField( obj, field ) -> - (match field with - | FInstance (clazz,params,_) - | FClosure (Some (clazz,params),_) -> - visit_type (TInst (clazz,params)) - | _ -> () - ) - | TConst TSuper -> - (match follow expression.etype with - | TInst (klass,params) -> - (try let construct_type = Hashtbl.find constructor_deps klass.cl_path in - visit_type construct_type.cf_type - with Not_found -> () ) - | _ -> print_endline ("TSuper : Odd etype ?" ^ ( (ctx_type_string ctx expression.etype)) ) - ) - | _ -> () - ); - Type.iter visit_expression expression; - visit_type (follow expression.etype) - in - visit_expression expression - end - in - let visit_field field = - (* Add the type of the expression ... *) - visit_type field.cf_type; - if (not header_only) then - (match field.cf_expr with - | Some expression -> visit_params expression | _ -> ()); - in - let visit_class class_def = - let fields = List.append class_def.cl_ordered_fields class_def.cl_ordered_statics in - let fields_and_constructor = List.append fields - (match class_def.cl_constructor with | Some expr -> [expr] | _ -> [] ) in - let fields_and_constructor = - if field_name="*" then - fields_and_constructor - else - List.filter (fun f -> f.cf_name=field_name) fields_and_constructor in - List.iter visit_field fields_and_constructor; - if (include_super_args) then - List.iter visit_field (List.map (fun (a,_,_) -> a ) (all_virtual_functions class_def )); - - (* Add super & interfaces *) - if is_native_gen_class class_def then - add_native_gen_class class_def - else - add_type class_def.cl_path; - in - let visit_enum enum_def = - add_type enum_def.e_path; - PMap.iter (fun _ constructor -> - (match constructor.ef_type with - | TFun (args,_) -> - List.iter (fun (_,_,t) -> visit_type t; ) args; - | _ -> () ); - ) enum_def.e_constrs; - if (not header_only) then begin - let meta = Texpr.build_metadata ctx.ctx_common.basic (TEnumDecl enum_def) in - match meta with Some expr -> visit_params expr | _ -> (); - end; - in - let inc_cmp i1 i2 = - String.compare (join_class_path i1 ".") (join_class_path i2 ".") - in - - (* Body of main function *) - (match obj with - | TClassDecl class_def -> visit_class class_def; - (match TClass.get_cl_init class_def with Some expression -> visit_params expression | _ -> ()) - | TEnumDecl enum_def -> visit_enum enum_def - | TTypeDecl _ | TAbstractDecl _ -> (* These are expanded *) ()); - - let deps = List.sort inc_cmp (List.filter (fun path -> (include_class_header path) ) (pmap_keys !types)) in - let flags = List.map (fun dep -> PMap.find dep !types) deps in - deps, flags -;; - -let find_referenced_types ctx obj super_deps constructor_deps header_only for_depends include_super_args = - let deps,_ = find_referenced_types_flags ctx obj "*" super_deps constructor_deps header_only for_depends include_super_args in - deps -;; - - -let generate_main_header output_main = - output_main "#include \n\n"; - output_main "#include \n\n"; - output_main "extern \"C\" void __hxcpp_main();\n\n"; - output_main "extern \"C\" void __hxcpp_lib_main();\n\n" -;; - -let generate_main_footer1 output_main = - output_main "void __hxcpp_main() {\n";; - -let generate_main_footer2 output_main = - output_main " }\n\n"; - output_main "void __hxcpp_lib_main() {\n"; - output_main " HX_TOP_OF_STACK\n"; - output_main " ::hx::Boot();\n"; - output_main " __boot_all();\n"; - output_main " __hxcpp_main();\n"; - output_main " }\n" -;; - - -let generate_main ctx super_deps class_def = - let common_ctx = ctx.ctx_common in - (* main routine should be a single static function *) - let main_expression = - (match class_def.cl_ordered_statics with - | [{ cf_expr = Some expression }] -> expression; - | _ -> die "" __LOC__ ) in - ignore(find_referenced_types ctx (TClassDecl class_def) super_deps (Hashtbl.create 0) false false false); - let depend_referenced = find_referenced_types ctx (TClassDecl class_def) super_deps (Hashtbl.create 0) false true false in - let generate_startup filename is_main = - (*make_class_directories base_dir ( "src" :: []);*) - let cpp_file = new_cpp_file common_ctx common_ctx.file ([],filename) in - let output_main = (cpp_file#write) in - - generate_main_header (cpp_file#write_h); - - List.iter ( add_include cpp_file ) depend_referenced; - output_main "\n\n"; - - if is_main then output_main "\n#include \n\n"; - - generate_main_footer1 output_main; - - let ctx = file_context ctx cpp_file 1 false in - gen_cpp_init ctx "hxcpp" "__hxcpp_main" "" main_expression; - - - generate_main_footer2 output_main; - cpp_file#close; - in - generate_startup "__main__" true; - generate_startup "__lib__" false - ;; - -let generate_dummy_main common_ctx = - let generate_startup filename is_main = - let main_file = new_cpp_file common_ctx common_ctx.file ([],filename) in - let output_main = (main_file#write) in - generate_main_header (main_file#write_h); - if is_main then output_main "\n#include \n\n"; - generate_main_footer1 output_main; - generate_main_footer2 output_main; - main_file#close; - in - generate_startup "__main__" true; - generate_startup "__lib__" false - ;; - -let generate_boot ctx boot_enums boot_classes nonboot_classes init_classes = - let common_ctx = ctx.ctx_common in - (* Write boot class too ... *) - let base_dir = common_ctx.file in - let boot_file = new_cpp_file common_ctx base_dir ([],"__boot__") in - let output_boot = (boot_file#write) in - boot_file#write_h "#include \n\n"; - - List.iter ( fun class_path -> boot_file#add_include class_path ) - (boot_enums @ boot_classes @ nonboot_classes); - - let newScriptable = (Common.defined common_ctx Define.Scriptable) in - if newScriptable then begin - output_boot "#include \n"; - let funcs = hash_iterate !(ctx.ctx_interface_slot) (fun name id -> (name,id) ) in - let sorted = List.sort (fun (_,id1) (_,id2) -> id1-id2 ) funcs in - output_boot "static const char *scriptableInterfaceFuncs[] = {\n\t0,\n\t0,\n"; - List.iter (fun (name,id) -> output_boot ("\t\"" ^ name ^ "\", //" ^ (string_of_int (-id) ) ^ "\n")) sorted; - output_boot "};\n"; - end; - - - output_boot "\nvoid __files__boot();\n"; - output_boot "\nvoid __boot_all()\n{\n"; - output_boot "__files__boot();\n"; - output_boot "::hx::RegisterResources( ::hx::GetResources() );\n"; - if newScriptable then - output_boot ("::hx::ScriptableRegisterNameSlots(scriptableInterfaceFuncs," ^ (string_of_int !(ctx.ctx_interface_slot_count) ) ^ ");\n"); - - List.iter ( fun class_path -> - output_boot ("::" ^ ( join_class_path_remap class_path "::" ) ^ "_obj::__register();\n") ) - (boot_enums @ boot_classes @ nonboot_classes); - - let dump_boot = - List.iter ( fun class_path -> - output_boot ("::" ^ ( join_class_path_remap class_path "::" ) ^ "_obj::__boot();\n") ) in - - dump_boot boot_enums; - - List.iter ( fun class_path -> - output_boot ("::" ^ ( join_class_path_remap class_path "::" ) ^ "_obj::__init__();\n") ) (List.rev init_classes); - - dump_boot (List.filter (fun path -> is_cpp_class path ) (List.rev boot_classes)); - dump_boot (List.filter (fun path -> not (is_cpp_class path) ) (List.rev boot_classes)); - - output_boot "}\n\n"; - boot_file#close;; - - -let generate_files common_ctx file_info = - (* Write __files__ class too ... *) - let base_dir = common_ctx.file in - let files_file = new_cpp_file common_ctx base_dir ([],"__files__") in - let output_files = (files_file#write) in - let types = common_ctx.types in - files_file#write_h "#include \n\n"; - output_files "namespace hx {\n"; - output_files "const char *__hxcpp_all_files[] = {\n"; - output_files "#ifdef HXCPP_DEBUGGER\n"; - List.iter ( fun file -> output_files ((const_char_star file)^",\n" ) ) - ( List.sort String.compare ( pmap_keys !file_info) ); - output_files "#endif\n"; - output_files " 0 };\n"; - output_files "\n"; - - output_files "const char *__hxcpp_all_files_fullpath[] = {\n"; - output_files "#ifdef HXCPP_DEBUGGER\n"; - List.iter ( fun file -> output_files ((const_char_star ( - Path.get_full_path (try Common.find_file common_ctx file with Not_found -> file) - ))^",\n" ) ) - ( List.sort String.compare ( pmap_keys !file_info) ); - output_files "#endif\n"; - output_files " 0 };\n"; - output_files "\n"; - - - output_files "const char *__hxcpp_all_classes[] = {\n"; - output_files "#ifdef HXCPP_DEBUGGER\n"; - List.iter ( fun object_def -> - (match object_def with - | TClassDecl class_def when is_extern_class class_def -> ( ) - | TClassDecl class_def when (has_class_flag class_def CInterface) -> ( ) - | TClassDecl class_def -> - output_files ((const_char_star (join_class_path class_def.cl_path "." )) ^ ",\n") - | _ -> ( ) - ) - ) types; - output_files "#endif\n"; - output_files " 0 };\n"; - - output_files "} // namespace hx\n"; - output_files "void __files__boot() { __hxcpp_set_debugger_info(::hx::__hxcpp_all_classes, ::hx::__hxcpp_all_files_fullpath); }\n"; - - files_file#close;; - - -let begin_header_file output_h def_string nativeGen = - output_h ("#ifndef INCLUDED_" ^ def_string ^ "\n"); - output_h ("#define INCLUDED_" ^ def_string ^ "\n\n"); - output_h "#ifndef HXCPP_H\n"; - if nativeGen then begin - output_h "#ifdef HXCPP_API_LEVEL\n"; - output_h "#include \n"; - output_h "#else\n"; - output_h "#include \n"; - output_h "#endif\n" - end else begin - output_h "#include \n" - end; - output_h "#endif\n\n";; - -let end_header_file output_h def_string = - output_h ("\n#endif /* INCLUDED_" ^ def_string ^ " */ \n");; - -let new_placed_cpp_file common_ctx class_path = - let base_dir = common_ctx.file in - - if (Common.defined common_ctx Define.Vcproj ) then begin - make_class_directories base_dir ("src"::[]); - cached_source_writer common_ctx - ( base_dir ^ "/src/" ^ ( String.concat "-" (fst class_path) ) ^ "-" ^ - (snd class_path) ^ (source_file_extension common_ctx) ) - end else - new_cpp_file common_ctx common_ctx.file class_path;; - - - -let generate_enum_files baseCtx enum_def super_deps meta = - let common_ctx = baseCtx.ctx_common in - let class_path = enum_def.e_path in - let just_class_name = (snd class_path) in - let class_name = just_class_name ^ "_obj" in - let remap_class_name = ("::" ^ (join_class_path_remap class_path "::") ) in - (*let cpp_file = new_cpp_file common_ctx.file class_path in*) - let cpp_file = new_placed_cpp_file common_ctx class_path in - let output_cpp = (cpp_file#write) in - let debug = if (has_meta_key enum_def.e_meta Meta.NoDebug) || ( Common.defined common_ctx Define.NoDebug) - then 0 else 1 in - - let ctx = file_context baseCtx cpp_file debug false in - let strq = strq ctx.ctx_common in - - let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text enum_def.e_path) with Not_found -> Int32.zero in - let classIdTxt = Printf.sprintf "0x%08lx" classId in - - if (debug>1) then - print_endline ("Found enum definition:" ^ (join_class_path class_path "::" )); - - cpp_file#write_h "#include \n\n"; - - let referenced,flags = find_referenced_types_flags ctx (TEnumDecl enum_def) "*" super_deps (Hashtbl.create 0) false false false in - List.iter (add_include cpp_file) referenced; - - gen_open_namespace output_cpp class_path; - output_cpp "\n"; - - PMap.iter (fun _ constructor -> - let name = keyword_remap constructor.ef_name in - match constructor.ef_type with - | TFun (args,_) -> - output_cpp (remap_class_name ^ " " ^ class_name ^ "::" ^ name ^ "(" ^ - (ctx_tfun_arg_list ctx true args) ^")\n"); - - output_cpp ("{\n\treturn ::hx::CreateEnum< " ^ class_name ^ " >(" ^ (strq name) ^ "," ^ - (string_of_int constructor.ef_index) ^ "," ^ (string_of_int (List.length args)) ^ ")" ); - ExtList.List.iteri (fun i (arg,_,_) -> output_cpp ("->_hx_init(" ^ (string_of_int i) ^ "," ^ (keyword_remap arg) ^ ")")) args; - output_cpp ";\n}\n\n" - | _ -> - output_cpp ( remap_class_name ^ " " ^ class_name ^ "::" ^ name ^ ";\n\n" ) - ) enum_def.e_constrs; - - - let constructor_arg_count constructor = - (match constructor.ef_type with | TFun(args,_) -> List.length args | _ -> 0 ) - in - - output_cpp ("bool " ^ class_name ^ "::__GetStatic(const ::String &inName, ::Dynamic &outValue, ::hx::PropertyAccess inCallProp)\n{\n"); - PMap.iter (fun _ constructor -> - let name = constructor.ef_name in - let dyn = if constructor_arg_count constructor > 0 then "_dyn()" else "" in - output_cpp ("\tif (inName==" ^ strq name ^ ") { outValue = " ^ class_name ^ "::" ^ keyword_remap name ^ dyn ^ "; return true; }\n" ); - ) enum_def.e_constrs; - output_cpp ("\treturn super::__GetStatic(inName, outValue, inCallProp);\n}\n\n"); - - output_cpp ("HX_DEFINE_CREATE_ENUM(" ^ class_name ^ ")\n\n"); - - output_cpp ("bool " ^ class_name ^ "::_hx_isInstanceOf(int inClassId) {\n"); - output_cpp ("\treturn inClassId == (int)0x00000001 || inClassId == ::hx::EnumBase_obj::_hx_ClassId || inClassId == _hx_ClassId;\n"); - output_cpp ("}\n"); - - output_cpp ("int " ^ class_name ^ "::__FindIndex(::String inName)\n{\n"); - PMap.iter (fun _ constructor -> - let name = constructor.ef_name in - let idx = string_of_int constructor.ef_index in - output_cpp ("\tif (inName==" ^ (strq name) ^ ") return " ^ idx ^ ";\n") ) enum_def.e_constrs; - output_cpp ("\treturn super::__FindIndex(inName);\n"); - output_cpp ("}\n\n"); - - (* Dynamic versions of constructors *) - let dump_dynamic_constructor _ constr = - let count = constructor_arg_count constr in - if (count>0) then begin - let nargs = string_of_int count in - output_cpp ("STATIC_HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," ^ - (keyword_remap constr.ef_name) ^ ",return)\n\n"); - end - in - PMap.iter dump_dynamic_constructor enum_def.e_constrs; - - - output_cpp ("int " ^ class_name ^ "::__FindArgCount(::String inName)\n{\n"); - PMap.iter (fun _ constructor -> - let name = constructor.ef_name in - let count = string_of_int (constructor_arg_count constructor) in - output_cpp ("\tif (inName==" ^ (strq name) ^ ") return " ^ count ^ ";\n") ) enum_def.e_constrs; - output_cpp ("\treturn super::__FindArgCount(inName);\n"); - output_cpp ("}\n\n"); - - (* Dynamic "Get" Field function - string version *) - output_cpp ("::hx::Val " ^ class_name ^ "::__Field(const ::String &inName,::hx::PropertyAccess inCallProp)\n{\n"); - let dump_constructor_test _ constr = - output_cpp ("\tif (inName==" ^ (strq constr.ef_name) ^ ") return " ^ - (keyword_remap constr.ef_name) ); - if ( (constructor_arg_count constr) > 0 ) then output_cpp "_dyn()"; - output_cpp (";\n") - in - PMap.iter dump_constructor_test enum_def.e_constrs; - output_cpp ("\treturn super::__Field(inName,inCallProp);\n}\n\n"); - - output_cpp ("static ::String " ^ class_name ^ "_sStaticFields[] = {\n"); - let sorted = - List.sort (fun f1 f2 -> (PMap.find f1 enum_def.e_constrs ).ef_index - - (PMap.find f2 enum_def.e_constrs ).ef_index ) - (pmap_keys enum_def.e_constrs) in - - List.iter (fun name -> output_cpp ("\t" ^ (strq name) ^ ",\n") ) sorted; - - output_cpp "\t::String(null())\n};\n\n"; - - (* ENUM - Mark static as used by GC - they are const now, so no marking*) - (* ENUM - Visit static as used by GC - none *) - - output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); - - output_cpp ("Dynamic __Create_" ^ class_name ^ "() { return new " ^ class_name ^ "; }\n\n"); - - output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); - let text_name = strq (join_class_path class_path ".") in - output_cpp ("\n::hx::Static(__mClass) = ::hx::_hx_RegisterClass(" ^ text_name ^ - ", ::hx::TCanCast< " ^ class_name ^ " >," ^ class_name ^ "_sStaticFields,0,\n"); - output_cpp ("\t&__Create_" ^ class_name ^ ", &__Create,\n"); - output_cpp ("\t&super::__SGetClass(), &Create" ^ class_name ^ ", 0\n"); - output_cpp("#ifdef HXCPP_VISIT_ALLOCS\n , 0\n#endif\n"); - output_cpp ("#ifdef HXCPP_SCRIPTABLE\n , 0\n#endif\n"); - output_cpp (");\n"); - output_cpp ("\t__mClass->mGetStaticField = &" ^ class_name ^"::__GetStatic;\n"); - output_cpp "}\n\n"; - - output_cpp ("void " ^ class_name ^ "::__boot()\n{\n"); - (match meta with - | Some expr -> - let ctx = file_context ctx cpp_file 1 false in - gen_cpp_init ctx class_name "boot" "__mClass->__meta__ = " expr - | _ -> () ); - PMap.iter (fun _ constructor -> - let name = constructor.ef_name in - match constructor.ef_type with - | TFun (_,_) -> () - | _ -> - output_cpp ( (keyword_remap name) ^ " = ::hx::CreateConstEnum< " ^ class_name ^ " >(" ^ (strq name) ^ "," ^ - (string_of_int constructor.ef_index) ^ ");\n" ) - ) enum_def.e_constrs; - output_cpp ("}\n\n"); - - - - - output_cpp "\n"; - gen_close_namespace output_cpp class_path; - cpp_file#close; - - let h_file = new_header_file common_ctx common_ctx.file class_path in - let super = "::hx::EnumBase_obj" in - let output_h = (h_file#write) in - let def_string = join_class_path class_path "_" in - - let ctx = file_context baseCtx h_file debug true in - - begin_header_file (h_file#write_h) def_string false; - - List.iter2 (fun r f -> gen_forward_decl h_file r f) referenced flags; - - output_h ( get_code enum_def.e_meta Meta.HeaderCode ); - - gen_open_namespace output_h class_path; - - output_h "\n\n"; - output_h ("class " ^ class_name ^ " : public " ^ super ^ "\n"); - output_h ("{\n\ttypedef " ^ super ^ " super;\n"); - output_h ("\t\ttypedef " ^ class_name ^ " OBJ_;\n"); - output_h "\n\tpublic:\n"; - output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); - output_h ("\t\t" ^ class_name ^ "() {};\n"); - output_h ("\t\tHX_DO_ENUM_RTTI;\n"); - output_h ("\t\tstatic void __boot();\n"); - output_h ("\t\tstatic void __register();\n"); - output_h ("\t\tstatic bool __GetStatic(const ::String &inName, Dynamic &outValue, ::hx::PropertyAccess inCallProp);\n"); - output_h ("\t\t::String GetEnumName( ) const { return " ^ (strq (join_class_path class_path ".")) ^ "; }\n" ); - output_h ("\t\t::String __ToString() const { return " ^ (strq (just_class_name ^ ".") )^ " + _hx_tag; }\n"); - output_h ("\t\tbool _hx_isInstanceOf(int inClassId);\n\n"); - - - PMap.iter (fun _ constructor -> - let name = keyword_remap constructor.ef_name in - output_h ( "\t\tstatic " ^ remap_class_name ^ " " ^ name ); - match constructor.ef_type with - | TFun (args,_) -> - output_h ( "(" ^ (ctx_tfun_arg_list ctx true args) ^");\n"); - output_h ( "\t\tstatic ::Dynamic " ^ name ^ "_dyn();\n"); - | _ -> - output_h ";\n"; - output_h ( "\t\tstatic inline " ^ remap_class_name ^ " " ^ name ^ - "_dyn() { return " ^name ^ "; }\n" ); - ) enum_def.e_constrs; - - output_h "};\n\n"; - - gen_close_namespace output_h class_path; - - end_header_file output_h def_string; - h_file#close -;; - -let generate_enum_deps ctx enum_def super_deps = - find_referenced_types ctx (TEnumDecl enum_def) super_deps (Hashtbl.create 0) false true false -;; - -let list_iteri func in_list = - let idx = ref 0 in - List.iter (fun elem -> func !idx elem; idx := !idx + 1 ) in_list -;; - -let has_new_gc_references ctx class_def = - ( - let is_gc_reference field = - (should_implement_field field) && (is_data_member field) && not (ctx_cant_be_null ctx field.cf_type) - in - List.exists is_gc_reference class_def.cl_ordered_fields - ) -;; - - -let rec has_gc_references ctx class_def = - ( match class_def.cl_super with - | Some def when has_gc_references ctx (fst def) -> true - | _ -> false ) - || has_new_gc_references ctx class_def -;; - -let rec find_next_super_iteration ctx class_def = - match class_def.cl_super with - | Some (klass,params) when has_new_gc_references ctx klass -> - tcpp_to_string_suffix "_obj" (cpp_instance_type ctx klass params) - | Some (klass,_) -> find_next_super_iteration ctx klass - | _ -> ""; -;; - -let has_init_field class_def = - match TClass.get_cl_init class_def with - | Some _ -> true - | _ -> false;; - - -let is_abstract_impl class_def = match class_def.cl_kind with - | KAbstractImpl _ -> true - | _ -> false -;; - -let variable_field field = - (match field.cf_expr with - | Some { eexpr = TFunction function_def } -> is_dynamic_haxe_method field - | None when has_class_field_flag field CfAbstract -> false - | _ -> true) -;; - -let is_readable class_def field = - (match field.cf_kind with - | Var { v_read = AccNever } when not (is_physical_field field) -> false - | Var { v_read = AccInline } -> false - | Var _ when is_abstract_impl class_def -> false - | _ -> true) -;; - -let is_writable class_def field = - (match field.cf_kind with - | Var { v_write = AccNever } when not (is_physical_field field) -> false - | Var { v_read = AccInline } -> false - | Var _ when is_abstract_impl class_def -> false - | _ -> true) -;; - - -let statics_except_meta class_def = (List.filter (fun static -> static.cf_name <> "__meta__" && static.cf_name <> "__rtti") class_def.cl_ordered_statics);; - -let has_set_member_field class_def = - ( - let reflect_fields = List.filter (reflective class_def) (class_def.cl_ordered_fields) in - let reflect_writable = List.filter (is_writable class_def) reflect_fields in - List.exists variable_field reflect_writable - ) -;; - - -let has_set_static_field class_def = - let reflect_fields = List.filter (reflective class_def) (statics_except_meta class_def) in - let reflect_writable = List.filter (is_writable class_def) reflect_fields in - List.exists variable_field reflect_writable -;; - - -let has_get_fields class_def = - ( - let is_data_field field = (match follow field.cf_type with | TFun _ -> false | _ -> true) in - List.exists is_data_field class_def.cl_ordered_fields - ) -;; - -let has_get_member_field class_def = - ( - let reflect_fields = List.filter (reflective class_def) (class_def.cl_ordered_fields) in - List.exists (is_readable class_def) reflect_fields - ) -;; - - -let has_get_static_field class_def = - let reflect_fields = List.filter (reflective class_def) (statics_except_meta class_def) in - List.exists (is_readable class_def) reflect_fields -;; - -let has_compare_field class_def = - List.exists (fun f -> f.cf_name="__compare") class_def.cl_ordered_fields -;; - - -let has_boot_field class_def = - match TClass.get_cl_init class_def with - | None -> List.exists has_field_init (List.filter should_implement_field class_def.cl_ordered_statics) - | _ -> true -;; - -let cpp_tfun_signature ctx include_names args return_type = - let argList = ctx_tfun_arg_list ctx include_names args in - let returnType = ctx_type_string ctx return_type in - ("( " ^ returnType ^ " (::hx::Object::*)(" ^ argList ^ "))") -;; - -exception FieldFound of tclass_field;; - -let find_class_implementation ctx class_def name interface = - let rec find def = - List.iter (fun f -> if f.cf_name=name then raise (FieldFound f) ) def.cl_ordered_fields; - match def.cl_super with - | Some (def,_) -> find def - | _ -> () - in - try - find class_def; - abort ("Could not find implementation of " ^ name ^ " in " ^ - (join_class_path class_def.cl_path ".") ^ " required by " ^ (join_class_path interface.cl_path ".")) class_def.cl_pos - with FieldFound field -> - match follow field.cf_type, field.cf_kind with - | _, Method MethDynamic -> "" - | TFun (args,return_type), Method _ -> - cpp_tfun_signature ctx false args return_type - | _,_ -> "" -;; - - -let is_macro meta = - Meta.has Meta.Macro meta -;; - - -let cpp_get_interface_slot ctx name = - try Hashtbl.find !(ctx.ctx_interface_slot) name - with Not_found -> begin - let result = !(ctx.ctx_interface_slot_count) in - Hashtbl.replace !(ctx.ctx_interface_slot) name result; - ctx.ctx_interface_slot_count := !(ctx.ctx_interface_slot_count) + 1; - result - end -;; - -let access_str a = match a with - | AccNormal -> "AccNormal" - | AccNo -> "AccNo" - | AccNever -> "AccNever" - | AccCall -> "AccCall" - | AccInline -> "AccInline" - | AccRequire(_,_) -> "AccRequire" - | AccCtor -> "AccCtor";; - - -let script_type t optional = if optional then begin - match type_string t with - | "::String" -> "String" - | _ -> "Object" - end else match type_string t with - | "bool" -> "Int" - | "int" | "::cpp::Int32" -> "Int" - | "Float" -> "Float" - | "::String" -> "String" - | "Null" -> "Void" - | "Void" -> "Void" - | "float" | "::cpp::Float32" | "::cpp::Float64" -> "Float" - | "::cpp::Int64" | "::cpp::UInt64" -> "Object" - | _ -> "Object" -;; - -let script_signature t optional = match script_type t optional with - | "Bool" -> "b" - | "Int" -> "i" - | "Float" -> "f" - | "String" -> "s" - | "Void" -> "v" - | "void" -> "v" - | _ -> "o" -;; - -let script_size_type t optional = match script_type t optional with - | "Object" -> "void *" - | "Int" -> "int" - | "Bool" -> "bool" - | x -> x -;; - - - -let constructor_arg_var_list class_def ctx = - match class_def.cl_constructor with - | Some definition -> - (match definition.cf_expr with - | Some { eexpr = TFunction function_def } -> - List.map (fun (v,o) -> (v.v_name, ctx_arg_type_name ctx v.v_name o v.v_type "__o_")) - function_def.tf_args; - | _ -> - (match follow definition.cf_type with - | TFun (args,_) -> List.map (fun (a,_,t) -> (a, (ctx_type_string ctx t, a)) ) args - | _ -> []) - ) - | _ -> [] -;; - -let can_inline_constructor ctx class_def super_deps constructor_deps = - match class_def.cl_constructor with - | Some { cf_expr= Some super_func } -> - let is_simple = ref true in - let rec check_simple e = - (match e.eexpr with - | TReturn _ -> is_simple := false - | TArrayDecl e when List.length e > 0 -> is_simple := false - | _ -> () - ); - if !is_simple then Type.iter check_simple e - in - check_simple super_func; - !is_simple && ( - let rec known_classes class_def so_far = match class_def.cl_super with - | Some super -> known_classes (fst super) ((fst super).cl_path :: so_far) - | _ -> so_far in - let allowed = known_classes class_def [class_def.cl_path] in - (* Check to see if all the types required by the constructor are already in the header *) - (* This is quite restrictive, since most classes are forward-declared *) - let deps,_ = find_referenced_types_flags ctx (TClassDecl class_def) "new" super_deps constructor_deps false false true in - List.for_all (fun dep -> List.mem dep allowed ) deps - ) - | _ -> true -;; - -let has_dynamic_member_functions class_def = -List.fold_left (fun result field -> - match field.cf_expr with - | Some { eexpr = TFunction function_def } when is_dynamic_haxe_method field -> true - | _ -> result ) false class_def.cl_ordered_fields -;; - - -let generate_protocol_delegate ctx class_def output = - let protocol = get_meta_string class_def.cl_meta Meta.ObjcProtocol in - let full_class_name = ("::" ^ (join_class_path_remap class_def.cl_path "::") ) ^ "_obj" in - let name = "_hx_" ^ protocol ^ "_delegate" in - output ("@interface " ^ name ^ " : NSObject<" ^ protocol ^ "> {\n"); - output ("\t::hx::Object *haxeObj;\n"); - output ("}\n"); - output ("@end\n\n"); - output ("@implementation " ^ name ^ "\n"); - output ("- (id)initWithImplementation:( ::hx::Object *)inInplemnetation {\n"); - output (" if (self = [super init]) {\n"); - output (" self->haxeObj = inInplemnetation;\n"); - output (" GCAddRoot(&self->haxeObj);\n"); - output (" }\n"); - output (" return self;\n"); - output ("}\n"); - output ("- (void)dealloc {\n"); - output (" GCRemoveRoot(&self->haxeObj);\n"); - output (" #ifndef OBJC_ARC\n"); - output (" [super dealloc];\n"); - output (" #endif\n"); - output ("}\n\n"); - - let dump_delegate field = - match field.cf_type with - | TFun(args,ret) -> - let retStr = ctx_type_string ctx ret in - let nativeName = get_meta_string field.cf_meta Meta.ObjcProtocol in - let fieldName,argNames = if nativeName<>"" then begin - let parts = ExtString.String.nsplit nativeName ":" in - List.hd parts, parts - end else - field.cf_name, List.map (fun (n,_,_) -> n ) args - in - output ("- (" ^ retStr ^ ") " ^ fieldName ); - - let first = ref true in - (try - List.iter2 (fun (name,_,argType) signature_name -> - if !first then - output (" :(" ^ (ctx_type_string ctx argType) ^ ")" ^ name ) - else - output (" " ^ signature_name ^ ":(" ^ (ctx_type_string ctx argType) ^ ")" ^ name ); - first := false; - ) args argNames; - with Invalid_argument _ -> begin - abort ( - let argString = String.concat "," (List.map (fun (name,_,_) -> name) args) in - "Invalid arg count in delegate in " ^ field.cf_name ^ " '" ^ field.cf_name ^ "," ^ - (argString) ^ "' != '" ^ (String.concat "," argNames) ^ "'" ) field.cf_pos - end); - output (" {\n"); - output ("\t::hx::NativeAttach _hx_attach;\n"); - output ( (if retStr="void" then "\t" else "\treturn ") ^ full_class_name ^ "::" ^ (keyword_remap field.cf_name) ^ "(haxeObj"); - List.iter (fun (name,_,_) -> output ("," ^ name)) args; - output (");\n}\n\n"); - | _ -> () - in - List.iter dump_delegate class_def.cl_ordered_fields; - - output ("@end\n\n"); -;; - - -(* - Generate class header and cpp files - -*) - - -let generate_class_files baseCtx super_deps constructor_deps class_def inScriptable = - - (* Shorcuts *) - let common_ctx = baseCtx.ctx_common in - let class_path = class_def.cl_path in - let nativeGen = has_meta_key class_def.cl_meta Meta.NativeGen in - let class_name = (snd class_path) ^ (if nativeGen then "" else "_obj") in - let dot_name = join_class_path class_path "." in - let smart_class_name = (snd class_path) in - let class_name_text = join_class_path class_path "." in - let gcName = const_char_star class_name_text in - let ptr_name = "::hx::ObjectPtr< " ^ class_name ^ " >" in - let debug = if (has_meta_key class_def.cl_meta Meta.NoDebug) || ( Common.defined baseCtx.ctx_common Define.NoDebug) - then 0 else 1 in - let scriptable = inScriptable && not class_def.cl_private in - - let classId = try Hashtbl.find baseCtx.ctx_type_ids (class_text class_def.cl_path) with Not_found -> Int32.zero in - let classIdTxt = Printf.sprintf "0x%08lx" classId in - - (* Config *) - let override_iteration = (not nativeGen) && (has_new_gc_references baseCtx class_def) in - let dynamic_interface_closures = (Common.defined baseCtx.ctx_common Define.DynamicInterfaceClosures) in - - (* All interfaces (and sub-interfaces) implemented *) - let implemented_hash = Hashtbl.create 0 in - let native_implemented = Hashtbl.create 0 in - List.iter (fun imp -> - let rec descend_interface interface = - let intf_def = (fst interface) in - let interface_name = cpp_interface_impl_name baseCtx intf_def in - let hash = if is_native_gen_class intf_def then native_implemented else implemented_hash in - if ( not (Hashtbl.mem hash interface_name) ) then begin - Hashtbl.replace hash interface_name intf_def; - List.iter descend_interface intf_def.cl_implements; - end; - match intf_def.cl_super with - | Some (interface,params) -> descend_interface (interface,params) - | _ -> () - in descend_interface imp - ) (real_interfaces class_def.cl_implements); - let implemented = hash_keys implemented_hash in - let implementsNative = (Hashtbl.length native_implemented) > 0 in - - let dynamic_functions = List.fold_left (fun result field -> - match field.cf_expr with - | Some { eexpr = TFunction function_def } when is_dynamic_haxe_method field -> - (keyword_remap field.cf_name) :: result - | _ -> result ) [] class_def.cl_ordered_fields - in - - - (* Field groups *) - let statics_except_meta = statics_except_meta class_def in - let implemented_fields = List.filter should_implement_field statics_except_meta in - let implemented_instance_fields = List.filter should_implement_field class_def.cl_ordered_fields in - - let reflect_member_fields = List.filter (reflective class_def) class_def.cl_ordered_fields in - let reflect_member_readable = List.filter (is_readable class_def) reflect_member_fields in - let reflect_member_writable = List.filter (is_writable class_def) reflect_member_fields in - let reflect_write_member_variables = List.filter variable_field reflect_member_writable in - - let reflect_static_fields = List.filter (reflective class_def) (statics_except_meta) in - let reflect_static_readable = List.filter (is_readable class_def) reflect_static_fields in - let reflect_static_writable = List.filter (is_writable class_def) reflect_static_fields in - let reflect_write_static_variables = List.filter variable_field reflect_static_writable in - - let reflective_members = List.filter (reflective class_def) implemented_instance_fields in - - (* native interface glue *) - let neededInterfaceFunctions = if not implementsNative then [] - else begin - let have = Hashtbl.create 0 in - List.iter (fun field -> Hashtbl.replace have field.cf_name () ) implemented_instance_fields; - let want = ref [] in - Hashtbl.iter (fun _ intf_def -> - List.iter (fun field -> - if not (Hashtbl.mem have field.cf_name) then begin - Hashtbl.replace have field.cf_name (); - want := field :: !want; - end - ) intf_def.cl_ordered_fields; - ) native_implemented; - !want; - end - in - - let not_toString = fun (field,args,_) -> field.cf_name<>"toString" || (has_class_flag class_def CInterface) in - let functions = List.filter not_toString (all_virtual_functions class_def) in - - (* Constructor definition *) - let cargs = (constructor_arg_var_list class_def baseCtx) in - let constructor_type_var_list = List.map snd cargs in - let constructor_var_list = List.map snd constructor_type_var_list in - let constructor_type_args = String.concat "," - (List.map (fun (t,a) -> t ^ " " ^ a) constructor_type_var_list) in - let constructor_args = String.concat "," constructor_var_list in - - let isContainer = if (has_gc_references common_ctx class_def) then "true" else "false" in - - let can_quick_alloc = can_quick_alloc class_def in - - let outputConstructor ctx out isHeader = - let classScope = if isHeader then "" else class_name ^ "::" in - let staticHead = if isHeader then "inline static " else "" in - out (staticHead ^ ptr_name ^ " " ^ classScope ^ "__new(" ^constructor_type_args ^") {\n"); - out ("\t" ^ ptr_name ^ " __this = new " ^ class_name ^ "();\n"); - out ("\t__this->__construct(" ^ constructor_args ^ ");\n"); - out ("\treturn __this;\n"); - out ("}\n\n"); - - if can_quick_alloc then begin - out (staticHead ^ ptr_name ^ " " ^ classScope ^ "__alloc(::hx::Ctx *_hx_ctx" ^ - (if constructor_type_args="" then "" else "," ^constructor_type_args) ^") {\n"); - out ("\t" ^ class_name ^ " *__this = (" ^ class_name ^ "*)(::hx::Ctx::alloc(_hx_ctx, sizeof(" ^ class_name ^ "), " ^ isContainer ^", " ^ gcName ^ "));\n"); - out ("\t*(void **)__this = " ^ class_name ^ "::_hx_vtable;\n"); - let rec dump_dynamic class_def = - if has_dynamic_member_functions class_def then - out ("\t" ^ (join_class_path_remap class_def.cl_path "::") ^ "_obj::__alloc_dynamic_functions(_hx_ctx,__this);\n") - else match class_def.cl_super with - | Some super -> dump_dynamic (fst super) - | _ -> () - in - dump_dynamic class_def; - - if isHeader then begin - match class_def.cl_constructor with - | Some ( { cf_expr = Some ( { eexpr = TFunction(function_def) } ) } as definition ) -> - with_debug ctx definition.cf_meta (fun no_debug -> - ctx.ctx_real_this_ptr <- false; - gen_cpp_function_body ctx class_def false "new" function_def "" "" no_debug; - out "\n"; - ) - | _ -> () - end else - out ("\t__this->__construct(" ^ constructor_args ^ ");\n"); - - out ("\treturn __this;\n"); - out ("}\n\n"); - end; - in - - let outputNativeConstructor ctx out isHeader = - match class_def.cl_constructor with - | Some ({ cf_expr = Some { eexpr = TFunction(function_def) } } as definition) -> - if isHeader then begin - out ("\t\t" ^ class_name ^ "(" ^ constructor_type_args ^ ");\n\n"); - end else begin - with_debug ctx definition.cf_meta (fun no_debug -> - ctx.ctx_real_this_ptr <- true; - out (class_name ^ "::" ^ class_name ^ "(" ^ constructor_type_args ^ ")"); - - (match class_def.cl_super with - | Some (klass, _) -> - let rec find_super_args = function - | TCall ({ eexpr = TConst TSuper }, args) :: _ -> Some args - | (TParenthesis(e) | TMeta(_,e) | TCast(e,None)) :: rest -> find_super_args (e.eexpr :: rest) - | TBlock e :: rest -> find_super_args ((List.map (fun e -> e.eexpr) e) @ rest) - | _ :: rest -> find_super_args rest - | _ -> None - in - (match find_super_args [function_def.tf_expr.eexpr] with - | Some args -> - out ("\n:" ^ (cpp_class_path_of klass []) ^ "("); - let sep = ref "" in - List.iter (fun arg -> - out !sep; sep := ","; - gen_cpp_ast_expression_tree ctx "" "" [] t_dynamic None arg; - ) args; - out ")\n"; - | _ -> ()); - | _ -> ()); - - let head_code = get_code definition.cf_meta Meta.FunctionCode in - let tail_code = get_code definition.cf_meta Meta.FunctionTailCode in - gen_cpp_function_body ctx class_def false "new" function_def head_code tail_code no_debug; - ) - end - | _ -> () - in - - (* State *) - let header_glue = ref [] in - - - let cpp_file = new_placed_cpp_file baseCtx.ctx_common class_path in - let cpp_ctx = file_context baseCtx cpp_file debug false in - - let inlineContructor = can_inline_constructor cpp_ctx class_def super_deps constructor_deps in - - (* - Generate cpp code - *) - let generate_class_cpp () = - (*let cpp_file = new_cpp_file common_ctx.file class_path in*) - let ctx = cpp_ctx in - let output_cpp = (cpp_file#write) in - let strq = strq ctx.ctx_common in - - let class_super_name = (match class_def.cl_super with - | Some (klass, params) -> (tcpp_to_string_suffix "_obj" (cpp_instance_type ctx klass params) ) - | _ -> "") in - if (debug>1) then print_endline ("Found class definition:" ^ (join_class_path class_def.cl_path "::")); - - - cpp_file#write_h "#include \n\n"; - - let all_referenced = find_referenced_types ctx (TClassDecl class_def) super_deps constructor_deps false false scriptable in - List.iter ( add_include cpp_file ) all_referenced; - - - if (scriptable) then - cpp_file#write_h "#include \n"; - - cpp_file#write_h "\n"; - - output_cpp ( get_class_code class_def Meta.CppFileCode ); - let includes = get_all_meta_string_path class_def.cl_meta Meta.CppInclude in - let printer = fun inc -> output_cpp ("#include \"" ^ inc ^ "\"\n") in - List.iter printer includes; - - gen_open_namespace output_cpp class_path; - output_cpp "\n"; - - output_cpp ( get_class_code class_def Meta.CppNamespaceCode ); - - if (not (has_class_flag class_def CInterface)) && not nativeGen then begin - output_cpp ("void " ^ class_name ^ "::__construct(" ^ constructor_type_args ^ ")"); - (match class_def.cl_constructor with - | Some ( { cf_expr = Some ( { eexpr = TFunction(function_def) } ) } as definition ) -> - with_debug ctx definition.cf_meta (fun no_debug -> - gen_cpp_function_body ctx class_def false "new" function_def "" "" no_debug; - output_cpp "\n"; - ) - | _ -> output_cpp " { }\n\n" - ); - - (* Destructor goes in the cpp file so we can "see" the full definition of the member vars *) - if not (has_class_flag class_def CAbstract) then begin - output_cpp ("Dynamic " ^ class_name ^ "::__CreateEmpty() { return new " ^ class_name ^ "; }\n\n"); - output_cpp ("void *" ^ class_name ^ "::_hx_vtable = 0;\n\n"); - - output_cpp ("Dynamic " ^ class_name ^ "::__Create(::hx::DynamicArray inArgs)\n"); - output_cpp ("{\n\t" ^ ptr_name ^ " _hx_result = new " ^ class_name ^ "();\n"); - output_cpp ("\t_hx_result->__construct(" ^ (array_arg_list constructor_var_list) ^ ");\n"); - output_cpp ("\treturn _hx_result;\n}\n\n"); - end; - let rec addParent cls others = match cls.cl_super with - | Some (super,_) -> ( try ( - let parentId = Hashtbl.find ctx.ctx_type_ids (class_text super.cl_path) in - addParent super (parentId :: others); - ) with Not_found -> others ) - | _ -> others - in - let implemented_classes = addParent class_def [classId ; (Int32.of_int 1)] in - let implemented_classes = List.sort compare implemented_classes in - - output_cpp ("bool " ^ class_name ^ "::_hx_isInstanceOf(int inClassId) {\n"); - let txt cId = Printf.sprintf "0x%08lx" cId in - let rec dump_classes indent classes = match classes with - | [] -> () - | [c] -> output_cpp (indent ^ "return inClassId==(int)" ^ (txt c) ^ ";\n" ) - | [c;c1] -> output_cpp (indent ^ "return inClassId==(int)" ^ (txt c) ^ " || inClassId==(int)" ^ (txt c1) ^ ";\n" ) - | _ -> - let len = List.length classes in - let mid = List.nth classes (len / 2) in - let low,high = List.partition (fun e -> e<=mid) classes in - output_cpp (indent ^ "if (inClassId<=(int)" ^ (txt mid) ^ ") {\n"); - dump_classes (indent ^ "\t") low; - output_cpp (indent ^ "} else {\n"); - dump_classes (indent ^ "\t") high; - output_cpp (indent ^ "}\n"); - in - dump_classes "\t" implemented_classes; - output_cpp ("}\n\n"); - - if ( List.length implemented) > 0 then begin - let alreadyGlued = Hashtbl.create 0 in - let cname = "_hx_" ^ (join_class_path class_def.cl_path "_") in - let implname = (cpp_class_name class_def) in - let cpp_glue = ref [] in - List.iter (fun interface_name -> - (try let interface = Hashtbl.find implemented_hash interface_name in - output_cpp ("static " ^ cpp_class_name interface ^ " " ^ cname ^ "_" ^ interface_name ^ "= {\n" ); - let rec gen_interface_funcs interface = - let gen_field field = (match follow field.cf_type, field.cf_kind with - | _, Method MethDynamic -> () - | TFun (args,return_type), Method _ -> - let cast = cpp_tfun_signature ctx false args return_type in - let class_implementation = find_class_implementation ctx class_def field.cf_name interface in - let realName= cpp_member_name_of field in - let castKey = realName ^ "::" ^ cast in - (* C++ can't work out which function it needs to take the addrss of - when the implementation is overloaded - currently the map-set functions. - Change the castKey to force a glue function in this case (could double-cast the pointer, but it is ugly) - *) - let castKey = if interface_name="_hx_haxe_IMap" && realName="set" then castKey ^ "*" else castKey in - let implementationKey = realName ^ "::" ^ class_implementation in - if castKey <> implementationKey then begin - let glue = Printf.sprintf "%s_%08lx" field.cf_name (gen_hash32 0 cast) in - if not (Hashtbl.mem alreadyGlued castKey) then begin - Hashtbl.replace alreadyGlued castKey (); - let argList = ctx_tfun_arg_list ctx true args in - let returnType = ctx_type_string ctx return_type in - let returnStr = if returnType="void" then "" else "return " in - let cppCode = returnType ^ " " ^ class_name ^ "::" ^ glue ^ "(" ^ argList ^ ") {\n" ^ - "\t\t\t" ^ returnStr ^ realName ^ "(" ^ cpp_arg_names args ^ ");\n}\n" in - let headerCode = "\t\t" ^ returnType ^ " " ^ glue ^ "(" ^ argList ^ ");\n" in - header_glue := headerCode :: !header_glue; - cpp_glue := cppCode :: !cpp_glue; - end; - output_cpp (" " ^ cast ^ "&" ^ implname ^ "::" ^ glue ^ ",\n"); - end else - output_cpp (" " ^ cast ^ "&" ^ implname ^ "::" ^ realName ^ ",\n"); - | _ -> () ) - in - (match interface.cl_super with - | Some super -> gen_interface_funcs (fst super) - | _ -> ()); - List.iter gen_field interface.cl_ordered_fields; - in - gen_interface_funcs interface; - output_cpp "};\n\n"; - with Not_found -> () ) - ) implemented; - - output_cpp (String.concat "\n" !cpp_glue); - - output_cpp ("void *" ^ class_name ^ "::_hx_getInterface(int inHash) {\n"); - output_cpp "\tswitch(inHash) {\n"; - List.iter (fun interface_name -> - try let interface = Hashtbl.find implemented_hash interface_name in - output_cpp ("\t\tcase (int)" ^ (cpp_class_hash interface) ^ ": return &" ^ cname ^ "_" ^ interface_name ^ ";\n") - with Not_found -> () - ) implemented; - - output_cpp "\t}\n"; - - if class_super_name="" then begin - output_cpp ("\t#ifdef HXCPP_SCRIPTABLE\n"); - output_cpp ("\treturn super::_hx_getInterface(inHash);\n"); - output_cpp ("\t#else\n"); - output_cpp ("\treturn 0;\n"); - output_cpp ("\t#endif\n") - end else - output_cpp ("\treturn super::_hx_getInterface(inHash);\n"); - output_cpp ("}\n\n"); - end; - end; - - (match TClass.get_cl_init class_def with - | Some expression -> - let ctx = file_context baseCtx cpp_file debug false in - output_cpp ("void " ^ class_name^ "::__init__()"); - gen_cpp_init ctx (cpp_class_name class_def) "__init__" "" (mk_block expression); - output_cpp "\n\n"; - | _ -> ()); - - - let dump_field_name = (fun field -> output_cpp ("\t" ^ (strq field.cf_name) ^ ",\n")) in - - List.iter - (gen_field ctx class_def class_name smart_class_name dot_name false (has_class_flag class_def CInterface)) - class_def.cl_ordered_fields; - List.iter - (gen_field ctx class_def class_name smart_class_name dot_name true (has_class_flag class_def CInterface)) statics_except_meta; - output_cpp "\n"; - - if (List.length dynamic_functions > 0) then begin - output_cpp ("void " ^ class_name ^ "::__alloc_dynamic_functions(::hx::Ctx *_hx_ctx," ^ class_name ^ " *_hx_obj) {\n"); - List.iter (fun name -> - output_cpp ("\tif (!_hx_obj->" ^ name ^".mPtr) _hx_obj->" ^ name ^ " = new __default_" ^ name ^ "(_hx_obj);\n") - ) dynamic_functions; - (match class_def.cl_super with - | Some super -> - let rec find_super class_def = - if has_dynamic_member_functions class_def then begin - let super_name = (join_class_path_remap class_def.cl_path "::" ) ^ "_obj" in - output_cpp ("\t" ^ super_name ^ "::__alloc_dynamic_functions(_hx_ctx,_hx_obj);\n") - end else - match class_def.cl_super with - | Some super -> find_super (fst super) - | _ -> () - in - find_super (fst super); - | _ -> () - ); - output_cpp ("}\n"); - end; - - if (not (has_class_flag class_def CInterface)) && not nativeGen && not inlineContructor && not (has_class_flag class_def CAbstract) then - outputConstructor ctx output_cpp false - else if nativeGen then - outputNativeConstructor ctx output_cpp false; - - - (* Initialise non-static variables *) - if ( (not (has_class_flag class_def CInterface)) && (not nativeGen) ) then begin - output_cpp (class_name ^ "::" ^ class_name ^ "()\n{\n"); - List.iter (fun name -> - output_cpp ("\t" ^ name ^ " = new __default_" ^ name ^ "(this);\n") - ) dynamic_functions; - output_cpp "}\n\n"; - - - let dump_field_iterator macro field = - if (is_data_member field) then begin - let remap_name = keyword_remap field.cf_name in - output_cpp ("\t" ^ macro ^ "(" ^ remap_name ^ ",\"" ^ field.cf_name^ "\");\n"); - - (match field.cf_kind with Var { v_read = AccCall } when (is_dynamic_accessor ("get_" ^ field.cf_name) "get" field class_def) -> - let name = "get_" ^ field.cf_name in - output_cpp ("\t" ^ macro ^ "(" ^ name ^ "," ^ "\"" ^ name ^ "\");\n" ) | _ -> ()); - (match field.cf_kind with Var { v_write = AccCall } when (is_dynamic_accessor ("set_" ^ field.cf_name) "set" field class_def) -> - let name = "set_" ^ field.cf_name in - output_cpp ("\t" ^ macro ^ "(" ^ name ^ "," ^ "\"" ^ name ^ "\");\n" ) | _ -> ()); - end - in - - - if (override_iteration) then begin - let super_needs_iteration = find_next_super_iteration ctx class_def in - (* MARK function - explicitly mark all child pointers *) - output_cpp ("void " ^ class_name ^ "::__Mark(HX_MARK_PARAMS)\n{\n"); - output_cpp ("\tHX_MARK_BEGIN_CLASS(" ^ smart_class_name ^ ");\n"); - List.iter (dump_field_iterator "HX_MARK_MEMBER_NAME") implemented_instance_fields; - (match super_needs_iteration with - | "" -> () - | super -> output_cpp ("\t" ^ super^"::__Mark(HX_MARK_ARG);\n" ) ); - output_cpp "\tHX_MARK_END_CLASS();\n"; - output_cpp "}\n\n"; - - (* Visit function - explicitly visit all child pointers *) - output_cpp ("void " ^ class_name ^ "::__Visit(HX_VISIT_PARAMS)\n{\n"); - List.iter (dump_field_iterator "HX_VISIT_MEMBER_NAME") implemented_instance_fields; - (match super_needs_iteration with - | "" -> () - | super -> output_cpp ("\t" ^ super ^ "::__Visit(HX_VISIT_ARG);\n") ); - output_cpp "}\n\n"; - end; - - - let dump_quick_field_test fields = - if ( (List.length fields) > 0) then begin - let len = function (_,l,_) -> l in - let sfields = List.sort (fun f1 f2 -> (len f1)-(len f2)) fields in - let len_case = ref (-1) in - output_cpp "\tswitch(inName.length) {\n"; - List.iter (fun (field,l,result) -> - if (l <> !len_case) then begin - if (!len_case>=0) then output_cpp "\t\tbreak;\n"; - output_cpp ("\tcase " ^ (string_of_int l) ^ ":\n"); - len_case := l; - end; - output_cpp ("\t\tif (HX_FIELD_EQ(inName,\"" ^ (StringHelper.s_escape field) ^ "\") ) { " ^ result ^ " }\n"); - ) sfields; - output_cpp "\t}\n"; - end; - in - - let checkPropCall field = if ( (has_meta_key class_def.cl_meta Meta.NativeProperty) || - (has_meta_key field.cf_meta Meta.NativeProperty) || - (Common.defined common_ctx Define.ForceNativeProperty) ) - then - "inCallProp != ::hx::paccNever" - else - "inCallProp == ::hx::paccAlways" - in - - let toCommon t f value = - t ^ "( " ^ ( match cpp_type_of ctx f.cf_type with - | TCppInst(t, _) as inst when (has_meta_key t.cl_meta Meta.StructAccess) - -> "cpp::Struct< " ^ (tcpp_to_string inst) ^ " >( " ^ value ^ " )" - | TCppStar(t,_) -> "cpp::Pointer( " ^ value ^ " )" - | _ -> value - ) ^ " )" - in - let toVal f value = toCommon "::hx::Val" f value in - let toDynamic f value = toCommon "" f value in - - - if (has_get_member_field class_def) then begin - (* Dynamic "Get" Field function - string version *) - output_cpp ("::hx::Val " ^ class_name ^ "::__Field(const ::String &inName,::hx::PropertyAccess inCallProp)\n{\n"); - let get_field_dat = List.map (fun f -> - (f.cf_name, String.length f.cf_name, - (match f.cf_kind with - | Var { v_read = AccCall } when not (is_physical_field f) -> - "if (" ^ (checkPropCall f) ^ ") return " ^ (toVal f ((keyword_remap ("get_" ^ f.cf_name)) ^ "()" ) ) ^ ";" - | Var { v_read = AccCall } -> "return " ^ (toVal f ((checkPropCall f) ^ " ? " ^ (keyword_remap ("get_" ^ f.cf_name)) ^ "() : " ^ - ((keyword_remap f.cf_name) ^ (if (variable_field f) then "" else "_dyn()")) ) ) ^ ";" - | _ -> "return " ^ (toVal f (((keyword_remap f.cf_name) ^ if (variable_field f) then "" else "_dyn()"))) ^ ";" - ) ) ) - in - dump_quick_field_test (get_field_dat reflect_member_readable); - output_cpp ("\treturn super::__Field(inName,inCallProp);\n}\n\n"); - - end; - - if (has_get_static_field class_def) then begin - output_cpp ("bool " ^ class_name ^ "::__GetStatic(const ::String &inName, Dynamic &outValue, ::hx::PropertyAccess inCallProp)\n{\n"); - let get_field_dat = List.map (fun f -> - (f.cf_name, String.length f.cf_name, - (match f.cf_kind with - | Var { v_read = AccCall } when not (is_physical_field f) -> - "if (" ^ (checkPropCall f) ^ ") { outValue = " ^ (toDynamic f (keyword_remap ("get_" ^ f.cf_name) ^ "()")) ^ "; return true; }" - | Var { v_read = AccCall } -> "outValue = " ^ (toDynamic f ((checkPropCall f) ^ " ? " ^ (keyword_remap ("get_" ^ f.cf_name)) ^ "() : " ^ - ((keyword_remap f.cf_name) ^ if (variable_field f) then "" else "_dyn()"))) ^ "; return true;"; - | _ when variable_field f -> "outValue = " ^ (toDynamic f (keyword_remap f.cf_name)) ^ "; return true;" - | _ -> "outValue = " ^ ((native_field_name_remap true f) ^ "_dyn(); return true;") - ) - ) ) - in - dump_quick_field_test (get_field_dat reflect_static_readable); - output_cpp ("\treturn false;\n}\n\n"); - end; - - let castable f = - match cpp_type_of ctx f.cf_type with - | TCppInst(t, _) as inst when (has_meta_key t.cl_meta Meta.StructAccess) - -> "cpp::Struct< " ^ (tcpp_to_string inst) ^ " > " - | TCppStar(t,_) -> "cpp::Pointer< " ^ ( tcpp_to_string t ) ^ " >" - | _ -> ctx_type_string ctx f.cf_type - in - - (* Dynamic "Set" Field function *) - if (has_set_member_field class_def) then begin - - output_cpp ("::hx::Val " ^ class_name ^ "::__SetField(const ::String &inName,const ::hx::Val &inValue,::hx::PropertyAccess inCallProp)\n{\n"); - - let set_field_dat = List.map (fun f -> - let default_action = if is_gc_element ctx (cpp_type_of ctx f.cf_type) then - "_hx_set_" ^ (keyword_remap f.cf_name) ^ "(HX_CTX_GET,inValue.Cast< " ^ (castable f) ^ " >());" ^ " return inValue;" - else - (keyword_remap f.cf_name) ^ "=inValue.Cast< " ^ (castable f) ^ " >();" ^ " return inValue;" - in - (f.cf_name, String.length f.cf_name, - (match f.cf_kind with - | Var { v_write = AccCall } -> - let inVal = "(inValue.Cast< " ^ (castable f) ^ " >())" in - let setter = keyword_remap ("set_" ^ f.cf_name) in - "if (" ^ (checkPropCall f) ^ ") return " ^ (toVal f (setter ^inVal) ) ^ ";" ^ - ( if not (is_physical_field f) then "" else default_action ) - | _ -> default_action - ) - ) - ) in - - dump_quick_field_test (set_field_dat reflect_write_member_variables); - output_cpp ("\treturn super::__SetField(inName,inValue,inCallProp);\n}\n\n"); - end; - - if (has_set_static_field class_def) then begin - - output_cpp ("bool " ^ class_name ^ "::__SetStatic(const ::String &inName,Dynamic &ioValue,::hx::PropertyAccess inCallProp)\n{\n"); - - let set_field_dat = List.map (fun f -> - let default_action = - (keyword_remap f.cf_name) ^ "=ioValue.Cast< " ^ (castable f) ^ " >(); return true;" in - (f.cf_name, String.length f.cf_name, - (match f.cf_kind with - | Var { v_write = AccCall } -> - let inVal = "(ioValue.Cast< " ^ (castable f) ^ " >())" in - let setter = keyword_remap ("set_" ^ f.cf_name) in - "if (" ^ (checkPropCall f) ^ ") ioValue = " ^ (toDynamic f (setter ^ inVal) ) ^ ";" - ^ ( if not (is_physical_field f) then "" else " else " ^ default_action ) - | _ -> default_action - ) - ) - ) in - - dump_quick_field_test (set_field_dat reflect_write_static_variables); - output_cpp ("\treturn false;\n}\n\n"); - end; - - - - - (* For getting a list of data members (eg, for serialization) *) - if (has_get_fields class_def) then begin - let append_field = - (fun field -> output_cpp ("\toutFields->push(" ^( strq field.cf_name )^ ");\n")) in - let is_data_field field = (match follow field.cf_type with | TFun _ -> false | _ -> true) in - - output_cpp ("void " ^ class_name ^ "::__GetFields(Array< ::String> &outFields)\n{\n"); - List.iter append_field (List.filter is_data_field class_def.cl_ordered_fields); - output_cpp "\tsuper::__GetFields(outFields);\n"; - output_cpp "};\n\n"; - end; - - let storage field = match (cpp_type_of ctx field.cf_type) with - | TCppScalar("bool") -> "::hx::fsBool" - | TCppScalar("int") -> "::hx::fsInt" - | TCppScalar("Float") -> "::hx::fsFloat" - | TCppString -> "::hx::fsString" - | o when is_object_element ctx o -> "::hx::fsObject" ^ " /* " ^ (tcpp_to_string o ) ^ " */ " - | u -> "::hx::fsUnknown" ^ " /* " ^ (tcpp_to_string u) ^ " */ " - in - let dump_member_storage = (fun field -> - output_cpp ("\t{" ^ (storage field) ^ ",(int)offsetof(" ^ class_name ^"," ^ (keyword_remap field.cf_name) ^")," ^ - (strq field.cf_name) ^ "},\n") - ) - in - let dump_static_storage = (fun field -> - output_cpp ("\t{" ^ (storage field) ^ ",(void *) &" ^ class_name ^"::" ^ (keyword_remap field.cf_name) ^"," ^ - (strq field.cf_name) ^ "},\n") - ) - in - - output_cpp "#ifdef HXCPP_SCRIPTABLE\n"; - - let stored_fields = List.filter is_data_member implemented_instance_fields in - if ( (List.length stored_fields) > 0) then begin - output_cpp ("static ::hx::StorageInfo " ^ class_name ^ "_sMemberStorageInfo[] = {\n"); - List.iter dump_member_storage stored_fields; - output_cpp "\t{ ::hx::fsUnknown, 0, null()}\n};\n"; - end else - output_cpp ("static ::hx::StorageInfo *" ^ class_name ^ "_sMemberStorageInfo = 0;\n"); - - let stored_statics = List.filter is_data_member implemented_fields in - if ( (List.length stored_statics) > 0) then begin - output_cpp ("static ::hx::StaticInfo " ^ class_name ^ "_sStaticStorageInfo[] = {\n"); - List.iter dump_static_storage stored_statics; - output_cpp "\t{ ::hx::fsUnknown, 0, null()}\n};\n"; - end else - output_cpp ("static ::hx::StaticInfo *" ^ class_name ^ "_sStaticStorageInfo = 0;\n"); - - output_cpp "#endif\n\n"; - end; (* cl_interface *) - - let sMemberFields = if List.length reflective_members>0 then begin - let memberFields = class_name ^ "_sMemberFields" in - output_cpp ("static ::String " ^ memberFields ^ "[] = {\n"); - List.iter dump_field_name reflective_members; - output_cpp "\t::String(null()) };\n\n"; - memberFields - end else - "0 /* sMemberFields */"; - in - - let hasMarkFunc = (not nativeGen) && (List.exists is_data_member implemented_fields) in - - if (hasMarkFunc) then begin - (* Mark static variables as used *) - output_cpp ("static void " ^ class_name ^ "_sMarkStatics(HX_MARK_PARAMS) {\n"); - List.iter (fun field -> - if (is_data_member field) then - output_cpp ("\tHX_MARK_MEMBER_NAME(" ^ class_name ^ "::" ^ (keyword_remap field.cf_name) ^ ",\"" ^ field.cf_name ^ "\");\n") ) - implemented_fields; - output_cpp "};\n\n"; - - (* Visit static variables *) - output_cpp "#ifdef HXCPP_VISIT_ALLOCS\n"; - output_cpp ("static void " ^ class_name ^ "_sVisitStatics(HX_VISIT_PARAMS) {\n"); - List.iter (fun field -> - if (is_data_member field) then - output_cpp ("\tHX_VISIT_MEMBER_NAME(" ^ class_name ^ "::" ^ (keyword_remap field.cf_name) ^ ",\"" ^ field.cf_name ^ "\");\n") ) - implemented_fields; - output_cpp "};\n\n"; - output_cpp "#endif\n\n"; - end; - - let generate_script_function isStatic field scriptName callName = - match follow field.cf_type with - | TFun (args,return_type) when not (is_data_member field) -> - let isTemplated = not isStatic && not (has_class_flag class_def CInterface) in - if isTemplated then output_cpp ("\ntemplate"); - output_cpp ("\nstatic void CPPIA_CALL " ^ scriptName ^ "(::hx::CppiaCtx *ctx) {\n"); - let ret = match cpp_type_of ctx return_type with TCppScalar("bool") -> "b" | _ -> script_signature return_type false in - if (ret<>"v") then output_cpp ("ctx->return" ^ (script_type return_type false) ^ "("); - - - let dump_call cast = - if (has_class_flag class_def CInterface) then begin - output_cpp (class_name ^ "::" ^ callName ^ "(ctx->getThis()" ^ (if (List.length args) > 0 then "," else "")); - end else if isStatic then - output_cpp (class_name ^ "::" ^ callName ^ "(") - else - output_cpp ("((" ^ class_name ^ "*)ctx->getThis())->" ^ cast ^ callName ^ "("); - - let (signature,_,_) = List.fold_left (fun (signature,sep,size) (_,opt,t) -> - output_cpp (sep ^ "ctx->get" ^ (script_type t opt) ^ "(" ^ size ^ ")"); - (signature ^ (script_signature t opt ), ",", (size^"+sizeof(" ^ (script_size_type t opt) ^ ")") ) ) (ret,"","sizeof(void*)") args - in - output_cpp ")"; - signature - in - let signature = - if isTemplated then begin - output_cpp (" _HX_SUPER ? "); - ignore( dump_call (class_name ^ "::") ); - output_cpp (" : "); - dump_call "" - end else - dump_call ""; - in - - if (ret<>"v") then output_cpp (")"); - output_cpp (";\n}\n"); - signature; - | _ -> "" - in - - - let newInteface = (has_class_flag class_def CInterface) in - - if (scriptable && not nativeGen) then begin - let delegate = "this->" in - let dump_script_field idx (field,f_args,return_t) = - let args = ctx_tfun_arg_list ctx true f_args in - let names = List.map (fun (n,_,_) -> keyword_remap n) f_args in - let return_type = ctx_type_string ctx return_t in - let ret = if (return_type="Void" || return_type="void") then " " else "return " in - let name = keyword_remap field.cf_name in - let vtable = "__scriptVTable[" ^ (string_of_int (idx+1) ) ^ "] " in - let args_varray = (List.fold_left (fun l n -> l ^ ".Add(" ^ n ^ ")") "Array()" names) in - - output_cpp (" " ^ return_type ^ " " ^ name ^ "( " ^ args ^ " ) {\n"); - if newInteface then begin - output_cpp ("\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n" ); - output_cpp ("\t\t::hx::AutoStack __as(__ctx);\n" ); - output_cpp ("\t\t__ctx->pushObject(this);\n" ); - List.iter (fun (name,opt, t ) -> - output_cpp ("\t\t__ctx->push" ^ (script_type t opt) ^ "(" ^ (keyword_remap name) ^ ");\n" ); - ) f_args; - let interfaceSlot = string_of_int( -(cpp_get_interface_slot ctx name) ) in - output_cpp ("\t\t" ^ ret ^ "__ctx->run" ^ (script_type return_t false) ^ "(__GetScriptVTable()[" ^ interfaceSlot ^ "]);\n" ); - output_cpp "\t}\n"; - end else begin - output_cpp ("\tif (" ^ vtable ^ ") {\n" ); - output_cpp ("\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n" ); - output_cpp ("\t\t::hx::AutoStack __as(__ctx);\n" ); - output_cpp ("\t\t__ctx->pushObject(" ^ (if (has_class_flag class_def CInterface) then "mDelegate.mPtr" else "this" ) ^");\n" ); - List.iter (fun (name,opt, t ) -> - output_cpp ("\t\t__ctx->push" ^ (script_type t opt) ^ "(" ^ (keyword_remap name) ^ ");\n" ); - ) f_args; - output_cpp ("\t\t" ^ ret ^ "__ctx->run" ^ (script_type return_t false) ^ "(" ^ vtable ^ ");\n" ); - output_cpp ("\t} else " ^ ret ); - - - if ((has_class_flag class_def CInterface)) then begin - output_cpp (" " ^ delegate ^ "__Field(HX_CSTRING(\"" ^ field.cf_name ^ "\"), ::hx::paccNever)"); - if (List.length names <= 5) then - output_cpp ("->__run(" ^ (String.concat "," names) ^ ");") - else - output_cpp ("->__Run(" ^ args_varray ^ ");"); - end else - output_cpp (class_name ^ "::" ^ name ^ "(" ^ (String.concat "," names)^ ");"); - if (return_type<>"void") then - output_cpp "return null();"; - output_cpp "}\n"; - if ((has_class_flag class_def CInterface)) && not dynamic_interface_closures then begin - output_cpp (" Dynamic " ^ name ^ "_dyn() { return mDelegate->__Field(HX_CSTRING(\"" ^ field.cf_name ^ "\"), ::hx::paccNever); }\n\n"); - - end - end - in - - let new_sctipt_functions = if newInteface then - all_virtual_functions class_def - else - List.rev (current_virtual_functions_rev class_def []) - in - let sctipt_name = class_name ^ "__scriptable" in - - if newInteface then begin - output_cpp ("class " ^ sctipt_name ^ " : public ::hx::Object {\n" ); - output_cpp "public:\n"; - end else begin - output_cpp ("class " ^ sctipt_name ^ " : public " ^ class_name ^ " {\n" ); - output_cpp (" typedef "^sctipt_name ^" __ME;\n"); - output_cpp (" typedef "^class_name ^" super;\n"); - let has_funky_toString = List.exists (fun f -> f.cf_name="toString") class_def.cl_ordered_statics || - List.exists (fun f -> f.cf_name="toString" && field_arg_count f <> 0) class_def.cl_ordered_fields in - let super_string = if has_funky_toString then class_name ^ "::super" else class_name in - output_cpp (" typedef "^ super_string ^" __superString;\n"); - if ((has_class_flag class_def CInterface)) then - output_cpp (" HX_DEFINE_SCRIPTABLE_INTERFACE\n") - else begin - output_cpp (" HX_DEFINE_SCRIPTABLE(HX_ARR_LIST" ^ (string_of_int (List.length constructor_var_list) ) ^ ")\n"); - output_cpp "\tHX_DEFINE_SCRIPTABLE_DYNAMIC;\n"; - end; - end; - - list_iteri dump_script_field functions; - output_cpp ("};\n\n"); - - let sigs = Hashtbl.create 0 in - - let static_functions = (List.filter (fun f-> not (is_data_member f) ) reflect_static_fields) in - let all_script_functions = (List.map (fun (f,_,_)->f) new_sctipt_functions) @ static_functions in - - if (List.length all_script_functions) > 0 then begin - List.iter (fun (f,_,_) -> - let s = generate_script_function false f ("__s_" ^f.cf_name) (keyword_remap f.cf_name) in - Hashtbl.add sigs f.cf_name s - ) new_sctipt_functions; - - let dump_script_static f = - let s = generate_script_function true f ("__s_" ^f.cf_name) (keyword_remap f.cf_name) in - Hashtbl.add sigs f.cf_name s - in - List.iter dump_script_static class_def.cl_ordered_statics; - - output_cpp "#ifndef HXCPP_CPPIA_SUPER_ARG\n"; - output_cpp "#define HXCPP_CPPIA_SUPER_ARG(x)\n"; - output_cpp "#endif\n"; - output_cpp "static ::hx::ScriptNamedFunction __scriptableFunctions[] = {\n"; - let dump_func f isStaticFlag = - let s = try Hashtbl.find sigs f.cf_name with Not_found -> "v" in - output_cpp (" ::hx::ScriptNamedFunction(\"" ^ f.cf_name ^ "\",__s_" ^ f.cf_name ^ ",\"" ^ s ^ "\", " ^ isStaticFlag ^ " " ); - let superCall = if (isStaticFlag="true") || (has_class_flag class_def CInterface) then "0" else ("__s_" ^ f.cf_name ^ "") in - output_cpp ("HXCPP_CPPIA_SUPER_ARG(" ^ superCall ^")" ); - output_cpp (" ),\n" ) - in - List.iter (fun (f,_,_) -> dump_func f "false") new_sctipt_functions; - List.iter (fun f -> dump_func f "true") static_functions; - output_cpp " ::hx::ScriptNamedFunction(0,0,0 HXCPP_CPPIA_SUPER_ARG(0) ) };\n"; - end else - output_cpp "static ::hx::ScriptNamedFunction *__scriptableFunctions = 0;\n"; - - if newInteface then begin - output_cpp ("\n\n" ^ class_name ^ " " ^ class_name ^ "_scriptable = {\n"); - List.iter (fun (f,args,return_type) -> - let cast = cpp_tfun_signature ctx true args return_type in - output_cpp ("\t" ^ cast ^ "&" ^ sctipt_name ^ "::" ^ (keyword_remap f.cf_name) ^ ",\n") - ) new_sctipt_functions; - output_cpp ("};\n"); - end; - - end; - - - let class_name_text = join_class_path class_path "." in - - (* Initialise static in boot function ... *) - if (not (has_class_flag class_def CInterface) && not nativeGen) then begin - (* Remap the specialised "extern" classes back to the generic names *) - output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); - if (scriptable) then begin - (match class_def.cl_constructor with - | Some field -> - let signature = generate_script_function false field "__script_construct_func" "__construct" in - output_cpp ("::hx::ScriptFunction " ^ class_name ^ "::__script_construct(__script_construct_func,\"" ^ signature ^ "\");\n"); - | _ -> - output_cpp ("::hx::ScriptFunction " ^ class_name ^ "::__script_construct(0,0);\n"); - ); - end; +let make_base_directory dir = + Path.mkdir_recursive "" ( ( Str.split_delim (Str.regexp "[\\/]+") dir ) ) - let reflective_statics = List.filter (reflective class_def) implemented_fields in - let sStaticFields = if List.length reflective_statics > 0 then begin - output_cpp ("static ::String " ^ class_name ^ "_sStaticFields[] = {\n"); - List.iter dump_field_name reflective_statics; - output_cpp "\t::String(null())\n};\n\n"; - class_name ^ "_sStaticFields"; - end else - "0 /* sStaticFields */" +let get_meta_string meta key = + let rec loop = function + | [] -> "" + | (k,[Ast.EConst (Ast.String(name,_)),_],_) :: _ when k=key-> name + | _ :: l -> loop l in + loop meta - output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); - if (not (has_class_flag class_def CAbstract)) then begin - output_cpp ("\t" ^ class_name ^ " _hx_dummy;\n"); - output_cpp ("\t" ^ class_name ^ "::_hx_vtable = *(void **)&_hx_dummy;\n"); - end; - output_cpp ("\t::hx::Static(__mClass) = new ::hx::Class_obj();\n"); - output_cpp ("\t__mClass->mName = " ^ (strq class_name_text) ^ ";\n"); - output_cpp ("\t__mClass->mSuper = &super::__SGetClass();\n"); - if (not (has_class_flag class_def CAbstract)) then begin - output_cpp ("\t__mClass->mConstructEmpty = &__CreateEmpty;\n"); - output_cpp ("\t__mClass->mConstructArgs = &__Create;\n"); - end; - output_cpp ("\t__mClass->mGetStaticField = &" ^ ( - if (has_get_static_field class_def) then class_name ^ "::__GetStatic;\n" else "::hx::Class_obj::GetNoStaticField;\n" )); - output_cpp ("\t__mClass->mSetStaticField = &" ^ ( - if (has_set_static_field class_def) then class_name ^ "::__SetStatic;\n" else "::hx::Class_obj::SetNoStaticField;\n" )); - if hasMarkFunc then - output_cpp ("\t__mClass->mMarkFunc = " ^ class_name ^ "_sMarkStatics;\n"); - output_cpp ("\t__mClass->mStatics = ::hx::Class_obj::dupFunctions(" ^ sStaticFields ^ ");\n"); - output_cpp ("\t__mClass->mMembers = ::hx::Class_obj::dupFunctions(" ^ sMemberFields ^ ");\n"); - output_cpp ("\t__mClass->mCanCast = ::hx::TCanCast< " ^ class_name ^ " >;\n"); - if hasMarkFunc then - output_cpp ("#ifdef HXCPP_VISIT_ALLOCS\n\t__mClass->mVisitFunc = " ^ class_name ^ "_sVisitStatics;\n#endif\n"); - output_cpp ("#ifdef HXCPP_SCRIPTABLE\n\t__mClass->mMemberStorageInfo = " ^ class_name ^ "_sMemberStorageInfo;\n#endif\n"); - output_cpp ("#ifdef HXCPP_SCRIPTABLE\n\t__mClass->mStaticStorageInfo = " ^ class_name ^ "_sStaticStorageInfo;\n#endif\n"); - output_cpp ("\t::hx::_hx_RegisterClass(__mClass->mName, __mClass);\n"); - if (scriptable) then - output_cpp (" HX_SCRIPTABLE_REGISTER_CLASS(\""^class_name_text^"\"," ^ class_name ^ ");\n"); - Hashtbl.iter (fun _ intf_def -> - output_cpp ("\tHX_REGISTER_VTABLE_OFFSET( " ^ class_name ^ "," ^ (join_class_path_remap intf_def.cl_path "::")^ ");\n"); - ) native_implemented; - output_cpp ("}\n\n"); - end else if not nativeGen then begin - output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); - - output_cpp ("void " ^ class_name ^ "::__register()\n{\n"); - - output_cpp ("\t::hx::Static(__mClass) = new ::hx::Class_obj();\n"); - output_cpp ("\t__mClass->mName = " ^ (strq class_name_text) ^ ";\n"); - output_cpp ("\t__mClass->mSuper = &super::__SGetClass();\n"); - if hasMarkFunc then - output_cpp ("\t__mClass->mMarkFunc = " ^ class_name ^ "_sMarkStatics;\n"); - output_cpp ("\t__mClass->mMembers = ::hx::Class_obj::dupFunctions(" ^ sMemberFields ^ ");\n"); - output_cpp ("\t__mClass->mCanCast = ::hx::TIsInterface< (int)" ^ (cpp_class_hash class_def) ^ " >;\n"); - if hasMarkFunc then - output_cpp ("#ifdef HXCPP_VISIT_ALLOCS\n\t__mClass->mVisitFunc = " ^ class_name ^ "_sVisitStatics;\n#endif\n"); - output_cpp ("\t::hx::_hx_RegisterClass(__mClass->mName, __mClass);\n"); - if (scriptable) then - output_cpp (" HX_SCRIPTABLE_REGISTER_INTERFACE(\""^class_name_text^"\"," ^ class_name ^ ");\n"); - output_cpp ("}\n\n"); - end; - - if (has_boot_field class_def) then begin - output_cpp ("void " ^ class_name ^ "::__boot()\n{\n"); - - List.iter (gen_field_init ctx class_def ) (List.filter should_implement_field class_def.cl_ordered_statics); - - output_cpp ("}\n\n"); - end; - - - gen_close_namespace output_cpp class_path; - - if (has_class_flag class_def CInterface) && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin - let full_class_name = ("::" ^ (join_class_path_remap class_path "::") ) ^ "_obj" in - let protocol = get_meta_string class_def.cl_meta Meta.ObjcProtocol in - generate_protocol_delegate ctx class_def output_cpp; - output_cpp ("id<" ^ protocol ^ "> " ^ full_class_name ^ "::_hx_toProtocol(Dynamic inImplementation) {\n"); - output_cpp ("\treturn [ [_hx_" ^ protocol ^ "_delegate alloc] initWithImplementation:inImplementation.mPtr];\n"); - output_cpp ("}\n\n"); - end; - - - cpp_file#close; - in - (* - Header code - *) - let generate_class_header () = - let common_ctx = baseCtx.ctx_common in - let class_path = class_def.cl_path in - let nativeGen = has_meta_key class_def.cl_meta Meta.NativeGen in - let class_name = (snd class_path) ^ (if nativeGen then "" else "_obj") in - let smart_class_name = (snd class_path) in - let scriptable = inScriptable && not class_def.cl_private in - (*let cpp_file = new_cpp_file common_ctx.file class_path in*) - let debug = if (has_meta_key class_def.cl_meta Meta.NoDebug) || ( Common.defined baseCtx.ctx_common Define.NoDebug) - then 0 else 1 in - - let h_file = new_header_file common_ctx common_ctx.file class_path in - let ctx = file_context baseCtx h_file debug true in - let strq = strq ctx.ctx_common in - - - let parent,super = match class_def.cl_super with - | Some (klass,params) -> - let name = (tcpp_to_string_suffix "_obj" (cpp_instance_type ctx klass params) ) in - (if (has_class_flag class_def CInterface) && nativeGen then "virtual " else "" ) ^ name, name - | None when nativeGen && (has_class_flag class_def CInterface) -> "virtual ::hx::NativeInterface", "::hx::NativeInterface" - | None when (has_class_flag class_def CInterface) -> "", "::hx::Object" - | None when nativeGen -> "", "" - | None -> "::hx::Object", "::hx::Object" +let get_meta_string_path meta key = + let rec loop = function + | [] -> "" + | (k,[Ast.EConst (Ast.String(name,_)),_], pos) :: _ when k=key-> + make_path_absolute name pos + | _ :: l -> loop l in - let output_h = (h_file#write) in - let def_string = join_class_path class_path "_" in - - - begin_header_file (h_file#write_h) def_string nativeGen; - - (* Include the real header file for the super class *) - (match class_def.cl_super with - | Some super -> - let klass = fst super in - let include_files = get_all_meta_string_path klass.cl_meta Meta.Include in - if List.length include_files > 0 then - List.iter (fun inc -> h_file#add_include (path_of_string inc)) include_files - else - h_file#add_include klass.cl_path - | _ -> () ); - - (* And any interfaces ... *) - List.iter (fun imp-> - let interface = fst imp in - let include_files = get_all_meta_string_path interface.cl_meta Meta.Include in - if List.length include_files > 0 then - List.iter (fun inc -> h_file#add_include (path_of_string inc)) include_files - else - h_file#add_include interface.cl_path) - (real_interfaces class_def.cl_implements); - - (* Only need to forward-declare classes that are mentioned in the header file - (ie, not the implementation) *) - let header_referenced,header_flags = find_referenced_types_flags ctx (TClassDecl class_def) "*" super_deps (Hashtbl.create 0) true false scriptable in - List.iter2 ( fun r f -> gen_forward_decl h_file r f ) header_referenced header_flags; - output_h "\n"; - - output_h ( get_class_code class_def Meta.HeaderCode ); - let includes = get_all_meta_string_path class_def.cl_meta Meta.HeaderInclude in - let printer = fun inc -> output_h ("#include \"" ^ inc ^ "\"\n") in - List.iter printer includes; - - gen_open_namespace output_h class_path; - output_h "\n\n"; - output_h ( get_class_code class_def Meta.HeaderNamespaceCode ); - - let extern_class = Common.defined common_ctx Define.DllExport in - let attribs = "HXCPP_" ^ (if extern_class then "EXTERN_" else "") ^ "CLASS_ATTRIBUTES" in - - let dump_native_interfaces () = - List.iter ( fun(c,params) -> - output_h (" , public virtual " ^ (join_class_path c.cl_path "::") ) - ) (List.filter (fun (t,_) -> is_native_gen_class t) class_def.cl_implements); - in - - if ((has_class_flag class_def CInterface) && not nativeGen) then begin - output_h ("class " ^ attribs ^ " " ^ class_name ^ " {\n"); - output_h "\tpublic:\n"; - output_h ("\t\ttypedef " ^ super ^ " super;\n"); - end else if (super="") then begin - output_h ("class " ^ attribs ^ " " ^ class_name); - dump_native_interfaces(); - output_h "\n{\n\tpublic:\n"; - end else begin - output_h ("class " ^ attribs ^ " " ^ class_name ^ " : public " ^ parent ); - dump_native_interfaces(); - output_h "\n{\n\tpublic:\n"; - if not nativeGen then begin - output_h ("\t\ttypedef " ^ super ^ " super;\n"); - output_h ("\t\ttypedef " ^ class_name ^ " OBJ_;\n"); - end - end; - - - - if (not (has_class_flag class_def CInterface) && not nativeGen) then begin - output_h ("\t\t" ^ class_name ^ "();\n"); - output_h "\n\tpublic:\n"; - output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); - output_h ("\t\tvoid __construct(" ^ constructor_type_args ^ ");\n"); - output_h ("\t\tinline void *operator new(size_t inSize, bool inContainer=" ^ isContainer ^",const char *inName=" ^ gcName ^ ")\n" ); - output_h ("\t\t\t{ return ::hx::Object::operator new(inSize,inContainer,inName); }\n" ); - output_h ("\t\tinline void *operator new(size_t inSize, int extra)\n" ); - output_h ("\t\t\t{ return ::hx::Object::operator new(inSize+extra," ^ isContainer ^ "," ^ gcName ^ "); }\n" ); - if has_class_flag class_def CAbstract then - output_h "\n" - else if inlineContructor then begin - output_h "\n"; - outputConstructor ctx (fun str -> output_h ("\t\t" ^ str) ) true - end else begin - output_h ("\t\tstatic " ^ptr_name^ " __new(" ^constructor_type_args ^");\n"); - if can_quick_alloc then - output_h ("\t\tstatic " ^ptr_name^ " __alloc(::hx::Ctx *_hx_ctx" ^ - (if constructor_type_args="" then "" else "," ^constructor_type_args) ^");\n"); - end; - if (not (has_class_flag class_def CAbstract)) then begin - output_h ("\t\tstatic void * _hx_vtable;\n"); - output_h ("\t\tstatic Dynamic __CreateEmpty();\n"); - output_h ("\t\tstatic Dynamic __Create(::hx::DynamicArray inArgs);\n"); - end; - if (List.length dynamic_functions > 0) then - output_h ("\t\tstatic void __alloc_dynamic_functions(::hx::Ctx *_hx_alloc," ^ class_name ^ " *_hx_obj);\n"); - if (scriptable) then - output_h ("\t\tstatic ::hx::ScriptFunction __script_construct;\n"); - output_h ("\t\t//~" ^ class_name ^ "();\n\n"); - output_h ("\t\tHX_DO_RTTI_ALL;\n"); - if (has_get_member_field class_def) then - output_h ("\t\t::hx::Val __Field(const ::String &inString, ::hx::PropertyAccess inCallProp);\n"); - if (has_get_static_field class_def) then - output_h ("\t\tstatic bool __GetStatic(const ::String &inString, Dynamic &outValue, ::hx::PropertyAccess inCallProp);\n"); - if (has_set_member_field class_def) then - output_h ("\t\t::hx::Val __SetField(const ::String &inString,const ::hx::Val &inValue, ::hx::PropertyAccess inCallProp);\n"); - if (has_set_static_field class_def) then - output_h ("\t\tstatic bool __SetStatic(const ::String &inString, Dynamic &ioValue, ::hx::PropertyAccess inCallProp);\n"); - if (has_get_fields class_def) then - output_h ("\t\tvoid __GetFields(Array< ::String> &outFields);\n"); - - if (has_compare_field class_def) then - output_h ("\t\tint __Compare(const ::hx::Object *inRHS) const { " ^ - "return const_cast<" ^ class_name ^ " *>(this)->__compare(Dynamic((::hx::Object *)inRHS)); }\n"); - - output_h ("\t\tstatic void __register();\n"); - if (override_iteration) then begin - output_h ("\t\tvoid __Mark(HX_MARK_PARAMS);\n"); - output_h ("\t\tvoid __Visit(HX_VISIT_PARAMS);\n"); - end; - - if (implementsNative) then begin - output_h ("\n\t\tHX_NATIVE_IMPLEMENTATION\n"); - List.iter (fun field -> - match follow field.cf_type, field.cf_kind with - | _, Method MethDynamic -> () - | TFun (args,return_type), _ -> - let retVal = ctx_type_string ctx return_type in - let ret = if retVal="void" then "" else "return " in - let name = keyword_remap field.cf_name in - let argNames = List.map (fun (name,_,_) -> keyword_remap name ) args in - output_h ( "\t\t" ^ retVal ^" " ^ name ^ "( " ^ ctx_tfun_arg_list ctx true args ^ ") {\n"); - output_h ( "\t\t\t" ^ ret ^ "super::" ^ name ^ "( " ^ (String.concat "," argNames) ^ ");\n\t\t}\n"); - | _ -> () - ) neededInterfaceFunctions; - output_h ("\n"); - end; - - output_h ("\t\tbool _hx_isInstanceOf(int inClassId);\n"); - if ( (List.length implemented) > 0 ) then begin - output_h "\t\tvoid *_hx_getInterface(int inHash);\n"; - output_h (String.concat "\n" !header_glue); - end; - - - if (has_init_field class_def) then - output_h "\t\tstatic void __init__();\n\n"; - output_h ("\t\t::String __ToString() const { return " ^ (strq smart_class_name) ^ "; }\n\n"); - end else if not nativeGen then begin - output_h ("\t\tHX_DO_INTERFACE_RTTI;\n\n"); - end else begin - outputNativeConstructor ctx output_h true; - (* native interface *) ( ) - end; - - if (has_boot_field class_def) then - output_h ("\t\tstatic void __boot();\n"); - - - (match class_def.cl_array_access with - | Some t -> output_h ("\t\ttypedef " ^ (type_string t) ^ " __array_access;\n") - | _ -> ()); - - - List.iter (gen_member_def ctx class_def true (has_class_flag class_def CInterface)) (List.filter should_implement_field class_def.cl_ordered_statics); - - if (has_class_flag class_def CInterface) then begin - List.iter (fun (field,_,_) -> gen_member_def ctx class_def false true field) functions; - end else begin - List.iter (gen_member_def ctx class_def false false) (List.filter should_implement_field class_def.cl_ordered_fields); - end; - - if (has_class_flag class_def CInterface) && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin - let protocol = get_meta_string class_def.cl_meta Meta.ObjcProtocol in - output_h ("\t\tstatic id<" ^ protocol ^ "> _hx_toProtocol(Dynamic inImplementation);\n"); - end; - - - output_h ( get_class_code class_def Meta.HeaderClassCode ); - output_h "};\n\n"; - - gen_close_namespace output_h class_path; - - end_header_file output_h def_string; - h_file#close; - - in - - (* create header and cpp files *) - if not (nativeGen && (has_class_flag class_def CInterface)) then - generate_class_cpp (); - generate_class_header () -;; - -let generate_class_deps ctx class_def super_deps constructor_deps scriptable = - find_referenced_types ctx (TClassDecl class_def) super_deps constructor_deps false true scriptable -;; - - - + loop meta let write_resources common_ctx = @@ -6976,9 +99,7 @@ let write_resources common_ctx = resource_file#end_block_line; resource_file#write ";\n\n"; resource_file#write "namespace hx { Resource *GetResources() { return __Resources; } }\n"; - resource_file#close;; - - + resource_file#close let write_build_data common_ctx filename classes main_deps boot_deps build_extra extern_src exe_name = let buildfile = open_out filename in @@ -7006,7 +127,7 @@ let write_build_data common_ctx filename classes main_deps boot_deps build_extra in output_string buildfile "\n"; - let api_string = (Common.defined_value common_ctx Define.HxcppApiLevel) in + let api_string = (Gctx.defined_value common_ctx Define.HxcppApiLevel) in output_string buildfile ("\n"); output_string buildfile "\n"; output_string buildfile "\n"; @@ -7039,10 +160,10 @@ let write_build_data common_ctx filename classes main_deps boot_deps build_extra output_string buildfile ("\n"); output_string buildfile "\n"; output_string buildfile build_extra; - if (Common.defined common_ctx Define.HxcppSmartStings) then + if (Gctx.defined common_ctx Define.HxcppSmartStings) then output_string buildfile ("\n"); output_string buildfile "\n"; - close_out buildfile;; + close_out buildfile let write_build_options common_ctx filename defines = let writer = cached_source_writer common_ctx filename in @@ -7056,7 +177,7 @@ let write_build_options common_ctx filename defines = write_define "hxcpp" (Stdlib.input_line pin); Stdlib.ignore (Process_helper.close_process_in_pid (pin,pid)); end; - writer#close;; + writer#close let create_member_types common_ctx = let result = Hashtbl.create 0 in @@ -7073,1445 +194,20 @@ let create_member_types common_ctx = (match class_def.cl_super with Some super -> add_override (fst super) | _->()) | _ -> () ) ) common_ctx.types; - result;; - -(* Builds inheritance tree, so header files can include parents defs. *) -let create_super_dependencies common_ctx = - let result = Hashtbl.create 0 in - List.iter (fun object_def -> - (match object_def with - | TClassDecl class_def when not (has_class_flag class_def CExtern) -> - let deps = ref [] in - (match class_def.cl_super with Some super -> - if not (has_class_flag (fst super) CExtern) then - deps := ((fst super).cl_path) :: !deps - | _ ->() ); - List.iter (fun imp -> if not (has_class_flag (fst imp) CExtern) then deps := (fst imp).cl_path :: !deps) (real_non_native_interfaces class_def.cl_implements); - Hashtbl.add result class_def.cl_path !deps; - | TEnumDecl enum_def when not (has_enum_flag enum_def EnExtern) -> - Hashtbl.add result enum_def.e_path []; - | _ -> () ); - ) common_ctx.types; - result;; - -let create_constructor_dependencies common_ctx = - let result = Hashtbl.create 0 in - List.iter (fun object_def -> - (match object_def with - | TClassDecl class_def when not (has_class_flag class_def CExtern) -> - (match class_def.cl_constructor with - | Some func_def -> Hashtbl.add result class_def.cl_path func_def - | _ -> () ) - | _ -> () ); - ) common_ctx.types; - result;; - + result let is_assign_op op = match op with | OpAssign | OpAssignOp _ -> true | _ -> false -;; - - - - - -(* - ------------------ CPPIA ---------------------------------------- -*) - - - - - - -let rec script_type_string haxe_type = - match haxe_type with - | TAbstract ({ a_path = ([],"Null") },[t]) -> - (match follow t with - | TAbstract ({ a_path = [],"Int" },_) - | TAbstract ({ a_path = [],"Float" },_) - | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" - | _ -> script_type_string t) - | TInst ({cl_path=[],"Null"},[t]) -> - (match follow t with - | TAbstract ({ a_path = [],"Int" },_) - | TAbstract ({ a_path = [],"Float" },_) - | TAbstract ({ a_path = [],"Bool" },_) -> "Dynamic" - | _ -> script_type_string t ) - | _ -> - match follow haxe_type with - | TType ({t_path = [],"Array"},params) -> "Array" - | TInst ({cl_path=[],"Array"},params) -> - (match params with - | [t] -> - (match type_string_suff "" t false with - | "int" -> "Array.int" - | "Float" -> "Array.Float" - | "bool" -> "Array.bool" - | "::String" -> "Array.String" - | "unsigned char" -> "Array.unsigned char" - | "::cpp::UInt8" -> "Array.unsigned char" - | "Dynamic" -> "Array.Any" - | _ -> "Array.Object" - ) - | _ -> "Array.Object" - ) - | TAbstract (abs,pl) when abs.a_impl <> None -> - script_type_string (Abstract.get_underlying_type abs pl); - | _ -> - type_string_suff "" haxe_type false -;; - - -let rec script_cpptype_string cppType = match cppType with - | TCppDynamic - | TCppUnchanged - | TCppWrapped _ - | TCppObject -> "Dynamic" - | TCppObjectPtr -> ".*.hx.Object*" - | TCppReference t -> ".ref." ^ (script_cpptype_string t) - | TCppStruct t -> ".struct." ^ (script_cpptype_string t) - | TCppStar(t,_) -> "*." ^ (script_cpptype_string t) - | TCppVoid -> "void" - | TCppVoidStar -> "*.void" - | TCppRest _ -> "vaarg_list" - | TCppVarArg -> "vararg" - | TCppAutoCast -> ".cpp.AutoCast" - | TCppVariant -> ".cpp.Variant" - | TCppEnum(enum) -> (join_class_path enum.e_path ".") - | TCppScalar(scalar) -> scalar - | TCppString -> "String" - | TCppFastIterator it -> "cpp.FastIterator." ^ (script_cpptype_string it) - | TCppPointer(_,valueType) -> "cpp.Pointer." ^ (script_cpptype_string valueType) - | TCppRawPointer(_,valueType) -> "cpp.RawPointer." ^ (script_cpptype_string valueType) - | TCppFunction _ -> "cpp.Function" - | TCppObjCBlock _ -> "cpp.ObjCBlock" - | TCppDynamicArray -> "Array.Any" - | TCppObjectArray _ -> "Array.Object" - | TCppScalarArray(value) -> "Array." ^ (script_cpptype_string value) - | TCppObjC _ -> "cpp.ObjC" - | TCppProtocol _ -> "cpp.ObjC.Protocol" - | TCppNativePointer klass -> "cpp.Pointer." ^ (join_class_path klass.cl_path ".") - | TCppInterface klass -> (join_class_path klass.cl_path ".") - | TCppInst (klass, _) -> (join_class_path klass.cl_path ".") - | TCppClass -> "Class" - | TCppGlobal -> "?global"; - | TCppNull -> "null"; - | TCppCode _ -> "Dynamic" -;; - - -type array_of = - | ArrayInterface of int - | ArrayData of string - | ArrayObject - | ArrayAny - | ArrayNone -;; - -let is_template_type t = - false -;; - -type cppia_op = - | IaFunction - | IaVar - | IaToInterface - | IaToDynArray - | IaToDataArray - | IaToInterfaceArray - | IaFun - | IaCast - | IaTCast - | IaBlock - | IaBreak - | IaContinue - | IaIsNull - | IaNotNull - | IaSet - | IaCall - | IaCallGlobal - | IaCallStatic - | IaCallMember - | IaCallSuper - | IaCallThis - | IaCallSuperNew - | IaCreateEnum - | IaADef - | IaIf - | IaIfElse - | IaFStatic - | IaFName - | IaFThisInst - | IaFLink - | IaFThisName - | IaFEnum - | IaThrow - | IaArrayI - | IaPlusPlus - | IaPlusPlusPost - | IaMinusMinus - | IaMinusMinusPost - | IaNeg - | IaBitNot - | IaLogicNot - | IaTVars - | IaVarDecl - | IaVarDeclI - | IaNew - | IaReturn - | IaRetVal - | IaPosInfo - | IaObjDef - | IaClassOf - | IaWhile - | IaFor - | IaEnumI - | IaSwitch - | IaTry - | IaImplDynamic - | IaConstInt - | IaConstFloat - | IaConstString - | IaConstFalse - | IaConstTrue - | IaConstNull - | IaConsThis - | IaConstSuper - | IaCastInt - | IaCastBool - | IaInterface - | IaClass - | IaAccessNormal - | IaAccessNot - | IaAccessResolve - | IaAccessCall - | IaEnum - | IaInline - | IaMain - | IaNoMain - | IaResources - | IaReso - | IaNoCast - | IaAccessCallNative - - | IaBinOp of Ast.binop -;; - -let cppia_op_info = function - | IaFunction -> ("FUNCTION", 1) - | IaVar -> ("VAR", 2) - | IaToInterface -> ("TOINTERFACE", 3) - | IaToDynArray -> ("TODYNARRAY", 4) - | IaToDataArray -> ("TODATAARRAY", 5) - | IaToInterfaceArray -> ("TOINTERFACEARRAY", 6) - | IaFun -> ("FUN", 7) - | IaCast -> ("CAST", 8) - | IaBlock -> ("BLOCK", 9) - | IaBreak -> ("BREAK", 10) - | IaContinue -> ("CONTINUE", 11) - | IaIsNull -> ("ISNULL", 12) - | IaNotNull -> ("NOTNULL", 13) - | IaSet -> ("SET", 14) - | IaCall -> ("CALL", 15) - | IaCallGlobal -> ("CALLGLOBAL", 16) - | IaCallStatic -> ("CALLSTATIC", 17) - | IaCallMember -> ("CALLMEMBER", 18) - | IaCallSuper -> ("CALLSUPER", 19) - | IaCallThis -> ("CALLTHIS", 20) - | IaCallSuperNew -> ("CALLSUPERNEW", 21) - | IaCreateEnum -> ("CREATEENUM", 22) - | IaADef -> ("ADEF", 23) - | IaIf -> ("IF", 24) - | IaIfElse -> ("IFELSE", 25) - | IaFName -> ("FNAME", 27) - | IaFStatic -> ("FSTATIC", 28) - | IaFThisInst -> ("FTHISINST", 29) - | IaFLink -> ("FLINK", 30) - | IaFThisName -> ("FTHISNAME", 31) - | IaFEnum -> ("FENUM", 32) - | IaThrow -> ("THROW", 33) - | IaArrayI -> ("ARRAYI", 34) - | IaPlusPlus -> ("++", 35) - | IaPlusPlusPost -> ("+++", 36) - | IaMinusMinus -> ("--", 37) - | IaMinusMinusPost -> ("---", 38) - | IaNeg -> ("NEG", 39) - | IaBitNot -> ("~", 40) - | IaLogicNot -> ("!", 41) - | IaTVars -> ("TVARS", 42) - | IaVarDecl -> ("VARDECL", 43) - | IaVarDeclI -> ("VARDECLI", 44) - | IaNew -> ("NEW", 45) - | IaReturn -> ("RETURN", 46) - | IaRetVal -> ("RETVAL", 47) - | IaPosInfo -> ("POSINFO", 48) - | IaObjDef -> ("OBJDEF", 49) - | IaClassOf -> ("CLASSOF", 50) - | IaWhile -> ("WHILE", 51) - | IaFor -> ("FOR", 52) - | IaEnumI -> ("ENUMI", 53) - | IaSwitch -> ("SWITCH", 54) - | IaTry -> ("TRY", 55) - | IaImplDynamic -> ("IMPLDYNAMIC", 56) - | IaConstInt -> ("i", 57) - | IaConstFloat -> ("f", 58) - | IaConstString -> ("s", 59) - | IaConstFalse -> ("false", 60) - | IaConstTrue -> ("true", 61) - | IaConstNull -> ("NULL", 62) - | IaConsThis -> ("THIS", 63) - | IaConstSuper -> ("SUPER", 64) - | IaCastInt -> ("CASTINT", 65) - | IaCastBool -> ("CASTBOOL", 66) - | IaInterface -> ("INTERFACE", 67) - | IaClass -> ("CLASS", 68) - | IaAccessNormal -> ("N", 69) - | IaAccessNot -> ("n", 70) - | IaAccessResolve -> ("R", 71) - | IaAccessCall -> ("C", 72) - | IaEnum -> ("ENUM", 73) - | IaInline -> ("INLINE", 74) - | IaMain -> ("MAIN", 75) - | IaNoMain -> ("NOMAIN", 76) - | IaResources -> ("RESOURCES", 77) - | IaReso -> ("RESO", 78) - | IaNoCast -> ("NOCAST", 79) - | IaAccessCallNative -> ("V", 80) - - | IaBinOp OpAdd -> ("+", 101) - | IaBinOp OpMult -> ("*", 102) - | IaBinOp OpDiv -> ("/", 103) - | IaBinOp OpSub -> ("-", 104) - | IaBinOp OpAssign -> ("=", 105) - | IaBinOp OpEq -> ("==", 106) - | IaBinOp OpNotEq -> ("!=", 107) - | IaBinOp OpGte -> (">=", 108) - | IaBinOp OpLte -> ("<=", 109) - | IaBinOp OpGt -> (">", 110) - | IaBinOp OpLt -> ("<", 111) - | IaBinOp OpAnd -> ("&", 112) - | IaBinOp OpOr -> ("|", 113) - | IaBinOp OpXor -> ("^", 114) - | IaBinOp OpBoolAnd -> ("&&", 115) - | IaBinOp OpBoolOr -> ("||", 116) - | IaBinOp OpShr -> (">>", 117) - | IaBinOp OpUShr -> (">>>", 118) - | IaBinOp OpShl -> ("<<", 119) - | IaBinOp OpMod -> ("%", 120) - | IaBinOp OpInterval -> ("...", 121) - | IaBinOp OpArrow -> ("=>", 122) - | IaBinOp OpIn -> (" in ", 123) - | IaBinOp OpNullCoal -> ("??", 124) - | IaBinOp OpAssignOp OpAdd -> ("+=", 201) - | IaBinOp OpAssignOp OpMult -> ("*=", 202) - | IaBinOp OpAssignOp OpDiv -> ("/=", 203) - | IaBinOp OpAssignOp OpSub -> ("-=", 204) - - - | IaBinOp OpAssignOp OpAnd -> ("&=", 212) - | IaBinOp OpAssignOp OpOr -> ("|=", 213) - | IaBinOp OpAssignOp OpXor -> ("^=", 214) - | IaBinOp OpAssignOp OpBoolAnd -> ("&&=", 215) - | IaBinOp OpAssignOp OpBoolOr -> ("||=", 216) - | IaBinOp OpAssignOp OpShr -> (">>=", 217) - | IaBinOp OpAssignOp OpUShr -> (">>>=", 218) - | IaBinOp OpAssignOp OpShl -> ("<<=", 219) - | IaBinOp OpAssignOp OpMod -> ("%=", 220) - - | IaBinOp OpAssignOp OpIn - | IaBinOp OpAssignOp OpNullCoal - | IaBinOp OpAssignOp OpInterval - | IaBinOp OpAssignOp OpAssign - | IaBinOp OpAssignOp OpEq - | IaBinOp OpAssignOp OpNotEq - | IaBinOp OpAssignOp OpGte - | IaBinOp OpAssignOp OpLte - | IaBinOp OpAssignOp OpGt - | IaBinOp OpAssignOp OpLt - | IaBinOp OpAssignOp OpAssignOp _ - | IaBinOp OpAssignOp OpArrow -> die "" __LOC__ - | IaTCast -> ("TCAST", 221) -;; - - - -class script_writer ctx filename asciiOut = - object(this) - val debug = asciiOut - val doComment = asciiOut && (Common.defined ctx.ctx_common Define.AnnotateSource) - val indent_str = if asciiOut then "\t" else "" - val mutable indent = "" - val mutable indents = [] - val mutable just_finished_block = false - val mutable classCount = 0 - val mutable return_type = TMono(Monomorph.create()) - val buffer = Buffer.create 0 - val identTable = Hashtbl.create 0 - val fileTable = Hashtbl.create 0 - val identBuffer = Buffer.create 0 - val cppiaAst = not (Common.defined ctx.ctx_common Define.NoCppiaAst) - - method stringId name = - try ( Hashtbl.find identTable name ) - with Not_found -> begin - let size = Hashtbl.length identTable in - Hashtbl.add identTable name size; - Buffer.add_string identBuffer ((string_of_int (String.length name)) ^ " " ^ name ^ "\n"); - size; - end - method incClasses = classCount <- classCount +1 - - method stringText name = (string_of_int (this#stringId name)) ^ " " - val typeTable = Hashtbl.create 0 - val typeBuffer = Buffer.create 0 - method typeId name = - let name = if name="::hx::Class" then "::Class" else name in - try ( Hashtbl.find typeTable name ) - with Not_found -> begin - let size = Hashtbl.length typeTable in - Hashtbl.add typeTable name size; - Buffer.add_string typeBuffer ((string_of_int (String.length name)) ^ " " ^ name ^ "\n"); - size; - end - method write str = if asciiOut then - Buffer.add_string buffer str - else begin - let push i = Buffer.add_char buffer (Char.chr i) in - let pushI32 i = push (Int32.to_int (Int32.logand i (Int32.of_int 255))) in - List.iter (fun i -> - if ((Int32.compare i Int32.zero) >= 0) && ((Int32.compare i (Int32.of_int 254)) < 0) then - pushI32 i - else if ((Int32.compare i Int32.zero) >= 0) && ((Int32.compare i (Int32.of_int 65536)) < 0) then begin - push 254; - pushI32 i; - pushI32 (Int32.shift_right i 8); - end else begin - push 255; - pushI32 i; - pushI32 (Int32.shift_right i 8); - pushI32 (Int32.shift_right i 16); - pushI32 (Int32.shift_right i 24); - end - ) (List.map Int32.of_string (Str.split (Str.regexp "[\n\t ]+") str) ); - end; - just_finished_block <- false - method comment text = if doComment then this#write ("# " ^ text ^ "\n") - method commentOf text = if doComment then " # " ^ text else "" - method typeTextString typeName = (string_of_int (this#typeId typeName)) ^ " " - method typeText typeT = - let tname = if cppiaAst then script_cpptype_string (cpp_type_of ctx typeT) else script_type_string typeT in - (string_of_int (this#typeId tname)) ^ " " - method astType cppType = (string_of_int (this#typeId (script_cpptype_string cppType))) ^ " " - method writeType typeT = this#write (this#typeText typeT) - method toCppType etype = (string_of_int (this#typeId (script_cpptype_string (cpp_type_of ctx etype) ))) ^ " " - method boolText value = if value then "1" else "0" - method writeBool value = this#write (if value then "1 " else "0 ") - method staticText value = if value then "1" else "0" - method writeData str = Buffer.add_string buffer str; - method wint ival = this#write ((string_of_int ival)^" ") - method ident name = this#wint (this#stringId name) - method cppInstText clazz = match clazz.cl_path with - | ([],"Array") -> this#typeTextString "Array" - | x -> this#typeTextString (join_class_path x ".") - method instText clazz = match clazz.cl_path with - | ([],"Array") -> string_of_int (this#typeId "Array< ::Dynamic >") ^ " " - | _ -> this#typeText (TInst(clazz,[])) - method instName clazz = this#write (if cppiaAst then (this#cppInstText clazz) else (this#instText clazz)) - method enumText e = this#typeText (TEnum(e,[])) - method close = - let out_file = open_out_bin filename in - output_string out_file (if asciiOut then "CPPIA\n" else "CPPIB\n"); - let idents = Buffer.contents identBuffer in - output_string out_file ((string_of_int (Hashtbl.length identTable)) ^ "\n"); - output_string out_file idents; - let types = Buffer.contents typeBuffer in - output_string out_file ((string_of_int (Hashtbl.length typeTable)) ^ "\n"); - output_string out_file types; - output_string out_file ( (string_of_int classCount) ^ "\n" ); - let contents = Buffer.contents buffer in - output_string out_file contents; - close_out out_file - method fileId file = - try ( Hashtbl.find fileTable file ) - with Not_found -> begin - let stripped_file = strip_file ctx.ctx_common file in - let result = this#stringId stripped_file in - Hashtbl.add fileTable file result; - result; - end - method constText c = match c with - | TInt i -> (this#op IaConstInt) ^ (Printf.sprintf "%ld " i) - | TFloat f -> (this#op IaConstFloat) ^ (this#stringText (replace_float_separators f)) - | TString s -> (this#op IaConstString) ^ (this#stringText s) - | TBool true -> (this#op IaConstTrue) - | TBool false -> (this#op IaConstFalse) - | TNull -> (this#op IaConstNull) - | TThis -> (this#op IaConsThis) - | TSuper -> (this#op IaConstSuper) - - method get_array_type t = - match follow t with - | TInst ({cl_path=[],"Array"},[param]) -> - let typeName = type_string_suff "" param false in - (match typeName with - | "::String" -> ArrayData "String" - | "int" | "Float" | "bool" | "String" | "unsigned char" | "::cpp::UInt8" -> - ArrayData typeName - | "cpp::ArrayBase" | "cpp::VirtualArray" | "Dynamic" -> ArrayAny - | _ when is_interface_type param -> ArrayInterface (this#typeId (script_type_string param)) - | _ -> ArrayObject - ) - | TAbstract (abs,pl) when abs.a_impl <> None -> - this#get_array_type (Abstract.get_underlying_type abs pl); - | _ -> ArrayNone; - - method pushReturn inType = - let oldReturnType = return_type in - return_type <- inType; - fun () -> return_type <- oldReturnType; - method fileText file = string_of_int (this#fileId file) - method indent_one = this#write indent_str - method push_indent = indents <- indent_str::indents; indent <- String.concat "" indents - method pop_indent = match indents with - | h::tail -> indents <- tail; indent <- String.concat "" indents - | [] -> indent <- "/*?*/"; - method write_i x = this#write (indent ^ x) - method get_indent = indent - method begin_expr = this#push_indent - method end_expr = if not just_finished_block then this#write "\n"; this#pop_indent; just_finished_block <- true - method op x = match cppia_op_info x with - | (name,index) -> (if debug then name else string_of_int index) ^ " " - method writeOp o = this#write (this#op o) - method writeOpLine o = this#write ((this#op o) ^ "\n") - method voidFunc isStatic isDynamic funcName fieldExpression = - this#comment funcName; - this#write ( (this#op IaFunction) ^ (this#staticText isStatic) ^ " " ^(this#boolText isDynamic) ^ " " ^(this#stringText funcName) ^ " "); - this#write ((this#typeTextString "Void") ^ "0\n"); - this#gen_expression fieldExpression - method func isStatic isDynamic funcName ret args isInterface fieldExpression abstractPos = - this#comment funcName; - this#write ( (this#op IaFunction) ^ (this#staticText isStatic) ^ " " ^(this#boolText isDynamic) ^ " " ^(this#stringText funcName) ^ " "); - this#write ((this#typeText ret) ^ (string_of_int (List.length args)) ^ " "); - List.iter (fun (name,opt,typ) -> this#write ( (this#stringText name) ^ (this#boolText opt) ^ " " ^ (this#typeText typ) ^ " " )) args; - this#write "\n"; - if (not isInterface) then begin - match fieldExpression with - | Some ({ eexpr = TFunction function_def } as e) -> - if cppiaAst then begin - let args = List.map fst function_def.tf_args in - let cppExpr = retype_expression ctx TCppVoid args function_def.tf_type function_def.tf_expr false in - this#begin_expr; - this#writePos function_def.tf_expr; - this#write ( (this#op IaFun) ^ (this#typeText function_def.tf_type) ^ (string_of_int (List.length args)) ^ "\n" ); - let close = this#gen_func_args function_def.tf_args in - this#gen_expression_tree cppExpr; - this#end_expr; - close() - end else - this#gen_expression e - | _ -> - (* Abstract function - dummp implementation that (should) not get called *) - this#begin_expr; - this#wpos abstractPos; - this#writeOpLine IaReturn; - this#end_expr; - end - method var readAcc writeAcc isExtern isStatic name varType varExpr = - this#write ( (this#op IaVar) ^ (this#staticText isStatic) ^ " " ^ (this#op readAcc) ^ (this#op writeAcc) ^ - (this#boolText isExtern) ^ " " ^ (this#stringText name)^ (this#typeText varType) ^ - (match varExpr with Some _ -> "1" | _ -> "0" ) ^ - (if doComment then (" # " ^ name ^ "\n") else "\n") ); - match varExpr with - | Some expression -> - if cppiaAst then begin - let varType = cpp_type_of ctx expression.etype in - let cppExpr = retype_expression ctx varType [] t_dynamic expression false in - this#gen_expression_tree cppExpr - end else - this#gen_expression expression - | _ -> () - method implDynamic = this#writeOpLine IaImplDynamic; - method writeVar v = - this#ident v.v_name; - this#wint v.v_id; - this#writeBool (has_var_flag v VCaptured); - this#writeType v.v_type; - method writeList prefix len = this#write (prefix ^" " ^ (string_of_int (len)) ^ "\n"); - method wpos p = if debug then - this#write ( (this#fileText p.pfile) ^ "\t" ^ (string_of_int (Lexer.get_error_line p) ) ^ indent); - method writePos expr = this#wpos expr.epos - method writeCppPos expr = this#wpos expr.cpppos - method checkCast toType expr forceCast fromGenExpression= - let write_cast text = - if (not fromGenExpression) then - this#writePos expr; - this#write (text ^"\n" ); - this#begin_expr; - this#gen_expression expr; - this#end_expr; - true; - in - let was_cast = - if (is_interface_type toType) then begin - if (is_dynamic_in_cppia ctx expr) then begin - write_cast ( (this#op IaToInterface) ^ (this#typeText toType) ^ " " ^ (this#typeTextString "Dynamic") ) - end else if (not (is_matching_interface_type toType expr.etype)) then begin - write_cast ( (this#op IaToInterface) ^ (this#typeText toType) ^ " " ^ (this#typeText expr.etype) ) - end else - false - end else begin - let get_array_expr_type expr = - if is_dynamic_in_cppia ctx expr then - ArrayNone - else - this#get_array_type expr.etype - in - match (this#get_array_type toType), (get_array_expr_type expr) with - | ArrayAny, _ -> false - | ArrayObject, ArrayData _ -> write_cast (this#op IaToDynArray) - | ArrayObject, ArrayObject -> false - | ArrayObject, ArrayNone - | ArrayObject, ArrayAny -> write_cast ((this#op IaToDataArray) ^ (this#typeTextString ("Array.Object"))) - | ArrayData t, ArrayNone - | ArrayData t, ArrayObject - | ArrayData t, ArrayAny -> write_cast ((this#op IaToDataArray) ^ (this#typeTextString ("Array." ^ t))) - | ArrayInterface t, ArrayNone - | ArrayInterface t, ArrayAny -> write_cast ((this#op IaToInterfaceArray) ^ (string_of_int t)) - | _,_ -> (* a0,a1 -> - let arrayString a = - match a with - | ArrayNone -> "ArrayNone" - | ArrayAny -> "ArrayAny" - | ArrayObject -> "ArrayObject" - | ArrayData _ -> "ArrayData" - | ArrayInterface _ -> "ArrayInterface" - in - this#write ("NOCAST " ^ (arrayString a0) ^ "=" ^ (arrayString a1)); *) - false - end - in - - if (not was_cast) then begin - if (forceCast) then begin - let op =match (type_string expr.etype) with - | "int" -> IaCastInt - | "bool" -> IaCastBool - | _ when is_interface_type toType -> IaNoCast - | _ -> IaCast - in - this#writeOpLine op; - end; - this#gen_expression expr; - end - - method gen_func_args args = - let gen_inits = ref [] in - List.iter (fun(arg,init) -> - this#write (indent ^ indent_str ); - this#writeVar arg; - match init with - | Some ({eexpr = TConst TNull}) -> this#write "0\n" - | Some const -> - let argType = (cpp_type_of ctx const.etype) in - if (is_cpp_scalar argType || argType==TCppString ) then begin - this#write ("1 "); - this#gen_expression_only const; - this#write "\n"; - end else begin - gen_inits := (arg, const) :: !gen_inits; - this#write "0\n"; - end - | _ -> this#write "0\n"; - ) args; - - if (List.length !gen_inits)==0 then begin - fun () -> ( ) - end else begin - this#begin_expr; - this#writePos (snd (List.hd !gen_inits) ); - this#writeList (this#op IaBlock) ((List.length !gen_inits) + 1); - List.iter (fun(arg,const) -> - let start_expr( ) = this#begin_expr; this#writePos const; in - let local_var( ) = - this#begin_expr; - this#writePos const; - this#write ((this#op IaVar) ^ (string_of_int arg.v_id) ^ (this#commentOf arg.v_name) ); - this#end_expr; - in - - start_expr(); - this#writeOpLine IaIf; - start_expr(); - this#writeOpLine IaIsNull; - local_var(); - this#end_expr; - start_expr(); - this#writeOpLine IaSet; - local_var(); - this#gen_expression const; - this#end_expr; - this#begin_expr; - ) !gen_inits; - fun () -> this#end_expr; - end - - method gen_expression expr = - this#begin_expr; - this#writePos expr; - this#gen_expression_only expr; - this#end_expr; - - method gen_expression_only expr = (* { *) - let expression = remove_parens expr in - (match expression.eexpr with - | TFunction function_def -> this#write ( (this#op IaFun) ^ (this#typeText function_def.tf_type) ^ (string_of_int (List.length function_def.tf_args)) ^ "\n" ); - let close = this#gen_func_args function_def.tf_args in - let pop = this#pushReturn function_def.tf_type in - this#gen_expression function_def.tf_expr; - pop (); - close() - | TBlock expr_list -> this#writeList (this#op IaBlock) (List.length expr_list); - List.iter this#gen_expression expr_list; - | TConst const -> this#write (this#constText const) - | TBreak -> this#writeOp IaBreak - | TContinue -> this#writeOp IaContinue - - | TBinop (op,e1,e2) when op=OpAssign -> - this#writeOpLine IaSet; - this#gen_expression e1; - this#checkCast e1.etype e2 false false; - | TBinop (OpEq ,e1, { eexpr = TConst TNull } ) -> this#writeOpLine IaIsNull; - this#gen_expression e1; - | TBinop (OpNotEq ,e1, { eexpr = TConst TNull }) -> this#writeOpLine IaNotNull; - this#gen_expression e1; - | TBinop (OpEq , { eexpr = TConst TNull }, e1) -> this#writeOpLine IaIsNull; - this#gen_expression e1; - | TBinop (OpNotEq, { eexpr = TConst TNull }, e1) -> this#writeOpLine IaNotNull; - this#gen_expression e1; - | TBinop (op,e1,e2) -> this#writeOpLine (IaBinOp op); - this#gen_expression e1; - this#gen_expression e2; - | TThrow e -> this#writeOpLine IaThrow; - this#gen_expression e; - | TArrayDecl expr_list -> - this#write ( (this#op IaADef) ^ (this#typeText expression.etype) ^ " " ^(string_of_int (List.length expr_list))^"\n"); - List.iter this#gen_expression expr_list; - | TIf (e,e1,e2) -> - (match e2 with - | None -> - this#writeOpLine IaIf; - this#gen_expression e; - this#gen_expression e1; - | Some elze -> - this#writeOpLine IaIfElse; - this#gen_expression e; - this#gen_expression e1; - this#gen_expression elze; ) - | TCall (func, arg_list) -> - let argN = (string_of_int (List.length arg_list)) ^ " " in - let gen_call () = - (match (remove_parens_cast func).eexpr with - | TField ( { eexpr = TIdent "__global__" }, field ) -> - this#write ( (this#op IaCallGlobal) ^ (this#stringText (field_name field)) ^ argN ^ (this#commentOf (field_name field)) ^ "\n"); - | TField (obj,FStatic (class_def,field) ) when is_real_function field -> - this#write ( (this#op IaCallStatic) ^ (this#instText class_def) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf ( join_class_path class_def.cl_path "." ^ "." ^ field.cf_name) ) ^ "\n"); - | TField (obj,FInstance (_,_,field) ) when (is_this obj) && (is_real_function field) -> - this#write ( (this#op IaCallThis) ^ (this#typeText obj.etype) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf field.cf_name) ^ "\n"); - | TField (obj,FInstance (_,_,field) ) when is_super obj -> - this#write ( (this#op IaCallSuper) ^ (this#typeText obj.etype) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf field.cf_name) ^ "\n"); - (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *) - | TField (obj,FInstance (_,_,field) ) when field.cf_name = "_hx_getIndex" && (script_type_string obj.etype)="::hx::EnumBase" -> - this#write ( (this#op IaCallMember) ^ (this#typeTextString "::hx::EnumBase") ^ " " ^ (this#stringText "__Index") ^ - argN ^ (this#commentOf ("Enum index") ) ^ "\n"); - this#gen_expression obj; - | TField (obj,FInstance (_,_,field) ) when field.cf_name = "__Index" || (not (is_dynamic_in_cppia ctx obj) && is_real_function field) -> - this#write ( (this#op IaCallMember) ^ (this#typeText obj.etype) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf field.cf_name) ^ "\n"); - this#gen_expression obj; - | TField (obj,FDynamic (name) ) when (is_internal_member name || (type_string obj.etype = "::String" && name="cca") ) -> - this#write ( (this#op IaCallMember) ^ (this#typeText obj.etype) ^ " " ^ (this#stringText name) ^ - argN ^ (this#commentOf name) ^ "\n"); - this#gen_expression obj; - | TConst TSuper -> this#write ((this#op IaCallSuperNew) ^ (this#typeText func.etype) ^ " " ^ argN ^ "\n"); - | TField (_,FEnum (enum,field)) -> this#write ((this#op IaCreateEnum) ^ (this#enumText enum) ^ " " ^ (this#stringText field.ef_name) ^ argN ^ - (this#commentOf field.ef_name) ^ "\n"); - | _ -> this#write ( (this#op IaCall) ^ argN ^ "\n"); - this#gen_expression func; - ); - let matched_args = match func.etype with - | TFun (args,_) -> - ( try ( - List.iter2 (fun (_,_,protoT) arg -> this#checkCast protoT arg false false) args arg_list; - true; ) - with Invalid_argument _ -> (*print_endline "Bad count?";*) false ) - | _ -> false - in - if not matched_args then - List.iter this#gen_expression arg_list; - in - (match (remove_parens_cast func).eexpr with - | TField(obj,field) when is_array_or_dyn_array obj.etype && (field_name field)="map" -> - (match this#get_array_type expression.etype with - | ArrayData t -> - this#write ( (this#op IaToDataArray) ^ (this#typeTextString ("Array." ^ t)) ^ "\n"); - this#begin_expr; - this#writePos func; - gen_call(); - this#end_expr; - | ArrayInterface t -> - this#write ( (this#op IaToInterfaceArray) ^ (string_of_int t) ^ "\n"); - this#begin_expr; - this#writePos func; - gen_call(); - this#end_expr; - | _ -> gen_call(); - ) - | _ -> gen_call(); - ); - | TField (obj, acc) -> - let objType = if is_dynamic_in_cppia ctx obj then "Dynamic" else script_type_string obj.etype in - let typeText = if is_dynamic_in_cppia ctx obj then this#typeTextString "Dynamic" else this#typeText obj.etype in - (match acc with - | FDynamic name -> this#write ( (this#op IaFName) ^ typeText ^ " " ^ (this#stringText name) ^ (this#commentOf name) ^ "\n"); - this#gen_expression obj; - | FStatic (class_def,field) -> this#write ( (this#op IaFStatic) ^ (this#instText class_def) ^ " " ^ - (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ); - | FInstance (_,_,field) when is_this obj -> this#write ( (this#op IaFThisInst) ^ typeText ^ " " ^ (this#stringText field.cf_name) - ^ (this#commentOf field.cf_name) ); - | FInstance (_,_,field) -> this#write ( (this#op IaFLink) ^ typeText ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf ( objType ^ "." ^ field.cf_name)) ^ "\n"); - this#gen_expression obj; - - | FClosure (_,field) when is_this obj -> this#write ( (this#op IaFThisName) ^typeText ^ " " ^ (this#stringText field.cf_name) ^ "\n") - | FAnon (field) when is_this obj -> this#write ( (this#op IaFThisName) ^typeText ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ^ "\n") - - | FClosure (_,field) - | FAnon (field) -> this#write ( (this#op IaFName) ^typeText ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ^ "\n"); - this#gen_expression obj; - - | FEnum (enum,field) -> this#write ( (this#op IaFEnum) ^ (this#enumText enum) ^ " " ^ (this#stringText field.ef_name) ^ (this#commentOf field.ef_name) ); - ) - | TArray (e1, e2) -> this#write ((this#op IaArrayI) ^ (this#typeText e1.etype) ^ "\n"); - this#gen_expression e1; - this#gen_expression e2; - | TUnop (op, flag, e) -> - this#writeOpLine (match op,flag with - | Increment, Prefix -> IaPlusPlus - | Increment, _ -> IaPlusPlusPost - | Decrement, Prefix -> IaMinusMinus - | Decrement, _ -> IaMinusMinusPost - | Not, _ -> IaLogicNot - | Neg, _ -> IaNeg - | Spread, _ -> die ~p:e.epos "Unexpected spread operator" __LOC__ - | NegBits, _ -> IaBitNot ); - this#gen_expression e; - (* TODO - lval op-assign local/member/array *) - | TLocal var -> this#write ((this#op IaVar) ^ (string_of_int var.v_id) ^ (this#commentOf var.v_name) ); - - | TVar (tvar,optional_init) -> - this#write ( (this#op IaTVars) ^ (string_of_int (1)) ^ (this#commentOf (tvar.v_name ^ ":" ^ (script_type_string tvar.v_type)) ) ^ "\n"); - this#write ("\t\t" ^ indent); - (match optional_init with - | None -> this#writeOp IaVarDecl; - this#writeVar tvar; - | Some init ->this#writeOp IaVarDeclI; - let init = remove_parens init in - this#writeVar tvar; - this#write (" " ^ (this#typeText init.etype)); - this#write "\n"; - this#checkCast tvar.v_type init false false); - | TNew (clazz,params,arg_list) -> - this#write ((this#op IaNew) ^ (this#typeText (TInst(clazz,params))) ^ (string_of_int (List.length arg_list)) ^ "\n"); - (try - match OverloadResolution.maybe_resolve_constructor_overload clazz params arg_list with - | Some (_,{ cf_type = TFun(args,_) },_) -> - List.iter2 (fun (_,_,protoT) arg -> this#checkCast protoT arg false false) args arg_list; - | _ -> - raise (Invalid_argument "") - with Invalid_argument _ -> - List.iter this#gen_expression arg_list) - - | TReturn optval -> (match optval with - | None -> this#writeOpLine IaReturn; - | Some value -> this#write ( (this#op IaRetVal) ^ (this#typeText value.etype) ^ "\n"); - this#checkCast return_type value false false; - ) - | TObjectDecl ( - (("fileName",_,_) , { eexpr = (TConst (TString file)) }) :: - (("lineNumber",_,_) , { eexpr = (TConst (TInt line)) }) :: - (("className",_,_) , { eexpr = (TConst (TString class_name)) }) :: - (("methodName",_,_), { eexpr = (TConst (TString meth)) }) :: [] ) -> - this#write ( (this#op IaPosInfo) ^ (this#stringText file) ^ (Printf.sprintf "%ld" line) ^ " " ^ - (this#stringText class_name) ^ " " ^ (this#stringText meth)) - - | TObjectDecl values ->this#write ( (this#op IaObjDef) ^ (string_of_int (List.length values))); - this#write " "; - List.iter (fun ((name,_,_),_) -> this#write (this#stringText name) ) values; - this#write "\n"; - List.iter (fun (_,e) -> this#gen_expression e ) values; - | TTypeExpr type_expr -> - let klass = "::" ^ (join_class_path (t_path type_expr) "::" ) in - this#write ((this#op IaClassOf) ^ (string_of_int (this#typeId klass))) - | TWhile (e1,e2,flag) -> this#write ( (this#op IaWhile) ^ (if flag=NormalWhile then "1" else "0" ) ^ "\n"); - this#gen_expression e1; - this#gen_expression e2; - | TFor (tvar,init,loop) -> this#writeOp IaFor; - this#writeVar tvar; - this#write "\n"; - this#gen_expression init; - this#gen_expression loop; - | TEnumParameter (expr,ef,i) -> - let enum = match follow ef.ef_type with - | TEnum(en,_) | TFun(_,TEnum(en,_)) -> en - | _ -> die "" __LOC__ - in - this#write ( (this#op IaEnumI) ^ (this#typeText (TEnum(enum,[])) ) ^ (string_of_int i) ^ "\n"); - this#gen_expression expr; - | TEnumIndex expr -> - this#write ( (this#op IaCallMember) ^ (this#typeTextString "::hx::EnumBase") ^ " " ^ (this#stringText "__Index") ^ "0" ^ (this#commentOf ("Enum index") ) ^ "\n"); - this#gen_expression expr; - | TSwitch {switch_subject = condition;switch_cases = cases;switch_default = optional_default} -> - this#write ( (this#op IaSwitch) ^ (string_of_int (List.length cases)) ^ " " ^ - (match optional_default with None -> "0" | Some _ -> "1") ^ "\n"); - this#gen_expression condition; - List.iter (fun {case_patterns = cases_list;case_expr = expression} -> - this#writeList ("\t\t\t"^indent) (List.length cases_list); - List.iter (fun value -> this#gen_expression value ) cases_list; - this#gen_expression expression; - ) cases; - (match optional_default with None -> () | Some expr -> this#gen_expression expr); - | TTry (e,catches) -> - this#writeList (this#op IaTry) (List.length catches); - this#gen_expression e; - List.iter ( fun (tvar,catch_expr) -> - this#write ("\t\t\t"^indent); - this#writeVar tvar; - this#write "\n"; - this#gen_expression catch_expr; - ) catches; - | TCast (cast,Some (TClassDecl t)) -> - this#write ((this#op IaTCast) ^ (this#typeText (TInst(t,[])) ) ^ "\n"); - this#gen_expression cast; - | TCast (cast,_) -> this#checkCast expression.etype cast true true; - | TParenthesis _ -> abort "Unexpected parens" expression.epos - | TMeta(_,_) -> abort "Unexpected meta" expression.epos - | TIdent _ -> abort "Unexpected ident" expression.epos - ); - (* } *) - method gen_expression_tree expression_tree = (* { *) - let rec gen_expression expression = - begin - this#begin_expr; - this#writeCppPos expression; - let rec match_expr expression = match expression.cppexpr with - | CppBlock(exprs,closures,_) -> - this#writeList (this#op IaBlock) (List.length exprs); - List.iter gen_expression exprs; - - | CppVarDecl(var,init) -> - let name = cpp_var_name_of var in - this#write ( (this#op IaTVars) ^ (string_of_int (1)) ^ (this#commentOf (name ^ ":" ^ (script_type_string var.v_type)) ) ^ "\n"); - this#write ("\t\t" ^ indent); - (match init with - | None -> this#writeOp IaVarDecl; this#writeVar var; - | Some init ->this#writeOp IaVarDeclI; - this#writeVar var; - this#write (" " ^ (this#astType init.cpptype)); - this#write "\n"; - gen_expression init; - ) - | CppInt i -> this#write ((this#op IaConstInt) ^ (Printf.sprintf "%ld " i)) - | CppFloat float_as_string -> this#write ((this#op IaConstFloat) ^ (this#stringText float_as_string)) - | CppString s -> this#write ((this#op IaConstString) ^ (this#stringText s)) - | CppBool false -> this#writeOp IaConstFalse - | CppBool true -> this#writeOp IaConstTrue - | CppNull -> this#writeOp IaConstNull - | CppNil -> abort "Nil not supported in cppia" expression.cpppos - | CppThis _ -> this#writeOp IaConsThis - | CppSuper _ -> this#writeOp IaConstSuper - | CppBreak -> this#writeOp IaBreak - | CppContinue -> this#writeOp IaContinue - | CppGoto label -> abort "Goto not supported in cppia" expression.cpppos - | CppReturn None -> this#writeOpLine IaReturn; - - | CppReturn Some value -> - this#write ( (this#op IaRetVal) ^ (this#astType value.cpptype) ^ "\n"); - gen_expression value; - - | CppWhile(condition, block, while_flag, _) -> - this#write ( (this#op IaWhile) ^ (if while_flag=NormalWhile then "1" else "0" ) ^ "\n"); - gen_expression condition; - gen_expression block; - - | CppIf (condition,block,None) -> - this#writeOpLine IaIf; - gen_expression condition; - gen_expression block; - - | CppIf (condition,block,Some elze) -> - this#writeOpLine IaIfElse; - gen_expression condition; - gen_expression block; - gen_expression elze; - - | CppBinop(op, left, right) -> - this#writeOpLine (IaBinOp op); - gen_expression left; - gen_expression right; - - | CppVar var -> gen_var_loc var - - | CppExtern (name,_) -> abort ("Unexpected global '"^ name ^"' in cppia") expression.cpppos - - | CppSet(lvalue,rvalue) -> - this#writeOpLine IaSet; - gen_lvalue lvalue expression.cpppos; - gen_expression rvalue; - - | CppCall(func, args) -> - let argN = (string_of_int (List.length args)) ^ " " in - (match func with - | FuncThis(field, inst) -> - let name = field.cf_name in - this#write ( (this#op IaCallThis) ^ (this#astType inst) ^ " " ^ (this#stringText name) ^ - argN ^ (this#commentOf name) ^ "\n"); - | FuncInstance(expr,_,field) - | FuncInterface(expr,_,field) -> - this#write ( (this#op IaCallMember) ^ (this#astType expr.cpptype) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf field.cf_name) ^ "\n"); - gen_expression expr; - | FuncStatic(class_def,_,field) -> - this#write ( (this#op IaCallStatic) ^ (this#cppInstText class_def) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf ( join_class_path class_def.cl_path "." ^ "." ^ field.cf_name) ) ^ "\n"); - | FuncTemplate _ -> abort "Templated function call not supported in cppia" expression.cpppos - | FuncFromStaticFunction -> abort "Unexpected FuncFromStaticFunction" expression.cpppos - | FuncEnumConstruct(enum,field) -> - this#write ((this#op IaCreateEnum) ^ (this#enumText enum) ^ " " ^ (this#stringText field.ef_name) ^ argN ^ - (this#commentOf field.ef_name) ^ "\n"); - | FuncSuperConstruct(TCppInst (klass, _)) when (is_native_gen_class klass) && (is_native_class klass) -> - abort "Unsupported super for native class constructor" expression.cpppos; - | FuncSuperConstruct childType -> - this#write ((this#op IaCallSuperNew) ^ (this#astType childType) ^ " " ^ argN ^ "\n"); - | FuncSuper(_,TCppInst(klass, _),_) when (is_native_gen_class klass) && (is_native_class klass) -> - abort "Unsupported super for native class method" expression.cpppos; - | FuncSuper(_,objType,field) -> - this#write ( (this#op IaCallSuper) ^ (this#astType objType) ^ " " ^ (this#stringText field.cf_name) ^ - argN ^ (this#commentOf field.cf_name) ^ "\n"); - | FuncExtern(name,_) -> - this#write ( (this#op IaCallGlobal) ^ (this#stringText name) ^ argN ^ (this#commentOf name) ^ "\n"); - - | FuncNew(newType) -> - this#write ((this#op IaNew) ^ (this#astType newType) ^ argN ^ "\n"); - - | FuncInternal(obj,"cca",".") when obj.cpptype=TCppString -> - this#write ( (this#op IaCallMember) ^ (this#astType obj.cpptype) ^ " " ^ (this#stringText "cca") ^ - argN ^ (this#commentOf "cca") ^ "\n"); - gen_expression obj; - | FuncInternal(obj,name,join) -> - (* abort ("Internal function call '" ^ name ^ "' not supported in cppia") expression.cpppos; *) - this#write ( (this#op IaCallMember) ^ (this#astType obj.cpptype) ^ " " ^ (this#stringText name) ^ - argN ^ (this#commentOf name) ^ "\n"); - gen_expression obj; - | FuncExpression(expr) -> - this#write ( (this#op IaCall) ^ argN ^ "\n"); - gen_expression expr; - ); - List.iter gen_expression args; - - | CppFunction(func,_) -> - (match func with - | FuncThis(field, inst) -> - this#write ( (this#op IaFThisName) ^ (this#astType inst) ^ " " ^ (this#stringText field.cf_name) ^ - (this#commentOf ((script_cpptype_string inst) ^ "." ^ field.cf_name)) ); - | FuncInternal(expr,name,_) -> - this#write ( (this#op IaFLink) ^ (this#astType expr.cpptype) ^ " " ^ (this#stringText name) ^ - (this#commentOf ( "Internal " ^ (script_cpptype_string expr.cpptype) ^ "." ^ name)) ^ "\n"); - gen_expression expr; - - | FuncInstance(expr,_,field) - | FuncInterface(expr,_,field) -> - this#write ( (this#op IaFName) ^ (this#astType expr.cpptype) ^ " " ^ (this#stringText field.cf_name) ^ - (this#commentOf ( (script_cpptype_string expr.cpptype) ^ "." ^ field.cf_name)) ^ "\n"); - gen_expression expr; - - | FuncStatic(class_def,_,field) -> - this#write ( (this#op IaFStatic) ^ (this#cppInstText class_def) ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ); - | FuncExpression(expr) -> match_expr expr; - | FuncExtern(name,_) ->abort ("Can't create extern " ^ name ^ " closure") expression.cpppos - | FuncSuper _ | FuncSuperConstruct _ -> abort "Can't create super closure" expression.cpppos - | FuncNew _ -> abort "Can't create new closure" expression.cpppos - | FuncEnumConstruct _ -> abort "Enum constructor outside of CppCall" expression.cpppos - | FuncFromStaticFunction -> abort "Can't create cpp.Function.fromStaticFunction closure" expression.cpppos - | FuncTemplate _ -> abort "Can't create template function closure" expression.cpppos - ) - - | CppPosition(file,line,class_name,meth) -> - this#write ( (this#op IaPosInfo) ^ (this#stringText file) ^ (Printf.sprintf "%ld" line) ^ " " ^ - (this#stringText class_name) ^ " " ^ (this#stringText meth)) - - | CppNullCompare("IsNull", e) -> - this#writeOpLine IaIsNull; - gen_expression e; - - | CppNullCompare(_, e) -> - this#writeOpLine IaNotNull; - gen_expression e; - - | CppCompare(_, left, right, op) -> - this#writeOpLine (IaBinOp op); - gen_expression left; - gen_expression right; - - | CppArray(arrayLoc) -> gen_array arrayLoc expression.cpppos - - | CppArrayDecl(exprList) -> - this#write ( (this#op IaADef) ^ (this#astType expression.cpptype) ^ " " ^(string_of_int (List.length exprList))^"\n"); - List.iter gen_expression exprList; - - | CppEnumField(enum,field) -> - this#write ( (this#op IaFEnum) ^ (this#enumText enum) ^ " " ^ (this#stringText field.ef_name) ^ (this#commentOf field.ef_name) ); - - | CppEnumIndex(obj) -> - (* Cppia does not have a "GetEnumIndex" op code - must use IaCallMember ::hx::EnumBase.__Index *) - this#write ( (this#op IaCallMember) ^ (this#typeTextString "::hx::EnumBase") ^ " " ^ (this#stringText "__Index") ^ - "0" ^ (this#commentOf ("Enum index") ) ^ "\n"); - gen_expression obj; - - | CppDynamicField(obj,name) -> - this#write ( (this#op IaFName) ^ (this#typeTextString "Dynamic") ^ " " ^ (this#stringText name) ^ (this#commentOf name) ^ "\n"); - gen_expression obj; - - | CppClassOf (path,native) -> - let klass = (join_class_path path "." ) in - this#write ((this#op IaClassOf) ^ (this#typeTextString klass) ^ (this#commentOf klass) ); - - | CppEnumParameter(obj,field,index) -> - this#write ( (this#op IaEnumI) ^ (this#typeTextString "Dynamic") ^ (string_of_int index) ^ "\n"); - gen_expression obj; - - | CppClosure closure -> - this#write ( (this#op IaFun) ^ (this#astType closure.close_type) ^ (string_of_int (List.length closure.close_args)) ^ "\n" ); - let close = this#gen_func_args closure.close_args in - gen_expression closure.close_expr; - close() - - | CppObjectDecl (values,isStruct) ->this#write ( (this#op IaObjDef) ^ (string_of_int (List.length values))); - this#write " "; - List.iter (fun (name,_) -> this#write (this#stringText name) ) values; - this#write "\n"; - List.iter (fun (_,e) -> gen_expression e ) values; - - | CppCrement(incFlag,preFlag,lvalue) -> - let op = match incFlag, preFlag with - | CppIncrement, Prefix -> IaPlusPlus - | CppIncrement, Postfix -> IaPlusPlusPost - | CppDecrement, Prefix -> IaMinusMinus - | CppDecrement, Postfix -> IaMinusMinusPost - in - this#writeOpLine op; - gen_lvalue lvalue expression.cpppos; - - | CppModify(op,lvalue,rvalue) -> - this#writeOpLine (IaBinOp (OpAssignOp op)); - gen_lvalue lvalue expression.cpppos; - gen_expression rvalue; - - | CppUnop(op,expr) -> - let op = match op with - | CppNot -> IaLogicNot - | CppNeg -> IaNeg - | CppNegBits -> IaBitNot - in - this#writeOpLine op; - gen_expression expr; - - | CppThrow(value) -> this#writeOpLine IaThrow; - gen_expression value; - - | CppTry(block,catches) -> - this#writeList (this#op IaTry) (List.length catches); - gen_expression block; - List.iter ( fun (tvar,catch_expr) -> - this#write ("\t\t\t"^indent); - this#writeVar tvar; - this#write "\n"; - gen_expression catch_expr; - ) catches; - - | CppIntSwitch _ -> abort "CppIntSwitch not supported in cppia" expression.cpppos; - | CppSwitch(condition,_, cases, optional_default, _) -> - this#write ( (this#op IaSwitch) ^ (string_of_int (List.length cases)) ^ " " ^ - (match optional_default with None -> "0" | Some _ -> "1") ^ "\n"); - gen_expression condition; - List.iter (fun (cases_list,expression) -> - this#writeList ("\t\t\t"^indent) (List.length cases_list); - List.iter (fun value -> gen_expression value ) cases_list; - gen_expression expression; - ) cases; - (match optional_default with None -> () | Some expr -> gen_expression expr); - - - | CppTCast(expr,toType) -> - this#write ((this#op IaTCast) ^ (this#astType toType) ^ "\n"); - gen_expression expr; - - | CppCast(expr,toType) -> - (match toType with - | TCppDynamicArray -> - this#write ((this#op IaToDynArray) ^ "\n"); - gen_expression expr; - | TCppObjectArray(_) -> - this#write ((this#op IaToDataArray) ^ (this#typeTextString ("Array.Object")) ^ "\n"); - gen_expression expr; - | TCppScalarArray(t) -> - this#write ((this#op IaToDataArray) ^ (this#typeTextString ("Array." ^ (script_cpptype_string t))) ^ "\n"); - gen_expression expr; - | _ -> match_expr expr - ) - - | CppCastScalar(expr,"bool") -> - this#writeOpLine IaCastBool; - gen_expression expr; - - | CppCastScalar(expr,"int") -> - this#writeOpLine IaCastInt; - gen_expression expr; - - | CppCastScalar(expr,"Float") -> - this#write ((this#op IaTCast) ^ (this#astType (TCppScalar("Float"))) ^ "\n"); - gen_expression expr; - - | CppCastScalar(expr,_) -> match_expr expr - | CppCastVariant(expr) -> match_expr expr - | CppCastStatic(expr,_) -> match_expr expr - | CppNullAccess -> - this#writeOpLine IaThrow; - this#begin_expr; - this#writeCppPos expression; - this#write ((this#op IaConstString) ^ (this#stringText "Null access")); - this#end_expr; - - | CppCode _ - | CppFunctionAddress _ - | CppNewNative _ - | CppDereference _ - | CppAddressOf _ - | CppFor _ - | CppCastObjC _ - | CppCastObjCBlock _ - | CppCastProtocol _ - | CppCastNative _ -> abort ("Unsupported operation in cppia :" ^ (s_tcpp expression.cppexpr) ) expression.cpppos - - (*| x -> print_endline ("Unknown cppexpr " ^ (s_tcpp x) );*) - in - match_expr expression; - this#end_expr; - end and gen_array arrayLoc pos = - match arrayLoc with - | ArrayObject(arrayObj, index, _) - | ArrayTyped(arrayObj, index, _) -> - this#write ((this#op IaArrayI) ^ (this#astType arrayObj.cpptype) ^ "\n"); - gen_expression arrayObj; - gen_expression index; - | ArrayPointer(_, _) - | ArrayRawPointer(_,_) -> abort "Unvalid array access in cppia" pos - | ArrayVirtual(arrayObj, index) - | ArrayImplements(_,arrayObj,index) - | ArrayDynamic(arrayObj, index) -> - this#write ((this#op IaArrayI) ^ (this#astType arrayObj.cpptype) ^ "\n"); - gen_expression arrayObj; - gen_expression index; - and gen_lvalue lvalue pos = - this#begin_expr; - this#wpos pos; - (match lvalue with - | CppVarRef varLoc -> gen_var_loc varLoc - | CppArrayRef arrayLoc -> gen_array arrayLoc pos - | CppExternRef(name,_) -> abort ("Unsupported extern '" ^ name ^ "' in cppia") pos; - | CppDynamicRef(expr,name) -> - let typeText = this#typeTextString "Dynamic" in - this#write ( (this#op IaFName) ^ typeText ^ " " ^ (this#stringText name) ^ (this#commentOf name) ^ "\n"); - gen_expression expr; - ); - this#end_expr; - - and gen_var_loc loc = - match loc with - | VarClosure(var) - | VarLocal(var) -> - this#write ((this#op IaVar) ^ (string_of_int var.v_id) ^ (this#commentOf var.v_name) ) - | VarStatic(class_def,_,field) -> - this#write ( (this#op IaFStatic) ^ (this#cppInstText class_def) ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ); - | VarThis(field, thisType) -> - this#write ( (this#op IaFThisInst) ^ (this#astType thisType) ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf field.cf_name) ); - | VarInstance(obj,field,_,_) - | VarInterface(obj,field) -> - let objType = script_cpptype_string obj.cpptype in - this#write ( (this#op IaFLink) ^ (this#astType obj.cpptype) ^ " " ^ (this#stringText field.cf_name) ^ (this#commentOf ( objType ^ "." ^ field.cf_name)) ^ "\n"); - gen_expression obj; - | VarInternal(obj,_,name) -> - let objType = script_cpptype_string obj.cpptype in - this#write ( (this#op IaFLink) ^ (this#astType obj.cpptype) ^ " " ^ (this#stringText name) ^ (this#commentOf ( objType ^ "." ^ name)) ^ "\n"); - gen_expression obj; - (* - and get_array_type elem = - this#stringText (script_cpptype_string elem.cpptype); - *) - in - gen_expression expression_tree -end;; - - - - -let generate_script_class common_ctx script class_def = - script#incClasses; - let classText = (join_class_path class_def.cl_path ".") in - script#comment ("Class " ^ classText); - script#writeOp (if (has_class_flag class_def CInterface) then IaInterface else IaClass ); - script#instName class_def; - (match class_def.cl_super with - | None -> script#ident "" - | Some (c,_) -> script#instName c); - script#wint (List.length class_def.cl_implements); - List.iter (fun(c,_) -> script#instName c) class_def.cl_implements; - script#write "\n"; - (* Looks like some map impl classes have their bodies discarded - not sure best way to filter *) - let non_dodgy_function allow_empty field = - (has_class_flag class_def CInterface) || - match field.cf_kind, field.cf_expr with - | Var _, _ -> true - | Method MethDynamic, _ -> true - | Method MethNormal, None when allow_empty -> true - | Method _, Some _ -> true - | _ -> - false - in - let ordered_statics = List.filter (non_dodgy_function false) class_def.cl_ordered_statics in - let ordered_fields = List.filter (non_dodgy_function true) class_def.cl_ordered_fields in - script#write ((string_of_int ( (List.length ordered_fields) + - (List.length ordered_statics) + - (match class_def.cl_constructor with Some _ -> 1 | _ -> 0 ) + - (match TClass.get_cl_init class_def with Some _ -> 1 | _ -> 0 ) ) ) - ^ "\n"); - - let generate_field isStatic field = - match field.cf_kind, follow field.cf_type with - | Var { v_read = AccInline; v_write = AccNever },_ -> - script#writeOpLine IaInline; - | Var v,_ -> - let mode_code mode = match mode with - | AccNormal | AccCtor -> IaAccessNormal - | AccNo -> IaAccessNot - | AccNever -> IaAccessNot - | AccCall -> if ( (has_meta_key class_def.cl_meta Meta.NativeProperty) || - (has_meta_key field.cf_meta Meta.NativeProperty) || - (Common.defined common_ctx Define.ForceNativeProperty) ) - then IaAccessCallNative else IaAccessCall; - | AccInline -> IaAccessNormal - | AccRequire (_,_) -> IaAccessNormal - in - let isExtern = not (is_physical_field field) in - script#var (mode_code v.v_read) (mode_code v.v_write) isExtern isStatic field.cf_name field.cf_type field.cf_expr - | Method MethDynamic, TFun(args,ret) -> - script#func isStatic true field.cf_name ret args (has_class_flag class_def CInterface) field.cf_expr field.cf_pos - | Method _, TFun(args,ret) when field.cf_name="new" -> - script#func true false "new" (TInst(class_def,[])) args false field.cf_expr field.cf_pos - | Method _, TFun (args,ret) -> - script#func isStatic false field.cf_name ret args (has_class_flag class_def CInterface) field.cf_expr field.cf_pos - | Method _, _ -> print_endline ("Unknown method type " ^ (join_class_path class_def.cl_path "." ) - ^ "." ^field.cf_name ) - in - (match class_def.cl_constructor with - | Some field -> generate_field true field - | _ -> () ); - (match TClass.get_cl_init class_def with - | Some expression -> script#voidFunc true false "__init__" expression - | _ -> () ); - - List.iter (generate_field false) ordered_fields; - List.iter (generate_field true) ordered_statics; - script#write "\n"; -;; - -let generate_script_enum common_ctx script enum_def meta = - script#incClasses; - let sorted_items = List.sort (fun f1 f2 -> (f1.ef_index - f2.ef_index ) ) (pmap_values enum_def.e_constrs) in - script#writeList ((script#op IaEnum) ^ (script#enumText enum_def)) (List.length sorted_items); - - List.iter (fun constructor -> - let name = script#stringText constructor.ef_name in - match constructor.ef_type with - | TFun (args,_) -> - script#write ( name ^ " " ^ (string_of_int (List.length args)) ); - List.iter (fun (arg,_,t) -> script#write ( " " ^ (script#stringText arg) ^ " " ^ (script#typeText t) ) ) args; - script#write "\n"; - | _ -> script#write ( name ^ " 0\n" ) - ) sorted_items; - - match meta with - | Some expr -> script#write "1\n"; - script#gen_expression expr - | _ -> script#write "0\n"; - script#write "\n" -;; - - -let generate_cppia ctx = - let common_ctx = ctx.ctx_common in - let debug = ctx.ctx_debug_level in - Path.mkdir_from_path common_ctx.file; - let script = new script_writer ctx common_ctx.file common_ctx.debug in - ignore (script#stringId ""); - ignore (script#typeId ""); - - List.iter (fun object_def -> - (match object_def with - | TClassDecl class_def when (has_class_flag class_def CExtern) -> - () (*if (gen_externs) then gen_extern_class common_ctx class_def;*) - | TClassDecl class_def -> - let is_internal = is_internal_class class_def.cl_path in - if (is_internal || (is_macro class_def.cl_meta)) then - ( if (debug>=4) then print_endline (" internal class " ^ (join_class_path class_def.cl_path ".") )) - else begin - generate_script_class common_ctx script class_def - end - | TEnumDecl enum_def when has_enum_flag enum_def EnExtern -> () - | TEnumDecl enum_def -> - let is_internal = is_internal_class enum_def.e_path in - if (is_internal) then - (if (debug>=4) then print_endline (" internal enum " ^ (join_class_path enum_def.e_path ".") )) - else begin - let meta = Texpr.build_metadata common_ctx.basic object_def in - if (has_enum_flag enum_def EnExtern) then - (if (debug>=4) then print_endline ("external enum " ^ (join_class_path enum_def.e_path ".") )); - generate_script_enum common_ctx script enum_def meta - end - | TTypeDecl _ | TAbstractDecl _ -> (* already done *) () - ); - ) common_ctx.types; - - (match common_ctx.main.main_expr with - | None -> script#writeOpLine IaNoMain; - | Some e -> script#writeOpLine IaMain; - script#gen_expression e - ); - - script#write ( (script#op IaResources) ^ (string_of_int (Hashtbl.length common_ctx.resources)) ^ "\n"); - Hashtbl.iter (fun name data -> - script#write ((script#op IaReso) ^ (script#stringText name) ^ (string_of_int (String.length data)) ^ "\n"); - ) common_ctx.resources; - Hashtbl.iter (fun _ data -> script#writeData data) common_ctx.resources; - - script#close -;; +let generate_class_files ctx class_def = + (* create header and cpp files *) + let nativeGen = Meta.has Meta.NativeGen class_def.cl_meta in + if not (nativeGen && (has_class_flag class_def CInterface)) then + CppGenClassImplementation.generate ctx class_def; + CppGenClassHeader.generate ctx class_def (* The common_ctx contains the haxe AST in the "types" field and the resources @@ -8525,32 +221,32 @@ let generate_source ctx = let boot_enums = ref [] in let nonboot_classes = ref [] in let init_classes = ref [] in - let super_deps = create_super_dependencies common_ctx in - let constructor_deps = create_constructor_dependencies common_ctx in + let super_deps = CppGen.create_super_dependencies common_ctx in + let constructor_deps = CppGen.create_constructor_dependencies common_ctx in let main_deps = ref [] in let extern_src = ref [] in let jobs = ref [] in let build_xml = ref "" in - let scriptable = (Common.defined common_ctx Define.Scriptable) in + let scriptable = (Gctx.defined common_ctx Define.Scriptable) in let existingIds = Hashtbl.create 0 in List.iter (fun object_def -> (* check if any @:objc class is referenced while '-D objc' is not defined This will guard all code changes to this flag *) - (if not (Common.defined common_ctx Define.Objc) then match object_def with + (if not (Gctx.defined common_ctx Define.Objc) then match object_def with | TClassDecl class_def when Meta.has Meta.Objc class_def.cl_meta -> abort "In order to compile '@:objc' classes, please define '-D objc'" class_def.cl_pos | _ -> ()); (match object_def with | TClassDecl class_def when is_extern_class class_def -> - build_xml := !build_xml ^ (get_class_code class_def Meta.BuildXml); + build_xml := !build_xml ^ (CppGen.get_class_code class_def Meta.BuildXml); let source = get_meta_string_path class_def.cl_meta Meta.SourceFile in if (source<>"") then extern_src := source :: !extern_src; | TClassDecl class_def -> let name = class_text class_def.cl_path in let is_internal = is_internal_class class_def.cl_path in - if (is_internal || (is_macro class_def.cl_meta)) then + if (is_internal || (Meta.has Meta.Macro class_def.cl_meta)) then ( if (debug>=4) then print_endline (" internal class " ^ name )) else begin let rec makeId class_name seed = @@ -8564,15 +260,15 @@ let generate_source ctx = end in makeId name 0; - build_xml := !build_xml ^ (get_class_code class_def Meta.BuildXml); + build_xml := !build_xml ^ (CppGen.get_class_code class_def Meta.BuildXml); if (has_init_field class_def) then init_classes := class_def.cl_path :: !init_classes; if (has_boot_field class_def) then boot_classes := class_def.cl_path :: !boot_classes - else if not (has_meta_key class_def.cl_meta Meta.NativeGen) then + else if not (Meta.has Meta.NativeGen class_def.cl_meta) then nonboot_classes := class_def.cl_path :: !nonboot_classes; - jobs := (fun () -> generate_class_files ctx super_deps constructor_deps class_def scriptable ) :: !jobs; - let deps = generate_class_deps ctx class_def super_deps constructor_deps scriptable in + jobs := (fun () -> generate_class_files ctx class_def) :: !jobs; + let deps = CppReferences.find_referenced_types ctx (TClassDecl class_def) super_deps constructor_deps false true scriptable in if not ((has_class_flag class_def CInterface) && (is_native_gen_class class_def)) then exe_classes := (class_def.cl_path, deps, object_def) :: !exe_classes; end @@ -8594,12 +290,11 @@ let generate_source ctx = end in makeId name 0; - let meta = Texpr.build_metadata common_ctx.basic object_def in if (has_enum_flag enum_def EnExtern) then (if (debug>1) then print_endline ("external enum " ^ name )); boot_enums := enum_def.e_path :: !boot_enums; - jobs := (fun () -> generate_enum_files ctx enum_def super_deps meta ) :: !jobs; - let deps = generate_enum_deps ctx enum_def super_deps in + jobs := (fun () -> CppGenEnum.generate ctx enum_def) :: !jobs; + let deps = CppReferences.find_referenced_types ctx (TEnumDecl enum_def) super_deps (Hashtbl.create 0) false true false in exe_classes := (enum_def.e_path, deps, object_def) :: !exe_classes; end | TTypeDecl _ | TAbstractDecl _ -> (* already done *) () @@ -8610,27 +305,27 @@ let generate_source ctx = (match common_ctx.main.main_expr with - | None -> generate_dummy_main common_ctx + | None -> CppGen.generate_dummy_main common_ctx | Some e -> let main_field = { (mk_field "__main__" t_dynamic e.epos null_pos) with cf_expr = Some e; } in let class_def = { null_class with cl_path = ([],"@Main"); cl_ordered_statics = [main_field] } in - main_deps := find_referenced_types ctx (TClassDecl class_def) super_deps constructor_deps false true false; - generate_main ctx super_deps class_def + main_deps := CppReferences.find_referenced_types ctx (TClassDecl class_def) super_deps constructor_deps false true false; + CppGen.generate_main ctx super_deps class_def ); - generate_boot ctx !boot_enums !boot_classes !nonboot_classes !init_classes; + CppGen.generate_boot ctx !boot_enums !boot_classes !nonboot_classes !init_classes; - generate_files common_ctx ctx.ctx_file_info; + CppGen.generate_files common_ctx ctx.ctx_file_info; write_resources common_ctx; (* Output class info if requested *) - if (scriptable || (Common.defined common_ctx Define.DllExport) ) then begin + if (scriptable || (Gctx.defined common_ctx Define.DllExport) ) then begin let filename = try - let value = Common.defined_value common_ctx Define.DllExport in + let value = Gctx.defined_value common_ctx Define.DllExport in if value="1" then raise Not_found; value with Not_found -> "export_classes.info" @@ -8664,7 +359,7 @@ let generate_source ctx = (* Output file info too *) List.iter ( fun file -> - let full_path = Path.get_full_path (try Common.find_file common_ctx file with Not_found -> file) in + let full_path = Path.get_full_path (try Gctx.find_file common_ctx file with Not_found -> file) in if file <> "?" then out ("file " ^ (escape file) ^ " " ^ (escape full_path) ^"\n") ) ( List.sort String.compare ( pmap_keys !(ctx.ctx_file_info) ) ); @@ -8678,7 +373,7 @@ let generate_source ctx = write_build_data common_ctx (common_ctx.file ^ "/Build.xml") !exe_classes !main_deps (!boot_enums@ !boot_classes) !build_xml !extern_src output_name; write_build_options common_ctx (common_ctx.file ^ "/Options.txt") common_ctx.defines.Define.values; - if ( not (Common.defined common_ctx Define.NoCompilation) ) then begin + if ( not (Gctx.defined common_ctx Define.NoCompilation) ) then begin let t = Timer.timer ["generate";"cpp";"native compilation"] in let old_dir = Sys.getcwd() in Sys.chdir common_ctx.file; @@ -8697,15 +392,13 @@ let generate_source ctx = Sys.chdir old_dir; t() end - ;; let generate common_ctx = - let debug_level = if (Common.defined common_ctx Define.NoDebug) then 0 else 1 in - if (Common.defined common_ctx Define.Cppia) then begin + let debug_level = if (Gctx.defined common_ctx Define.NoDebug) then 0 else 1 in + if (Gctx.defined common_ctx Define.Cppia) then begin let ctx = new_context common_ctx debug_level (ref PMap.empty) (Hashtbl.create 0) in - generate_cppia ctx + CppCppia.generate_cppia ctx end else begin let ctx = new_context common_ctx debug_level (ref PMap.empty) (create_member_types common_ctx) in generate_source ctx - end -;; + end \ No newline at end of file diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 06b29a4d7d0..2558b7c2f29 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -24,7 +24,7 @@ open Globals open Ast open Type open Error -open Common +open Gctx open Hlcode (* compiler *) @@ -85,7 +85,7 @@ type constval = | CString of string type context = { - com : Common.context; + com : Gctx.t; cglobals : (string, ttype) lookup; cstrings : (string, string) lookup; cbytes : (bytes, bytes) lookup; @@ -325,7 +325,7 @@ let set_curpos ctx p = let make_debug ctx arr = let get_relative_path p = - match Common.defined ctx.com Common.Define.AbsolutePath with + match Gctx.defined ctx.com Define.AbsolutePath with | true -> if (Filename.is_relative p.pfile) then Filename.concat (Sys.getcwd()) p.pfile else p.pfile @@ -3463,7 +3463,7 @@ let generate_static ctx c f = | (Meta.HlNative,[(EConst(String(lib,_)),_)] ,_ ) :: _ -> add_native lib f.cf_name | (Meta.HlNative,[(EConst(Float(ver,_)),_)] ,_ ) :: _ -> - let cur_ver = (try Common.defined_value ctx.com Define.HlVer with Not_found -> "") in + let cur_ver = (try Gctx.defined_value ctx.com Define.HlVer with Not_found -> "") in if cur_ver < ver then let gen_content() = op ctx (OThrow (make_string ctx ("Requires compiling with -D hl-ver=" ^ ver ^ ".0 or higher") null_pos)); @@ -4126,8 +4126,8 @@ let create_context com dump = in let ctx = { com = com; - optimize = not (Common.raw_defined com "hl_no_opt"); - w_null_compare = Common.raw_defined com "hl_w_null_compare"; + optimize = not (Gctx.raw_defined com "hl_no_opt"); + w_null_compare = Gctx.raw_defined com "hl_w_null_compare"; dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None; m = method_context 0 HVoid null_capture false; cints = new_lookup(); @@ -4247,8 +4247,8 @@ let make_context_sign com = let prev_sign = ref "" and prev_data = ref "" let generate com = - let dump = Common.defined com Define.Dump in - let hl_check = Common.raw_defined com "hl_check" in + let dump = Gctx.defined com Define.Dump in + let hl_check = Gctx.raw_defined com "hl_check" in let sign = make_context_sign com in if sign = !prev_sign && not dump && not hl_check then begin @@ -4268,7 +4268,7 @@ let generate com = Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code; close_out ch; end; - (*if Common.raw_defined com "hl_dump_spec" then begin + (*if Gctx.raw_defined com "hl_dump_spec" then begin let ch = open_out_bin "dump/hlspec.txt" in let write s = output_string ch (s ^ "\n") in Array.iter (fun f -> @@ -4294,19 +4294,19 @@ let generate com = if Path.file_extension com.file = "c" then begin let gnames = Array.make (Array.length code.globals) "" in PMap.iter (fun n i -> gnames.(i) <- n) ctx.cglobals.map; - if not (Common.defined com Define.SourceHeader) then begin + if not (Gctx.defined com Define.SourceHeader) then begin let version_major = com.version / 1000 in let version_minor = (com.version mod 1000) / 100 in let version_revision = (com.version mod 100) in - Common.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version); + Gctx.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version); end; Hl2c.write_c com com.file code gnames; let t = Timer.timer ["nativecompile";"hl"] in - if not (Common.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed"; + if not (Gctx.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed"; t(); end else begin let ch = IO.output_string() in - write_code ch code (not (Common.raw_defined com "hl_no_debug")); + write_code ch code (not (Gctx.raw_defined com "hl_no_debug")); let str = IO.close_out ch in let ch = open_out_bin com.file in output_string ch str; @@ -4316,10 +4316,10 @@ let generate com = end; Hlopt.clean_cache(); t(); - if Common.raw_defined com "run" then begin + if Gctx.raw_defined com "run" then begin if com.run_command_args "haxelib" ["run";"hashlink";"run";escape_command com.file] <> 0 then failwith "Failed to run HL"; end; - if Common.defined com Define.Interp then + if Gctx.defined com Define.Interp then try let t = Timer.timer ["generate";"hl";"interp"] in let ctx = Hlinterp.create true in diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index 2a60f6f8093..ce8c98dbd0a 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -21,11 +21,11 @@ open Globals open Ast open Type open Error -open Common +open Gctx open JsSourcemap type ctx = { - com : Common.context; + com : Gctx.t; buf : Rbuffer.t; mutable chan : out_channel option; packages : (string list,unit) Hashtbl.t; @@ -46,7 +46,6 @@ type ctx = { mutable separator : bool; mutable found_expose : bool; mutable catch_vars : texpr list; - mutable deprecation_context : DeprecationCheck.deprecation_context; } type object_store = { @@ -90,7 +89,7 @@ let es5kwds = [ let setup_kwds com = Hashtbl.reset kwds; - let es_version = get_es_version com in + let es_version = Gctx.get_es_version com.defines in let lst = if es_version >= 5 then es5kwds else es3kwds in List.iter (fun s -> Hashtbl.add kwds s ()) lst @@ -148,8 +147,8 @@ let module_field_expose_path mpath f = with Not_found -> (dot_path mpath) ^ "." ^ f.cf_name -let has_feature ctx = Common.has_feature ctx.com -let add_feature ctx = Common.add_feature ctx.com +let has_feature ctx = Gctx.has_feature ctx.com +let add_feature ctx = Gctx.add_feature ctx.com let unsupported p = abort "This expression cannot be compiled to Javascript" p @@ -367,24 +366,6 @@ let rec gen_call ctx e el in_value = | _ -> abort "js.Lib.getOriginalException can only be called inside a catch block" e.epos ) - | TIdent "__new__", args -> - print_deprecation_message ctx.deprecation_context "__new__ is deprecated, use js.Syntax.construct instead" e.epos; - gen_syntax ctx "construct" args e.epos - | TIdent "__js__", args -> - print_deprecation_message ctx.deprecation_context "__js__ is deprecated, use js.Syntax.code instead" e.epos; - gen_syntax ctx "code" args e.epos - | TIdent "__instanceof__", args -> - print_deprecation_message ctx.deprecation_context "__instanceof__ is deprecated, use js.Syntax.instanceof instead" e.epos; - gen_syntax ctx "instanceof" args e.epos - | TIdent "__typeof__", args -> - print_deprecation_message ctx.deprecation_context "__typeof__ is deprecated, use js.Syntax.typeof instead" e.epos; - gen_syntax ctx "typeof" args e.epos - | TIdent "__strict_eq__" , args -> - print_deprecation_message ctx.deprecation_context "__strict_eq__ is deprecated, use js.Syntax.strictEq instead" e.epos; - gen_syntax ctx "strictEq" args e.epos - | TIdent "__strict_neq__" , args -> - print_deprecation_message ctx.deprecation_context "__strict_neq__ is deprecated, use js.Syntax.strictNeq instead" e.epos; - gen_syntax ctx "strictNeq" args e.epos | TIdent "__define_feature__", [_;e] -> gen_expr ctx e | TIdent "__feature__", { eexpr = TConst (TString f) } :: eif :: eelse -> @@ -550,13 +531,13 @@ and gen_expr ctx e = print ctx ",$bind($_,$_%s))" (if Meta.has Meta.SelfCall f.cf_meta then "" else (field f.cf_name))) | TEnumIndex x -> gen_value ctx x; - if not (Common.defined ctx.com Define.JsEnumsAsArrays) then + if not (Gctx.defined ctx.com Define.JsEnumsAsArrays) then print ctx "._hx_index" else print ctx "[1]" | TEnumParameter (x,f,i) -> gen_value ctx x; - if not (Common.defined ctx.com Define.JsEnumsAsArrays) then + if not (Gctx.defined ctx.com Define.JsEnumsAsArrays) then let fname = (match f.ef_type with TFun((args,_)) -> let fname,_,_ = List.nth args i in fname | _ -> die "" __LOC__ ) in print ctx ".%s" (ident fname) else @@ -1031,7 +1012,7 @@ and gen_syntax ctx meth args pos = ) args in - Codegen.interpolate_code ctx.com code args (spr ctx) (gen_value ctx) code_pos + Codegen.interpolate_code ctx.com.error code args (spr ctx) (gen_value ctx) code_pos end | "plainCode", [code] -> let code = @@ -1147,7 +1128,6 @@ let can_gen_class_field ctx = function is_physical_field f let gen_class_field ctx c f = - ctx.deprecation_context <- {ctx.deprecation_context with field_meta = f.cf_meta}; check_field_name c f; match f.cf_expr with | None -> @@ -1473,7 +1453,6 @@ let generate_class_es6 ctx c = let generate_class ctx c = ctx.current <- c; - ctx.deprecation_context <- {ctx.deprecation_context with class_meta = c.cl_meta}; ctx.id_counter <- 0; (match c.cl_path with | [],"Function" -> abort "This class redefine a native one" c.cl_pos @@ -1496,7 +1475,7 @@ let generate_enum ctx e = else generate_package_create ctx e.e_path; print ctx "%s = " p; - let as_objects = not (Common.defined ctx.com Define.JsEnumsAsArrays) in + let as_objects = not (Gctx.defined ctx.com Define.JsEnumsAsArrays) in (if as_objects then print ctx "$hxEnums[\"%s\"] = " dotp else if has_feature ctx "Type.resolveEnum" then @@ -1653,7 +1632,7 @@ let set_current_class ctx c = let alloc_ctx com es_version = let smap = - if com.debug || Common.defined com Define.JsSourceMap || Common.defined com Define.SourceMap then + if com.debug || Gctx.defined com Define.JsSourceMap || Gctx.defined com Define.SourceMap then Some { source_last_pos = { file = 0; line = 0; col = 0}; print_comma = false; @@ -1673,10 +1652,10 @@ let alloc_ctx com es_version = chan = None; packages = Hashtbl.create 0; smap = smap; - js_modern = not (Common.defined com Define.JsClassic); - js_flatten = not (Common.defined com Define.JsUnflatten); - has_resolveClass = Common.has_feature com "Type.resolveClass"; - has_interface_check = Common.has_feature com "js.Boot.__interfLoop"; + js_modern = not (Gctx.defined com Define.JsClassic); + js_flatten = not (Gctx.defined com Define.JsUnflatten); + has_resolveClass = Gctx.has_feature com "Type.resolveClass"; + has_interface_check = Gctx.has_feature com "js.Boot.__interfLoop"; es_version = es_version; statics = []; inits = []; @@ -1689,7 +1668,6 @@ let alloc_ctx com es_version = separator = false; found_expose = false; catch_vars = []; - deprecation_context = DeprecationCheck.create_context com; } in ctx.type_accessor <- (fun t -> @@ -1714,22 +1692,22 @@ let gen_single_expr ctx e expr = ctx.id_counter <- 0; str -let generate com = - (match com.js_gen with +let generate js_gen com = + (match js_gen with | Some g -> g() | None -> - let es_version = get_es_version com in + let es_version = Gctx.get_es_version com.defines in if es_version >= 6 then ES6Ctors.rewrite_ctors com; let ctx = alloc_ctx com es_version in - Codegen.map_source_header com (fun s -> print ctx "// %s\n" s); + Gctx.map_source_header com.defines (fun s -> print ctx "// %s\n" s); if has_feature ctx "Class" || has_feature ctx "Type.getClassName" then add_feature ctx "js.Boot.isClass"; if has_feature ctx "Enum" || has_feature ctx "Type.getEnumName" then add_feature ctx "js.Boot.isEnum"; - let nodejs = Common.raw_defined com "nodejs" in + let nodejs = Gctx.raw_defined com "nodejs" in setup_kwds com; @@ -1792,7 +1770,7 @@ let generate com = | _ -> () ) include_files; - let defined_global_value = Common.defined_value_safe com Define.JsGlobal in + let defined_global_value = Gctx.defined_value_safe com Define.JsGlobal in let defined_global = defined_global_value <> "" in @@ -1813,7 +1791,7 @@ let generate com = ) in let closureArgs = [var_global] in - let closureArgs = if (anyExposed && not (Common.defined com Define.ShallowExpose)) then + let closureArgs = if (anyExposed && not (Gctx.defined com Define.ShallowExpose)) then var_exports :: closureArgs else closureArgs @@ -1829,7 +1807,7 @@ let generate com = (* Add node globals to pseudo-keywords, so they are not shadowed by local vars *) List.iter (fun s -> Hashtbl.replace kwds2 s ()) [ "global"; "process"; "__filename"; "__dirname"; "module" ]; - if (anyExposed && ((Common.defined com Define.ShallowExpose) || not ctx.js_modern)) then ( + if (anyExposed && ((Gctx.defined com Define.ShallowExpose) || not ctx.js_modern)) then ( print ctx "var %s = %s" (fst var_exports) (snd var_exports); ctx.separator <- true; newline ctx @@ -1870,7 +1848,7 @@ let generate com = if (not ctx.js_modern) && (ctx.es_version < 5) then spr ctx "var console = $global.console || {log:function(){}};\n"; - let enums_as_objects = not (Common.defined com Define.JsEnumsAsArrays) in + let enums_as_objects = not (Gctx.defined com Define.JsEnumsAsArrays) in (* TODO: fix $estr *) let vars = [] in @@ -1989,7 +1967,7 @@ let generate com = newline ctx; end; - if (anyExposed && (Common.defined com Define.ShallowExpose)) then ( + if (anyExposed && (Gctx.defined com Define.ShallowExpose)) then ( List.iter (fun f -> print ctx "var %s = $hx_exports%s" f.os_name (path_to_brackets f.os_name); ctx.separator <- true; @@ -2006,7 +1984,7 @@ let generate com = | Some smap -> write_mappings ctx.com smap "file:///"; let basefile = Filename.basename com.file in - print ctx "\n//# sourceMappingURL=%s.map" (url_encode_s basefile); + print ctx "\n//# sourceMappingURL=%s.map" (StringHelper.url_encode_s basefile); | None -> try Sys.remove (com.file ^ ".map") with _ -> ()); flush ctx; Option.may (fun chan -> close_out chan) ctx.chan diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 9a9613fa737..ad6033244ba 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -19,7 +19,7 @@ open Globals open Ast -open Common +open Gctx open Type open Path open JvmGlobals @@ -53,7 +53,7 @@ let get_construction_mode c cf = (* Haxe *) type generation_context = { - com : Common.context; + gctx : Gctx.t; out : Zip_output.any_output; t_runtime_exception : Type.t; entry_point : (tclass * texpr) option; @@ -126,13 +126,13 @@ open NativeSignatures let jsignature_of_path path = match path with | [],"Bool" -> TBool - | ["java"],"Int8" -> TByte - | ["java"],"Int16" -> TShort + | ["jvm"],"Int8" -> TByte + | ["jvm"],"Int16" -> TShort | [],"Int" -> TInt | ["haxe"],"Int32" -> TInt | ["haxe"],"Int64" -> TLong - | ["java"],"Int64" -> TLong - | ["java"],"Char16" -> TChar + | ["jvm"],"Int64" -> TLong + | ["jvm"],"Char16" -> TChar | [],"Single" -> TFloat | [],"Float" -> TDouble | [],"Dynamic" -> object_sig @@ -183,7 +183,7 @@ let rec jsignature_of_type gctx stack t = | TInst({cl_path = (["haxe";"root"],"Array")},[t]) -> let t = get_boxed_type (jsignature_of_type t) in TObject((["haxe";"root"],"Array"),[TType(WNone,t)]) - | TInst({cl_path = (["java"],"NativeArray")},[t]) -> + | TInst({cl_path = (["jvm"],"NativeArray")},[t]) -> TArray(jsignature_of_type t,None) | TInst({cl_kind = KTypeParameter ttp; cl_path = (_,name)},_) -> begin match get_constraints ttp with @@ -515,7 +515,6 @@ class texpr_to_jvm (jm : JvmMethod.builder) (return_type : jsignature option) = object(self) - val com = gctx.com val code = jm#get_code val pool : JvmConstantPool.constant_pool = jc#get_pool @@ -531,7 +530,7 @@ class texpr_to_jvm method vtype t = jsignature_of_type gctx t - method mknull t = com.basic.tnull (follow t) + method mknull t = gctx.gctx.basic.tnull (follow t) (* locals *) @@ -745,7 +744,7 @@ class texpr_to_jvm | FInstance({cl_path = (["java";"lang"],"String")},_,{cf_name = "length"}) -> self#texpr rvalue_any e1; jm#invokevirtual string_path "length" (method_sig [] (Some TInt)) - | FInstance({cl_path = (["java"],"NativeArray")},_,{cf_name = "length"}) -> + | FInstance({cl_path = (["jvm"],"NativeArray")},_,{cf_name = "length"}) -> self#texpr rvalue_any e1; let vtobj = self#vtype e1.etype in code#arraylength vtobj; @@ -858,7 +857,7 @@ class texpr_to_jvm apply (fun () -> code#dup_x2;); jm#expect_reference_type; jm#invokevirtual c.cl_path "__set" (method_sig [TInt;object_sig] None); - | TInst({cl_path = (["java"],"NativeArray")},[t]) -> + | TInst({cl_path = (["jvm"],"NativeArray")},[t]) -> let vte = self#vtype t in let vta = self#vtype e1.etype in self#texpr rvalue_any e1; @@ -1000,13 +999,13 @@ class texpr_to_jvm store(); let ev = mk (TLocal v) v.v_type null_pos in let el = List.rev_map (fun case -> - let f e' = mk (TBinop(OpEq,ev,e')) com.basic.tbool e'.epos in + let f e' = mk (TBinop(OpEq,ev,e')) gctx.gctx.basic.tbool e'.epos in let e_cond = match case.case_patterns with | [] -> die "" __LOC__ | [e] -> f e | e :: el -> List.fold_left (fun eacc e -> - mk (TBinop(OpBoolOr,eacc,f e)) com.basic.tbool e.epos + mk (TBinop(OpBoolOr,eacc,f e)) gctx.gctx.basic.tbool e.epos ) (f e) el in (e_cond,case.case_expr) @@ -1635,9 +1634,9 @@ class texpr_to_jvm | _ -> die "" __LOC__ end - | TIdent "__array__" | TField(_,FStatic({cl_path = (["java"],"NativeArray")},{cf_name = "make"})) -> + | TIdent "__array__" | TField(_,FStatic({cl_path = (["jvm"],"NativeArray")},{cf_name = "make"})) -> begin match follow tr with - | TInst({cl_path = (["java"],"NativeArray")},[t]) -> + | TInst({cl_path = (["jvm"],"NativeArray")},[t]) -> let jsig = self#vtype t in self#new_native_array jsig el; Some (array_sig jsig) @@ -2047,7 +2046,7 @@ class texpr_to_jvm else self#read (fun () -> self#cast_expect ret e.etype) e1 fa; | TCall(e1,el) -> self#call ret e.etype e1 el - | TNew({cl_path = (["java"],"NativeArray")},[t],[e1]) -> + | TNew({cl_path = (["jvm"],"NativeArray")},[t],[e1]) -> self#texpr (if need_val ret then rvalue_any else RVoid) e1; (* Technically this could throw... but whatever *) if need_val ret then ignore(NativeArray.create jm#get_code jc#get_pool (jsignature_of_type gctx t)) @@ -2103,7 +2102,7 @@ class texpr_to_jvm jm#cast TInt; jm#invokevirtual c.cl_path "__get" (method_sig [TInt] (Some object_sig)); self#cast e.etype - | TInst({cl_path = (["java"],"NativeArray")},[t]) -> + | TInst({cl_path = (["jvm"],"NativeArray")},[t]) -> self#texpr rvalue_any e1; let vt = self#vtype e1.etype in let vte = self#vtype t in @@ -2143,7 +2142,7 @@ class texpr_to_jvm | TParenthesis e1 | TMeta(_,e1) -> self#texpr ret e1 | TFor(v,e1,e2) -> - self#texpr ret (Texpr.for_remap com.basic v e1 e2 e.epos) + self#texpr ret (Texpr.for_remap gctx.gctx.basic v e1 e2 e.epos) | TEnumIndex e1 -> self#texpr rvalue_any e1; jm#invokevirtual java_enum_path "ordinal" (method_sig [] (Some TInt)) @@ -2593,9 +2592,9 @@ class tclass_to_jvm gctx c = object(self) | None -> if c.cl_path = (["haxe"],"Resource") && cf.cf_name = "content" then begin let el = Hashtbl.fold (fun name _ acc -> - Texpr.Builder.make_string gctx.com.basic name null_pos :: acc - ) gctx.com.resources [] in - let e = mk (TArrayDecl el) (gctx.com.basic.tarray gctx.com.basic.tstring) null_pos in + Texpr.Builder.make_string gctx.gctx.basic name null_pos :: acc + ) gctx.gctx.resources [] in + let e = mk (TArrayDecl el) (gctx.gctx.basic.tarray gctx.gctx.basic.tstring) null_pos in default e; end; | Some e when mtype <> MStatic -> @@ -2606,8 +2605,8 @@ class tclass_to_jvm gctx c = object(self) begin match cf.cf_kind with | Method MethDynamic -> let enull = Texpr.Builder.make_null efield.etype null_pos in - let echeck = Texpr.Builder.binop OpEq efield enull gctx.com.basic.tbool null_pos in - let eif = mk (TIf(echeck,eop,None)) gctx.com.basic.tvoid null_pos in + let echeck = Texpr.Builder.binop OpEq efield enull gctx.gctx.basic.tbool null_pos in + let eif = mk (TIf(echeck,eop,None)) gctx.gctx.basic.tvoid null_pos in DynArray.add delayed_field_inits eif | _ -> DynArray.add field_inits eop @@ -2644,11 +2643,11 @@ class tclass_to_jvm gctx c = object(self) let jsig = method_sig [array_sig string_sig] None in let jm = jc#spawn_method "main" jsig [MPublic;MStatic] in let _,load,_ = jm#add_local "args" (TArray(string_sig,None)) VarArgument in - if has_feature gctx.com "haxe.root.Sys.args" then begin + if has_feature gctx.gctx "haxe.root.Sys.args" then begin load(); jm#putstatic (["haxe";"root"],"Sys") "_args" (TArray(string_sig,None)) end; - jm#invokestatic (["haxe"; "java"], "Init") "init" (method_sig [] None); + jm#invokestatic (["haxe"; "jvm"], "Jvm") "init" (method_sig [] None); self#generate_expr gctx None jc jm e SCNone MStatic; if not jm#is_terminated then jm#return @@ -2874,7 +2873,7 @@ let generate_enum gctx en = jm_values#new_native_array (object_path_sig jc_enum#get_this_path) fl; jm_values#return; (* Add __meta__ TODO: do this via annotations instead? *) - begin match Texpr.build_metadata gctx.com.basic (TEnumDecl en) with + begin match Texpr.build_metadata gctx.gctx.basic (TEnumDecl en) with | None -> () | Some e -> @@ -3037,7 +3036,7 @@ module Preprocessor = struct | _ -> () ) m.m_types - ) gctx.com.modules; + ) gctx.gctx.modules; (* preprocess classes *) List.iter (fun mt -> match mt with @@ -3047,24 +3046,24 @@ module Preprocessor = struct else if has_class_flag c CFunctionalInterface then check_functional_interface gctx c | _ -> () - ) gctx.com.types; + ) gctx.gctx.types; (* find typedef-interface implementations *) List.iter (fun mt -> match mt with | TClassDecl c when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) -> gctx.typedef_interfaces#process_class c; | _ -> () - ) gctx.com.types + ) gctx.gctx.types end -let generate jvm_flag com = - let path = FilePath.parse com.file in - let jar_name,entry_point = match get_entry_point com with +let generate jvm_flag gctx = + let path = FilePath.parse gctx.file in + let jar_name,entry_point = match get_entry_point gctx with | Some (jarname,cl,expr) -> jarname, Some (cl,expr) | None -> "jar",None in let compression_level = try - int_of_string (Define.defined_value com.defines Define.JvmCompressionLevel) + int_of_string (Define.defined_value gctx.defines Define.JvmCompressionLevel) with _ -> 6 in @@ -3077,10 +3076,10 @@ let generate jvm_flag com = | Some _ -> begin match path.directory with | None -> - "./",create_jar ("./" ^ com.file) + "./",create_jar ("./" ^ gctx.file) | Some dir -> mkdir_from_path dir; - add_trailing_slash dir,create_jar com.file + add_trailing_slash dir,create_jar gctx.file end | None -> match path.directory with | Some dir -> @@ -3089,25 +3088,25 @@ let generate jvm_flag com = | None -> failwith "Please specify an output file name" end else begin - let jar_name = if com.debug then jar_name ^ "-Debug" else jar_name in - let jar_dir = add_trailing_slash com.file in + let jar_name = if gctx.debug then jar_name ^ "-Debug" else jar_name in + let jar_dir = add_trailing_slash gctx.file in let jar_path = Printf.sprintf "%s%s.jar" jar_dir jar_name in jar_dir,create_jar jar_path end in let anon_identification = new tanon_identification in let dynamic_level = try - int_of_string (Define.defined_value com.defines Define.JvmDynamicLevel) + int_of_string (Define.defined_value gctx.defines Define.JvmDynamicLevel) with _ -> 1 in if dynamic_level < 0 || dynamic_level > 2 then failwith "Invalid value for -D jvm.dynamic-level: Must be >=0 and <= 2"; let gctx = { - com = com; + gctx = gctx; out = out; - t_runtime_exception = TInst(resolve_class com (["java";"lang"],"RuntimeException"),[]); + t_runtime_exception = TInst(resolve_class gctx (["java";"lang"],"RuntimeException"),[]); entry_point = entry_point; - t_exception = TInst(resolve_class com (["java";"lang"],"Exception"),[]); - t_throwable = TInst(resolve_class com (["java";"lang"],"Throwable"),[]); + t_exception = TInst(resolve_class gctx (["java";"lang"],"Exception"),[]); + t_throwable = TInst(resolve_class gctx (["java";"lang"],"Throwable"),[]); anon_identification = anon_identification; preprocessor = Obj.magic (); typedef_interfaces = Obj.magic (); @@ -3118,14 +3117,14 @@ let generate jvm_flag com = default_export_config = { export_debug = true; }; - detail_times = Common.raw_defined com "jvm_times"; + detail_times = Gctx.raw_defined gctx "jvm_times"; timer = new Timer.timer ["generate";"java"]; jar_compression_level = compression_level; dynamic_level = dynamic_level; functional_interfaces = []; } in Hashtbl.add gctx.known_typed_functions haxe_function_path (); - gctx.preprocessor <- new preprocessor com.basic (jsignature_of_type gctx); + gctx.preprocessor <- new preprocessor gctx.gctx.basic (jsignature_of_type gctx); gctx.typedef_interfaces <- new typedef_interfaces gctx.preprocessor#get_infos anon_identification; gctx.typedef_interfaces#add_interface_rewrite (["haxe";"root"],"Iterator") (["java";"util"],"Iterator") true; let class_paths = ExtList.List.filter_map (fun java_lib -> @@ -3142,13 +3141,13 @@ let generate jvm_flag com = close_out ch_out; Some (Printf.sprintf "lib/%s \n" name) end - ) com.native_libs.java_libs in + ) gctx.gctx.native_libs in Hashtbl.iter (fun name v -> let filename = StringHelper.escape_res_name name ['/';'-'] in gctx.out#add_entry v filename; - ) com.resources; + ) gctx.gctx.resources; let generate_real_types () = - List.iter (generate_module_type gctx) com.types; + List.iter (generate_module_type gctx) gctx.gctx.types; in let generate_typed_interfaces () = Hashtbl.iter (fun _ c -> generate_module_type gctx (TClassDecl c)) gctx.typedef_interfaces#get_interfaces; diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml index cab664cb4d6..b0bb638f4fd 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -23,7 +23,7 @@ open Extlib_leftovers open Ast open Type -open Common +open Gctx open ExtList open Error open JsSourcemap @@ -31,7 +31,7 @@ open JsSourcemap type pos = Globals.pos type ctx = { - com : Common.context; + com : Gctx.t; buf : Buffer.t; packages : (string list,unit) Hashtbl.t; smap : sourcemap option; @@ -137,8 +137,8 @@ let static_field c s = | "length" | "name" when not (has_class_flag c CExtern) || Meta.has Meta.HxGen c.cl_meta-> "._hx" ^ s | s -> field s -let has_feature ctx = Common.has_feature ctx.com -let add_feature ctx = Common.add_feature ctx.com +let has_feature ctx = Gctx.has_feature ctx.com +let add_feature ctx = Gctx.add_feature ctx.com let temp ctx = ctx.id_counter <- ctx.id_counter + 1; @@ -458,7 +458,7 @@ and gen_call ctx e el = | TIdent "__lua__", [{ eexpr = TConst (TString code) }] -> spr ctx (String.concat "\n" (ExtString.String.nsplit code "\r\n")) | TIdent "__lua__", { eexpr = TConst (TString code); epos = p } :: tl -> - Codegen.interpolate_code ctx.com code tl (spr ctx) (gen_expr ctx) p + Codegen.interpolate_code ctx.com.error code tl (spr ctx) (gen_expr ctx) p | TIdent "__type__", [o] -> spr ctx "type"; gen_paren ctx [o]; @@ -1886,7 +1886,7 @@ let generate_type_forward ctx = function let alloc_ctx com = let smap = - if com.debug || Common.defined com Define.SourceMap then + if com.debug || Gctx.defined com Define.SourceMap then Some { source_last_pos = { file = 0; line = 0; col = 0}; print_comma = false; @@ -1919,10 +1919,10 @@ let alloc_ctx com = type_accessor = (fun _ -> Globals.die "" __LOC__); separator = false; found_expose = false; - lua_jit = Common.defined com Define.LuaJit; - lua_vanilla = Common.defined com Define.LuaVanilla; + lua_jit = Gctx.defined com Define.LuaJit; + lua_vanilla = Gctx.defined com Define.LuaVanilla; lua_ver = try - float_of_string (Common.defined_value com Define.LuaVer) + float_of_string (Gctx.defined_value com Define.LuaVer) with | Not_found -> 5.2; } in ctx.type_accessor <- (fun t -> @@ -2009,7 +2009,7 @@ let transform_multireturn ctx = function let generate com = let ctx = alloc_ctx com in - Codegen.map_source_header com (fun s -> print ctx "-- %s\n" s); + Gctx.map_source_header com.defines (fun s -> print ctx "-- %s\n" s); if has_feature ctx "Class" || has_feature ctx "Type.getClassName" then add_feature ctx "lua.Boot.isClass"; if has_feature ctx "Enum" || has_feature ctx "Type.getEnumName" then add_feature ctx "lua.Boot.isEnum"; @@ -2019,20 +2019,22 @@ let generate com = print ctx "%s\n" file_content; in + let find_file f = (com.class_paths#find_file f).file in + (* base table-to-array helpers and metatables *) - print_file (Common.find_file com "lua/_lua/_hx_tab_array.lua"); + print_file (find_file "lua/_lua/_hx_tab_array.lua"); (* base lua "toString" functionality for haxe objects*) - print_file (Common.find_file com "lua/_lua/_hx_tostring.lua"); + print_file (find_file "lua/_lua/_hx_tostring.lua"); (* base lua metatables for prototypes, inheritance, etc. *) - print_file (Common.find_file com "lua/_lua/_hx_anon.lua"); + print_file (find_file "lua/_lua/_hx_anon.lua"); (* Helpers for creating metatables from prototypes *) - print_file (Common.find_file com "lua/_lua/_hx_objects.lua"); + print_file (find_file "lua/_lua/_hx_objects.lua"); (* base runtime class stubs for haxe value types (Int, Float, etc) *) - print_file (Common.find_file com "lua/_lua/_hx_classes.lua"); + print_file (find_file "lua/_lua/_hx_classes.lua"); let include_files = List.rev com.include_files in List.iter (fun file -> @@ -2122,18 +2124,18 @@ let generate com = (* If bit ops are manually imported include the haxe wrapper for them *) if has_feature ctx "use._bitop" then begin - print_file (Common.find_file com "lua/_lua/_hx_bit.lua"); + print_file (find_file "lua/_lua/_hx_bit.lua"); end; (* integer clamping is always required, and will use bit ops if available *) - print_file (Common.find_file com "lua/_lua/_hx_bit_clamp.lua"); + print_file (find_file "lua/_lua/_hx_bit_clamp.lua"); (* Array is required, always patch it *) println ctx "_hx_array_mt.__index = Array.prototype"; newline ctx; (* Functions to support auto-run of libuv loop *) - print_file (Common.find_file com "lua/_lua/_hx_luv.lua"); + print_file (find_file "lua/_lua/_hx_luv.lua"); let b = open_block ctx in (* Localize init variables inside a do-block *) @@ -2148,45 +2150,45 @@ let generate com = newline ctx; if has_feature ctx "use._hx_bind" then begin - print_file (Common.find_file com "lua/_lua/_hx_bind.lua"); + print_file (find_file "lua/_lua/_hx_bind.lua"); end; if has_feature ctx "use._hx_staticToInstance" then begin - print_file (Common.find_file com "lua/_lua/_hx_static_to_instance.lua"); + print_file (find_file "lua/_lua/_hx_static_to_instance.lua"); end; if has_feature ctx "use._hx_funcToField" then begin - print_file (Common.find_file com "lua/_lua/_hx_func_to_field.lua"); + print_file (find_file "lua/_lua/_hx_func_to_field.lua"); end; if has_feature ctx "Math.random" then begin - print_file (Common.find_file com "lua/_lua/_hx_random_init.lua"); + print_file (find_file "lua/_lua/_hx_random_init.lua"); end; if has_feature ctx "use._hx_print" then - print_file (Common.find_file com "lua/_lua/_hx_print.lua"); + print_file (find_file "lua/_lua/_hx_print.lua"); if has_feature ctx "use._hx_apply_self" then begin - print_file (Common.find_file com "lua/_lua/_hx_apply_self.lua"); + print_file (find_file "lua/_lua/_hx_apply_self.lua"); end; if has_feature ctx "use._hx_box_mr" then begin - print_file (Common.find_file com "lua/_lua/_hx_box_mr.lua"); + print_file (find_file "lua/_lua/_hx_box_mr.lua"); end; if has_feature ctx "use._hx_table" then begin - print_file (Common.find_file com "lua/_lua/_hx_table.lua"); + print_file (find_file "lua/_lua/_hx_table.lua"); end; if has_feature ctx "use._hx_wrap_if_string_field" then begin - print_file (Common.find_file com "lua/_lua/_hx_wrap_if_string_field.lua"); + print_file (find_file "lua/_lua/_hx_wrap_if_string_field.lua"); end; if has_feature ctx "use._hx_dyn_add" then begin - print_file (Common.find_file com "lua/_lua/_hx_dyn_add.lua"); + print_file (find_file "lua/_lua/_hx_dyn_add.lua"); end; - print_file (Common.find_file com "lua/_lua/_hx_handle_error.lua"); + print_file (find_file "lua/_lua/_hx_handle_error.lua"); println ctx "_hx_static_init();"; diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml index 29a43826933..13b7cd0cabe 100644 --- a/src/generators/genneko.ml +++ b/src/generators/genneko.ml @@ -21,11 +21,11 @@ open Ast open Globals open Type open Nast -open Common +open Gctx type context = { version : int; - com : Common.context; + com : Gctx.t; packages : (string list, unit) Hashtbl.t; globals : (string list * string, string) Hashtbl.t; mutable curglobal : int; @@ -50,7 +50,7 @@ let pos ctx p = try Hashtbl.find files p.pfile with Not_found -> - let path = (match Common.defined ctx.com Common.Define.AbsolutePath with + let path = (match Gctx.defined ctx.com Define.AbsolutePath with | true -> if (Filename.is_relative p.pfile) then Filename.concat (Sys.getcwd()) p.pfile else p.pfile @@ -371,7 +371,7 @@ and gen_expr ctx e = | TCast (e,None) -> gen_expr ctx e | TCast (e1,Some t) -> - gen_expr ctx (Codegen.default_cast ~vtmp:"@tmp" ctx.com e1 t e.etype e.epos) + gen_expr ctx (Codegen.default_cast ~vtmp:"@tmp" ctx.com.basic ctx.com.std e1 t e.etype e.epos) | TIdent s -> ident p s | TSwitch {switch_subject = e;switch_cases = cases;switch_default = eo} -> @@ -771,19 +771,19 @@ let build ctx types = let vars = List.concat (List.map (gen_static_vars ctx) types) in packs @ methods @ boot :: names @ inits @ vars -let generate com = +let generate neko_lib_paths com = Hashtbl.clear files; - let ctx = new_context com (if Common.defined com Define.NekoV1 then 1 else 2) false in + let ctx = new_context com (if Gctx.defined com Define.NekoV1 then 1 else 2) false in let libs = (EBlock - (if Common.defined com Define.NekoNoHaxelibPaths then [] - else generate_libs_init com.neko_lib_paths), + (if Gctx.defined com Define.NekoNoHaxelibPaths then [] + else generate_libs_init neko_lib_paths), { psource = "
"; pline = 1; } ) in let el = build ctx com.types in let emain = (match com.main.main_expr with None -> [] | Some e -> [gen_expr ctx e]) in let e = (EBlock ((header()) @ libs :: el @ emain), null_pos) in - let source = Common.defined com Define.NekoSource in - let use_nekoc = Common.defined com Define.UseNekoc in + let source = Gctx.defined com Define.NekoSource in + let use_nekoc = Gctx.defined com Define.UseNekoc in if not use_nekoc then begin try Path.mkdir_from_path com.file; @@ -791,7 +791,7 @@ let generate com = Nbytecode.write ch (Ncompile.compile ctx.version e); IO.close_out ch; with Ncompile.Error (msg,pos) -> - let pfile = Common.find_file com pos.psource in + let pfile = Gctx.find_file com pos.psource in let rec loop p = let pp = { pfile = pfile; pmin = p; pmax = p; } in if Lexer.get_error_line pp >= pos.pline then diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml index c89e41b3e55..2cd92e8f6b0 100644 --- a/src/generators/genphp7.ml +++ b/src/generators/genphp7.ml @@ -3,8 +3,8 @@ *) open Ast +open Gctx open Type -open Common open Meta open Globals open Sourcemaps @@ -72,7 +72,7 @@ type used_type = { } type php_generator_context = { - pgc_common : Common.context; + pgc_common : Gctx.t; (** Do not add comments with Haxe positions before each line of generated php code *) pgc_skip_line_directives : bool; (** The value of `-D php-prefix=value` split by dots *) @@ -2011,8 +2011,6 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = @see http://old.haxe.org/doc/advanced/magic#php-magic *) method write_expr_magic name args = - let msg = "untyped " ^ name ^ " is deprecated. Use php.Syntax instead." in - DeprecationCheck.warn_deprecation (DeprecationCheck.create_context ctx.pgc_common) msg self#pos; let error = ("Invalid arguments for " ^ name ^ " magic call") in match args with | [] -> fail ~msg:error self#pos __LOC__ @@ -2021,7 +2019,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | "__php__" -> (match expr.eexpr with | TConst (TString php) -> - Codegen.interpolate_code ctx.pgc_common php args self#write self#write_expr self#pos + Codegen.interpolate_code ctx.pgc_common.error php args self#write self#write_expr self#pos | _ -> fail self#pos __LOC__ ) | "__call__" -> @@ -2445,7 +2443,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = ) args in - Codegen.interpolate_code ctx.pgc_common php args self#write self#write_expr self#pos + Codegen.interpolate_code ctx.pgc_common.error php args self#write self#write_expr self#pos | _ -> ctx.pgc_common.error "First argument of php.Syntax.code() must be a constant string." self#pos (** Writes error suppression operator (for `php.Syntax.suppress()`) @@ -3045,7 +3043,7 @@ class virtual type_builder ctx (wrapper:type_wrapper) = writer#indent 0; writer#write_line " writer#write_line (" * " ^ s)); + Gctx.map_source_header ctx.pgc_common.defines (fun s -> writer#write_line (" * " ^ s)); if ctx.pgc_common.debug then writer#write_line (" * Haxe source file: " ^ self#get_source_file); writer#write_line " */"; writer#write "\n"; @@ -3944,7 +3942,7 @@ class generator (ctx:php_generator_context) = and name = builder#get_name in let filename = (create_dir_recursive (build_dir :: namespace)) ^ "/" ^ name ^ ".php" in let channel = open_out filename in - if Common.defined ctx.pgc_common Define.SourceMap then + if Gctx.defined ctx.pgc_common Define.SourceMap then builder#set_sourcemap_generator (new sourcemap_builder filename); output_string channel builder#get_contents; close_out channel; @@ -3993,7 +3991,7 @@ class generator (ctx:php_generator_context) = match self#get_entry_point with | None -> () | Some (uses, entry_point) -> - let filename = Common.defined_value_safe ~default:"index.php" ctx.pgc_common Define.PhpFront in + let filename = Gctx.defined_value_safe ~default:"index.php" ctx.pgc_common Define.PhpFront in let front_dirs = split_file_path (Filename.dirname filename) in if front_dirs <> [] then ignore(create_dir_recursive (root_dir :: front_dirs)); @@ -4032,7 +4030,7 @@ class generator (ctx:php_generator_context) = Returns path from `index.php` to directory which will contain all generated classes *) method private get_lib_path : string list = - let path = Common.defined_value_safe ~default:"lib" ctx.pgc_common Define.PhpLib in + let path = Gctx.defined_value_safe ~default:"lib" ctx.pgc_common Define.PhpLib in split_file_path path (** Returns PHP code for entry point @@ -4069,12 +4067,12 @@ let get_boot com : tclass = (** Entry point to Genphp7 *) -let generate (com:context) = +let generate (com:Gctx.t) = let ctx = { pgc_common = com; - pgc_skip_line_directives = Common.defined com Define.RealPosition; - pgc_prefix = Str.split (Str.regexp "\\.") (Common.defined_value_safe com Define.PhpPrefix); + pgc_skip_line_directives = Gctx.defined com Define.RealPosition; + pgc_prefix = Str.split (Str.regexp "\\.") (Gctx.defined_value_safe com Define.PhpPrefix); pgc_boot = get_boot com; pgc_namespaces_types_cache = Hashtbl.create 512; pgc_anons = Hashtbl.create 0; diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index c170bd436ca..e58d05dcc90 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -21,7 +21,7 @@ open Globals open Ast open Error open Type -open Common +open Gctx open Texpr.Builder module Utils = struct @@ -955,7 +955,8 @@ module Transformer = struct let r = { a_expr with eexpr = TArrayDecl exprs } in lift_expr ae.a_next_id ~blocks:blocks r | (is_value, TCast(e1,Some mt)) -> - let e = Codegen.default_cast ~vtmp:(ae.a_next_id()) (match !como with Some com -> com | None -> die "" __LOC__) e1 mt ae.a_expr.etype ae.a_expr.epos in + let com = (match !como with Some com -> com | None -> die "" __LOC__) in + let e = Codegen.default_cast ~vtmp:(ae.a_next_id()) com.basic com.std e1 mt ae.a_expr.etype ae.a_expr.epos in transform_expr ae.a_next_id ~is_value:is_value e | (is_value, TCast(e,None)) -> let e = trans is_value [] e in @@ -999,12 +1000,12 @@ module Printer = struct pc_indent : string; pc_next_anon_func : unit -> string; pc_debug : bool; - pc_com : Common.context; + pc_com : Gctx.t; } - let has_feature pctx = Common.has_feature pctx.pc_com + let has_feature pctx = Gctx.has_feature pctx.pc_com - let add_feature pctx = Common.add_feature pctx.pc_com + let add_feature pctx = Gctx.add_feature pctx.pc_com let create_context = let n = ref (-1) in @@ -1491,11 +1492,9 @@ module Printer = struct | ("python_Syntax.code"),({ eexpr = TConst (TString code) } as ecode) :: tl -> let buf = Buffer.create 0 in let interpolate () = - Codegen.interpolate_code pctx.pc_com code tl (Buffer.add_string buf) (fun e -> Buffer.add_string buf (print_expr pctx e)) ecode.epos + Codegen.interpolate_code pctx.pc_com.error code tl (Buffer.add_string buf) (fun e -> Buffer.add_string buf (print_expr pctx e)) ecode.epos in - let old = pctx.pc_com.error_ext in - pctx.pc_com.error_ext <- (fun err -> raise (Error.Fatal_error err)); - Std.finally (fun() -> pctx.pc_com.error_ext <- old) interpolate (); + interpolate (); Buffer.contents buf | ("python_Syntax._pythonCode"), [e] -> print_expr pctx e @@ -1673,7 +1672,7 @@ end module Generator = struct type context = { - com : Common.context; + com : Gctx.t; buf : Buffer.t; packages : (string,int) Hashtbl.t; mutable static_inits : (unit -> unit) list; @@ -1683,8 +1682,8 @@ module Generator = struct print_time : float; } - let has_feature ctx = Common.has_feature ctx.com - let add_feature ctx = Common.add_feature ctx.com + let has_feature ctx = Gctx.has_feature ctx.com + let add_feature ctx = Gctx.add_feature ctx.com type class_field_infos = { cfd_fields : string list; @@ -2427,7 +2426,7 @@ module Generator = struct let run com = Transformer.init com; let ctx = mk_context com in - Codegen.map_source_header com (fun s -> print ctx "# %s\n# coding: utf-8\n" s); + Gctx.map_source_header com.defines (fun s -> print ctx "# %s\n# coding: utf-8\n" s); if has_feature ctx "closure_Array" || has_feature ctx "closure_String" then spr ctx "from functools import partial as _hx_partial\n"; spr ctx "import sys\n"; diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml index db182a137c0..5b594b7b9e6 100644 --- a/src/generators/genswf.ml +++ b/src/generators/genswf.ml @@ -21,7 +21,7 @@ open As3hl open ExtString open Type open Error -open Common +open Gctx open Ast open Globals open NativeLibraries @@ -32,14 +32,35 @@ let tag ?(ext=false) d = { tdata = d; } -let convert_header com (w,h,fps,bg) = +let flash_version_tag = function + | 6. -> 6 + | 7. -> 7 + | 8. -> 8 + | 9. -> 9 + | 10. | 10.1 -> 10 + | 10.2 -> 11 + | 10.3 -> 12 + | 11. -> 13 + | 11.1 -> 14 + | 11.2 -> 15 + | 11.3 -> 16 + | 11.4 -> 17 + | 11.5 -> 18 + | 11.6 -> 19 + | 11.7 -> 20 + | 11.8 -> 21 + | 11.9 -> 22 + | v when v >= 12.0 && float_of_int (int_of_float v) = v -> int_of_float v + 11 + | v -> failwith ("Invalid SWF version " ^ string_of_float v) + +let convert_header com flash_version (w,h,fps,bg) = let high = (max w h) * 20 in let rec loop b = if 1 lsl b > high then b else loop (b + 1) in let bits = loop 0 in { - h_version = Common.flash_version_tag com.flash_version; + h_version = flash_version_tag flash_version; h_size = { rect_nbits = bits + 1; left = 0; @@ -49,11 +70,11 @@ let convert_header com (w,h,fps,bg) = }; h_frame_count = 1; h_fps = to_float16 (if fps > 127.0 then 127.0 else fps); - h_compressed = not (Common.defined com Define.NoSwfCompress); + h_compressed = not (Gctx.defined com Define.NoSwfCompress); } , bg -let default_header com = - convert_header com (400,300,30.,0xFFFFFF) +let default_header com flash_version = + convert_header com flash_version (400,300,30.,0xFFFFFF) type dependency_kind = | DKInherit @@ -223,7 +244,7 @@ let detect_format data p = abort "Unknown file format" p let build_swf9 com file swc = - let boot_name = if swc <> None || Common.defined com Define.HaxeBoot then "haxe" else "boot_" ^ (String.sub (Digest.to_hex (Digest.string (Filename.basename file))) 0 4) in + let boot_name = if swc <> None || Gctx.defined com Define.HaxeBoot then "haxe" else "boot_" ^ (String.sub (Digest.to_hex (Digest.string (Filename.basename file))) 0 4) in let code = Genswf9.generate com boot_name in let code = (match swc with | Some cat -> @@ -256,7 +277,7 @@ let build_swf9 com file swc = tag (TBinaryData (!cid,data)) :: acc ) com.resources [] in let load_file_data file p = - let file = try Common.find_file com file with Not_found -> file in + let file = try Gctx.find_file com file with Not_found -> file in if String.length file > 5 && String.sub file 0 5 = "data:" then String.sub file 5 (String.length file - 5) else @@ -435,12 +456,12 @@ let build_swf9 com file swc = let clips = [tag (TF9Classes (List.rev !classes))] in res @ bmp @ code @ clips -let merge com file priority (h1,tags1) (h2,tags2) = +let merge com flash_version file priority (h1,tags1) (h2,tags2) = (* prioritize header+bgcolor for first swf *) - let header = if priority then { h2 with h_version = max h2.h_version (Common.flash_version_tag com.flash_version) } else h1 in + let header = if priority then { h2 with h_version = max h2.h_version (flash_version_tag flash_version) } else h1 in let tags1 = if priority then List.filter (function { tdata = TSetBgColor _ } -> false | _ -> true) tags1 else tags1 in (* remove unused tags *) - let use_stage = priority && Common.defined com Define.FlashUseStage in + let use_stage = priority && Gctx.defined com Define.FlashUseStage in let classes = ref [] in let nframe = ref 0 in let tags2 = List.filter (fun t -> @@ -451,9 +472,9 @@ let merge com file priority (h1,tags1) (h2,tags2) = | TRemoveObject _ -> use_stage | TShowFrame -> incr nframe; use_stage | TFilesAttributes _ | TEnableDebugger2 _ | TScenes _ -> false - | TMetaData _ -> not (Common.defined com Define.SwfMetadata) + | TMetaData _ -> not (Gctx.defined com Define.SwfMetadata) | TSetBgColor _ -> priority - | TExport el when !nframe = 0 && com.flash_version >= 9. -> + | TExport el when !nframe = 0 && flash_version >= 9. -> let el = List.filter (fun e -> let path = parse_path e.exp_name in let b = List.exists (fun t -> t_path t = path) com.types in @@ -508,8 +529,8 @@ let merge com file priority (h1,tags1) (h2,tags2) = let tags = loop tags1 tags2 in header, tags -let generate swf_header com = - let swc = if Common.defined com Define.Swc then Some (ref "") else None in +let generate swf_header swf_libs flash_version com = + let swc = if Gctx.defined com Define.Swc then Some (ref "") else None in let file , codeclip = (try let f , c = ExtString.String.split com.file "@" in f, Some c with _ -> com.file , None) in (* list exports *) let exports = Hashtbl.create 0 in @@ -541,39 +562,39 @@ let generate swf_header com = ) el | _ -> () ) tags; - ) com.native_libs.swf_libs; + ) swf_libs; (* build haxe swf *) let tags = build_swf9 com file swc in - let header, bg = (match swf_header with None -> default_header com | Some h -> convert_header com h) in + let header, bg = (match swf_header with None -> default_header com flash_version | Some h -> convert_header com flash_version h) in let bg = tag (TSetBgColor { cr = bg lsr 16; cg = (bg lsr 8) land 0xFF; cb = bg land 0xFF }) in let scene = tag ~ext:true (TScenes ([(0,"Scene1")],[])) in let swf_debug_password = try - Digest.to_hex(Digest.string (Common.defined_value com Define.SwfDebugPassword)) + Digest.to_hex(Digest.string (Gctx.defined_value com Define.SwfDebugPassword)) with Not_found -> "" in - let debug = (if Common.defined com Define.Fdb then [tag (TEnableDebugger2 (0, swf_debug_password))] else []) in + let debug = (if Gctx.defined com Define.Fdb then [tag (TEnableDebugger2 (0, swf_debug_password))] else []) in let meta_data = try - let file = Common.defined_value com Define.SwfMetadata in - let file = try Common.find_file com file with Not_found -> file in + let file = Gctx.defined_value com Define.SwfMetadata in + let file = try Gctx.find_file com file with Not_found -> file in let data = try Std.input_file ~bin:true file with Sys_error _ -> failwith ("Metadata resource file not found : " ^ file) in [tag(TMetaData (data))] with Not_found -> [] in - let fattr = (if com.flash_version < 8. then [] else + let fattr = (if flash_version < 8. then [] else [tag (TFilesAttributes { - fa_network = Common.defined com Define.NetworkSandbox; + fa_network = Gctx.defined com Define.NetworkSandbox; fa_as3 = true; fa_metadata = meta_data <> []; - fa_gpu = com.flash_version > 9. && Common.defined com Define.SwfGpu; - fa_direct_blt = com.flash_version > 9. && Common.defined com Define.SwfDirectBlit; + fa_gpu = flash_version > 9. && Gctx.defined com Define.SwfGpu; + fa_direct_blt = flash_version > 9. && Gctx.defined com Define.SwfDirectBlit; })] ) in - let fattr = if Common.defined com Define.AdvancedTelemetry then fattr @ [tag (TUnknown (0x5D,"\x00\x00"))] else fattr in + let fattr = if Gctx.defined com Define.AdvancedTelemetry then fattr @ [tag (TUnknown (0x5D,"\x00\x00"))] else fattr in let swf_script_limits = try - let s = Common.defined_value com Define.SwfScriptTimeout in + let s = Gctx.defined_value com Define.SwfScriptTimeout in let i = try int_of_string s with _ -> abort "Argument to swf_script_timeout must be an integer" null_pos in [tag(TScriptLimits (256, if i < 0 then 0 else if i > 65535 then 65535 else i))] with Not_found -> @@ -583,12 +604,12 @@ let generate swf_header com = (* merge swf libraries *) let priority = ref (swf_header = None) in let swf = List.fold_left (fun swf swf_lib -> - let swf = merge com file !priority swf (SwfLoader.remove_classes toremove swf_lib#get_data swf_lib#list_modules) in + let swf = merge com flash_version file !priority swf (SwfLoader.remove_classes toremove swf_lib#get_data swf_lib#list_modules) in priority := false; swf - ) swf com.native_libs.swf_libs in + ) swf swf_libs in let swf = match swf with - | header,tags when Common.defined com Define.SwfPreloaderFrame -> + | header,tags when Gctx.defined com Define.SwfPreloaderFrame -> let rec loop l = match l with | ({tdata = TFilesAttributes _ | TUnknown (0x5D,"\x00\x00") | TMetaData _ | TSetBgColor _ | TEnableDebugger2 _ | TScriptLimits _} as t) :: l -> t :: loop l @@ -599,7 +620,7 @@ let generate swf_header com = | _ -> swf in (* write swf/swc *) let t = Timer.timer ["write";"swf"] in - let level = (try int_of_string (Common.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in + let level = (try int_of_string (Gctx.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in SwfParser.init Extc.input_zip (Extc.output_zip ~level); (match swc with | Some cat -> diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index 828a353b875..a414330b45b 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -19,11 +19,11 @@ open Extlib_leftovers open Globals open Ast +open Gctx open Type open Error open As3 open As3hl -open Common open FlashProps type read = Read @@ -81,7 +81,7 @@ type try_infos = { type context = { (* globals *) - com : Common.context; + com : Gctx.t; debugger : bool; swc : bool; boot : path; @@ -351,7 +351,7 @@ let property ctx fa t = | TInst ({ cl_path = [],"Array" },_) -> (match p with | "length" -> ident p, Some KInt, false (* UInt in the spec *) - | "map" | "filter" when Common.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true + | "map" | "filter" when Gctx.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true | "copy" | "insert" | "contains" | "remove" | "iterator" | "keyValueIterator" | "toString" | "map" | "filter" | "resize" -> ident p , None, true | _ -> as3 p, None, false); @@ -364,13 +364,13 @@ let property ctx fa t = | TInst ({ cl_path = [],"String" },_) -> (match p with | "length" (* Int in AS3/Haxe *) -> ident p, None, false - | "charCodeAt" when Common.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true + | "charCodeAt" when Gctx.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true | "charCodeAt" (* use Haxe version *) -> ident p, None, true | "cca" -> as3 "charCodeAt", None, false | _ -> as3 p, None, false); | TInst ({ cl_path = [],"Date" },_) -> (match p with - | "toString" when Common.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true + | "toString" when Gctx.defined ctx.com Define.NoFlashOverride -> ident (p ^ "HX"), None, true | _ -> ident p, None, false) | TAnon a -> (match !(a.a_status) with @@ -2833,7 +2833,7 @@ let generate_resource ctx name = let generate com boot_name = let ctx = { com = com; - need_ctor_skip = Common.has_feature com "Type.createEmptyInstance"; + need_ctor_skip = Gctx.has_feature com "Type.createEmptyInstance"; handle_spread_args = (fun basic args t_result args_to_expr -> match List.rev args with | { eexpr = TUnop (Spread,Prefix,rest) } :: args_rev -> @@ -2869,12 +2869,12 @@ let generate com boot_name = | _ -> None ); - debug = com.Common.debug; + debug = com.Gctx.debug; cur_class = null_class; boot = ([],boot_name); - debugger = Common.defined com Define.Fdb; - swc = Common.defined com Define.Swc; - swf_protected = Common.defined com Define.SwfProtected; + debugger = Gctx.defined com Define.Fdb; + swc = Gctx.defined com Define.Swc; + swf_protected = Gctx.defined com Define.SwfProtected; code = DynArray.create(); locals = PMap.empty; infos = default_infos(); diff --git a/src/generators/hl2c.ml b/src/generators/hl2c.ml index 645e2982a8d..ea3989ed4a7 100644 --- a/src/generators/hl2c.ml +++ b/src/generators/hl2c.ml @@ -78,7 +78,7 @@ type context = { mutable file_prefix : string; mutable fun_index : int; mutable type_module : (ttype, code_module) PMap.t; - gcon : Common.context; + gcon : Gctx.t; } let sprintf = Printf.sprintf @@ -345,7 +345,7 @@ let short_digest str = let open_file ctx file = if ctx.curfile <> "" then close_file ctx; if file <> "hlc.json" then - Codegen.map_source_header ctx.gcon (fun s -> define ctx (sprintf "// %s" s)); + Gctx.map_source_header ctx.gcon.defines (fun s -> define ctx (sprintf "// %s" s)); ctx.curfile <- file; ctx.fun_index <- 0; ctx.file_prefix <- (short_digest file) ^ "_" @@ -1461,7 +1461,7 @@ let write_c com file (code:code) gnames = let bnames = Array.map (fun b -> "bytes$" ^ short_digest (Digest.to_hex (Digest.bytes b))) code.bytes in let ctx = { - version = com.Common.version; + version = com.Gctx.version; out = Buffer.create 1024; tabs = ""; hlcode = code; @@ -1576,7 +1576,7 @@ let write_c com file (code:code) gnames = in Array.iteri (fun i str -> if String.length str >= string_data_limit then begin - let s = Common.utf8_to_utf16 str true in + let s = StringHelper.utf8_to_utf16 str true in sline "// %s..." (String.escaped (String.sub str 0 (string_data_limit-4))); output ctx (Printf.sprintf "vbyte string$%s[] = {" (short_digest str)); output_bytes (output ctx) s; diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index 4de99859b52..82cf2afd5cd 100644 --- a/src/generators/hlinterp.ml +++ b/src/generators/hlinterp.ml @@ -292,7 +292,7 @@ let fstr = function | FFun f -> "function@" ^ string_of_int f.findex | FNativeFun (s,_,_) -> "native[" ^ s ^ "]" -let caml_to_hl str = Common.utf8_to_utf16 str true +let caml_to_hl str = StringHelper.utf8_to_utf16 str true let hash ctx str = let h = hl_hash str in @@ -317,7 +317,7 @@ let utf16_iter f s = loop 0 let utf16_char buf c = - Common.utf16_add buf (int_of_char c) + StringHelper.utf16_add buf (int_of_char c) let hl_to_caml str = let utf16_eof s = @@ -1776,9 +1776,9 @@ let load_native ctx lib name t = if c >= int_of_char 'a' && c <= int_of_char 'z' then c + int_of_char 'A' - int_of_char 'a' else c in - Common.utf16_add buf c + StringHelper.utf16_add buf c ) (String.sub s (int pos) ((int len) lsl 1)); - Common.utf16_add buf 0; + StringHelper.utf16_add buf 0; VBytes (Buffer.contents buf) | _ -> Globals.die "" __LOC__) | "ucs2_lower" -> @@ -1790,9 +1790,9 @@ let load_native ctx lib name t = if c >= int_of_char 'A' && c <= int_of_char 'Z' then c + int_of_char 'a' - int_of_char 'A' else c in - Common.utf16_add buf c + StringHelper.utf16_add buf c ) (String.sub s (int pos) ((int len) lsl 1)); - Common.utf16_add buf 0; + StringHelper.utf16_add buf 0; VBytes (Buffer.contents buf) | _ -> Globals.die "" __LOC__) | "url_encode" -> @@ -1800,8 +1800,8 @@ let load_native ctx lib name t = | [VBytes s; VRef (r, HI32)] -> let s = hl_to_caml s in let buf = Buffer.create 0 in - Common.url_encode s (utf16_char buf); - Common.utf16_add buf 0; + StringHelper.url_encode s (utf16_char buf); + StringHelper.utf16_add buf 0; let str = Buffer.contents buf in set_ref r (to_int (String.length str lsr 1 - 1)); VBytes str diff --git a/src/generators/hlopt.ml b/src/generators/hlopt.ml index e79e7c7495a..45053f41574 100644 --- a/src/generators/hlopt.ml +++ b/src/generators/hlopt.ml @@ -578,7 +578,7 @@ let remap_fun ctx f dump get_str old_code = if p < 0 || (match op p with ONop _ -> false | _ -> true) then [(i,p)] else let reg, last_w = try Hashtbl.find ctx.r_reg_moved p with Not_found -> (-1,-1) in if reg < 0 then [] (* ? *) else - if reg < nargs then [(i,-reg-1)] else + if reg < nargs then [(i,-reg-2)] else let b = resolve_block p in if last_w >= b.bstart && last_w < b.bend && last_w < p then loop last_w else let wp = try PMap.find reg b.bwrite with Not_found -> -1 in diff --git a/src/generators/jsSourcemap.ml b/src/generators/jsSourcemap.ml index f44a2029162..01aad6ba3fd 100644 --- a/src/generators/jsSourcemap.ml +++ b/src/generators/jsSourcemap.ml @@ -19,7 +19,6 @@ open Extlib_leftovers open Globals open Type -open Common type sourcemap = { sources : (string) DynArray.t; @@ -131,7 +130,7 @@ let handle_newlines smap str = loop 0 ) smap -let write_mappings (com : Common.context) smap source_path_prefix = +let write_mappings (com : Gctx.t) smap source_path_prefix = let basefile = Filename.basename com.file in let channel = open_out_bin (com.file ^ ".map") in let sources = DynArray.to_list smap.sources in @@ -145,7 +144,7 @@ let write_mappings (com : Common.context) smap source_path_prefix = output_string channel ("\"sources\":[" ^ (String.concat "," (List.map (fun s -> "\"" ^ source_path_prefix ^ to_url s ^ "\"") sources)) ^ "],\n"); - if Common.defined com Define.SourceMapContent then begin + if Gctx.defined com Define.SourceMapContent then begin output_string channel ("\"sourcesContent\":[" ^ (String.concat "," (List.map (fun s -> try "\"" ^ StringHelper.s_escape (Std.input_file ~bin:true s) ^ "\"" with _ -> "null") sources)) ^ "],\n"); diff --git a/src/macro/eval/evalExceptions.ml b/src/macro/eval/evalExceptions.ml index dd245852998..3c8a80c3bf3 100644 --- a/src/macro/eval/evalExceptions.ml +++ b/src/macro/eval/evalExceptions.ml @@ -184,7 +184,14 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p = let stack = get_stack ctx in reset_ctx(); final(); - let p = if p' = null_pos then p else p' in + let p,stack = match stack with + | p :: pl when p' = null_pos -> + (* If the exception position is null_pos we're probably in a built-in function. Let's use the topmost stack + as error position. *) + p,pl + | _ -> + (if p' = null_pos then p else p'),stack + in Error.raise_error (Error.make_error ~sub:(List.map (fun p -> Error.make_error (Error.Custom "Called from here") p) (List.rev stack)) (Error.Custom ("Uncaught exception " ^ (value_string v))) diff --git a/src/macro/eval/evalLuv.ml b/src/macro/eval/evalLuv.ml index 12099b5f6b9..953594797ea 100644 --- a/src/macro/eval/evalLuv.ml +++ b/src/macro/eval/evalLuv.ml @@ -94,6 +94,8 @@ let encode_uv_error (e:Error.t) = | `EILSEQ -> 77 | `EOVERFLOW -> 78 | `ESOCKTNOSUPPORT -> 79 + | `ENODATA -> 80 + | `EUNATCH -> 81 ) let decode_uv_error v : Error.t = @@ -178,6 +180,8 @@ let decode_uv_error v : Error.t = | 77 -> `EILSEQ | 78 -> `EOVERFLOW | 79 -> `ESOCKTNOSUPPORT + | 80 -> `ENODATA + | 81 -> `EUNATCH | _ -> unexpected_value v "eval.luv.UVError" let luv_exception e = @@ -1942,7 +1946,7 @@ let fs_event_fields = [ ) events in encode_obj [ - key_file,vnative_string file; + key_file,encode_nullable vnative_string file; key_events,encode_array vevents; ] ) v4 @@ -2175,7 +2179,7 @@ let env_fields = [ let time_fields = [ "getTimeOfDay", vfun0 (fun() -> encode_result (fun (t:Time.t) -> - encode_obj [key_sec,VInt64 t.tv_sec; key_usec,vint32 t.tv_usec] + encode_obj [key_sec,VInt64 t.sec; key_usec,vint32 t.usec] ) (Time.gettimeofday()) ); "hrTime", vfun0 (fun() -> @@ -2292,10 +2296,10 @@ let resource_fields = [ encode_array_a [|vfloat m1; vfloat m5; vfloat m15|]; ); "freeMemory", vfun0 (fun() -> - VUInt64 (Resource.free_memory()) + encode_nullable (fun u -> VUInt64 u) (Resource.free_memory()) ); "totalMemory", vfun0 (fun() -> - VUInt64 (Resource.total_memory()) + encode_nullable (fun u -> VUInt64 u) (Resource.total_memory()) ); "constrainedMemory", vfun0 (fun() -> encode_nullable (fun u -> VUInt64 u) (Resource.constrained_memory()) diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index 70c56b5597a..8f7ad7c3d83 100644 --- a/src/macro/eval/evalStdLib.ml +++ b/src/macro/eval/evalStdLib.ml @@ -613,9 +613,12 @@ module StdContext = struct else raise (EvalDebugMisc.BreakHere) ) - let callMacroApi = vfun1 (fun f -> + let callMacroApi = vfun1 (fun f -> let f = decode_string f in - Hashtbl.find GlobalState.macro_lib f + try + Hashtbl.find GlobalState.macro_lib f + with Not_found -> + exc_string ("Could not find macro function \"" ^ f ^ "\"") ) let plugins = ref PMap.empty @@ -2441,7 +2444,7 @@ end module StdStringTools = struct let url_encode s = let b = Buffer.create 0 in - Common.url_encode s (Buffer.add_char b); + StringHelper.url_encode s (Buffer.add_char b); Buffer.contents b let fastCodeAt = StdString.charCodeAt diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index a9200e1f9c1..79adeacd7bb 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -2013,7 +2013,7 @@ let macro_api ccom get_api = "set_custom_js_generator", vfun1 (fun f -> let f = prepare_callback f 1 in (get_api()).set_js_generator (fun js_ctx -> - let com = ccom() in + let com = Common.to_gctx (ccom()) in Genjs.setup_kwds com; let api = encode_obj [ "outputFile", encode_string com.file; @@ -2028,10 +2028,10 @@ let macro_api ccom get_api = vbool (Hashtbl.mem Genjs.kwds (decode_string v)) ); "hasFeature", vfun1 (fun v -> - vbool (Common.has_feature com (decode_string v)) + vbool (Gctx.has_feature com (decode_string v)) ); "addFeature", vfun1 (fun v -> - Common.add_feature com (decode_string v); + Gctx.add_feature com (decode_string v); vnull ); "quoteString", vfun1 (fun v -> @@ -2266,8 +2266,10 @@ let macro_api ccom get_api = let t = decode_type (field v "t") in let default = None in (* we don't care here *) let c = match t with - | TInst(c,_) -> c - | _ -> die "" __LOC__ + | TInst(({cl_kind = KTypeParameter _} as c),_) -> + c + | _ -> + (get_api()).exc_string (Printf.sprintf "Unexpected type where type parameter was expected: %s" (s_type_kind t)) in mk_type_param c TPHType default None ) (decode_array tpl) in @@ -2281,7 +2283,18 @@ let macro_api ccom get_api = end | _ -> Type.map map t in - encode_type (apply_params tpl tl (map (decode_type t))) + let t = (map (decode_type t)) in + let t = try + apply_params tpl tl t + with ApplyParamsMismatch -> + let msg = Printf.sprintf "Could not apply type parameters to %s:\n\tparams: %s\n\ttypes: %s" + (s_type_kind t) + (String.concat ", " (List.map (s_type_param s_type_kind) tpl)) + (String.concat ", " (List.map s_type_kind tl)) + in + (get_api()).exc_string msg + in + encode_type t ); "include_file", vfun2 (fun file position -> let file = decode_string file in diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index 7da5e99d695..d1bb998a237 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -87,7 +87,7 @@ let overrides_extern_field cf c = loop c cf let is_std_file dce file = - List.exists (ExtString.String.starts_with file) dce.std_dirs + List.exists (fun dir -> ExtString.String.starts_with file dir) dce.std_dirs let keep_metas = [Meta.Keep;Meta.Expose] diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 282b28f7679..a293f296cf4 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -163,7 +163,7 @@ let api_inline ctx c field params p = Some (Texpr.Builder.fcall (eJsSyntax()) "instanceof" [o;t] tbool p) | (["haxe";"ds";"_Vector"],"Vector_Impl_"),("fromArrayCopy"),[{ eexpr = TArrayDecl args } as edecl] -> (try let platf = match ctx.com.platform with - | Jvm -> "java" + | Jvm -> "jvm" | _ -> raise Exit in let mpath = if field = "fromArrayCopy" then diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 7a4e275aec7..6647a9c8ab0 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -355,7 +355,7 @@ let call_to_string ctx ?(resume=false) e = mk (TIf (check_null, string_null, Some (gen_to_string e))) ctx.t.tstring e.epos end -let type_bind ctx (e : texpr) (args,ret) params p = +let type_bind ctx (e : texpr) (args,ret) params safe p = let vexpr v = mk (TLocal v) v.v_type p in let acount = ref 0 in let alloc_name n = @@ -409,10 +409,23 @@ let type_bind ctx (e : texpr) (args,ret) params p = let e_var = alloc_var VGenerated gen_local_prefix e.etype e.epos in (mk (TLocal e_var) e.etype e.epos), (mk (TVar(e_var,Some e)) ctx.t.tvoid e.epos) :: var_decls in - let call = make_call ctx e ordered_args ret p in + let e_body = if safe then begin + let eobj, tempvar = get_safe_nav_base ctx e in + let sn = { + sn_pos = p; + sn_base = eobj; + sn_temp_var = tempvar; + sn_access = AKExpr e; (* This is weird, but it's not used by safe_nav_branch. *) + } in + safe_nav_branch ctx sn (fun () -> + make_call ctx eobj ordered_args ret p + ) + end else + make_call ctx e ordered_args ret p + in let body = - if ExtType.is_void (follow ret) then call - else mk (TReturn(Some call)) ret p + if ExtType.is_void (follow ret) then e_body + else mk (TReturn(Some e_body)) ret p in let arg_default optional t = if optional then Some (Texpr.Builder.make_null t null_pos) diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 94bc5dbdc70..387fd8fd4a3 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -310,6 +310,9 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = acc ) c.cl_implements in + let no_no_lookup cf = + if has_class_field_flag cf CfNoLookup then display_error ctx.com "This field cannot be accessed explicitly" pfield + in let rec type_field_by_type e t = let field_access = field_access e in match t with @@ -334,6 +337,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = begin try let cf = PMap.find i c.cl_statics in if has_class_field_flag cf CfImpl && not (has_class_field_flag cf CfEnum) then display_error ctx.com "Cannot access non-static abstract field statically" pfield; + no_no_lookup cf; field_access cf (FHStatic c) with Not_found -> begin match c.cl_kind with @@ -401,6 +405,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = let c = find_some a.a_impl in let f = PMap.find i c.cl_statics in if not (has_class_field_flag f CfImpl) then raise Not_found; + no_no_lookup f; field_access f (FHAbstract (a,tl,c)) with Not_found -> type_field_by_forward_member type_field_by_type e a tl diff --git a/src/typing/forLoop.ml b/src/typing/forLoop.ml index 6bb73631c7a..43fb3db5101 100644 --- a/src/typing/forLoop.ml +++ b/src/typing/forLoop.ml @@ -55,10 +55,14 @@ let optimize_for_loop_iterator ctx v e1 e2 p = mk (TWhile (ehasnext,eblock,NormalWhile)) ctx.t.tvoid p ]) ctx.t.tvoid p +type unroll_parameters = { + expression_weight : int; +} + module IterationKind = struct type t_kind = | IteratorIntConst of texpr * texpr * bool (* ascending? *) - | IteratorIntUnroll of int * int * bool + | IteratorIntUnroll of int * int * bool * unroll_parameters | IteratorInt of texpr * texpr | IteratorArrayDecl of texpr list | IteratorArray @@ -169,7 +173,22 @@ module IterationKind = struct ) | _ -> raise Not_found - let of_texpr ?(resume=false) ctx e unroll p = + let map_unroll_params ctx unroll_params i = match unroll_params with + | None -> + None + | Some unroll_params -> + let cost = i * unroll_params.expression_weight in + let max_cost = try + int_of_string (Common.defined_value ctx.com Define.LoopUnrollMaxCost) + with Not_found -> + 250 + in + if cost <= max_cost then + Some unroll_params + else + None + + let of_texpr ?(resume=false) ctx e unroll_params p = let dynamic_iterator e = display_error ctx.com "You can't iterate on a Dynamic value, please specify Iterator or Iterable" e.epos; IteratorDynamic,e,t_dynamic @@ -210,9 +229,12 @@ module IterationKind = struct let it = match efrom.eexpr,eto.eexpr with | TConst (TInt a),TConst (TInt b) -> let diff = Int32.to_int (Int32.sub a b) in - let unroll = unroll (abs diff) in - if unroll then IteratorIntUnroll(Int32.to_int a,abs(diff),diff <= 0) - else IteratorIntConst(efrom,eto,diff <= 0) + begin match map_unroll_params ctx unroll_params (abs diff) with + | Some unroll_params -> + IteratorIntUnroll(Int32.to_int a,abs(diff),diff <= 0,unroll_params) + | None -> + IteratorIntConst(efrom,eto,diff <= 0) + end | _ -> let eto = match follow eto.etype with | TAbstract ({ a_path = ([],"Int") }, []) -> eto @@ -222,8 +244,10 @@ module IterationKind = struct in it,e,ctx.t.tint | TArrayDecl el,TInst({ cl_path = [],"Array" },[pt]) -> - let it = if unroll (List.length el) then IteratorArrayDecl el - else IteratorArray in + let it = match map_unroll_params ctx unroll_params (List.length el) with + | Some _ -> IteratorArrayDecl el + | None -> IteratorArray + in (it,e,pt) | _,TInst({ cl_path = [],"Array" },[pt]) | _,TInst({ cl_path = ["flash"],"Vector" },[pt]) -> @@ -316,18 +340,31 @@ module IterationKind = struct match iterator.it_kind with | _ when not ctx.allow_transform -> mk (TFor(v,e1,e2)) t_void p - | IteratorIntUnroll(offset,length,ascending) -> + | IteratorIntUnroll(offset,length,ascending,unroll_params) -> check_loop_var_modification [v] e2; if not ascending then raise_typing_error "Cannot iterate backwards" p; - let el = ExtList.List.init length (fun i -> - let ei = make_int ctx.t (if ascending then i + offset else offset - i) p in - let rec loop e = match e.eexpr with - | TLocal v' when v == v' -> {ei with epos = e.epos} - | _ -> map_expr loop e + let rec unroll acc i = + if i = length then + List.rev acc + else begin + let ei = make_int ctx.t (if ascending then i + offset else offset - i) p in + let local_vars = ref [] in + let rec loop e = match e.eexpr with + | TLocal v' when v == v' -> + {ei with epos = e.epos} + | TVar(v,eo) when has_var_flag v VStatic -> + if acc = [] then + local_vars := {e with eexpr = TVar(v,eo)} :: !local_vars; + mk (TConst TNull) t_dynamic null_pos + | _ -> + map_expr loop e in let e2 = loop e2 in - Texpr.duplicate_tvars e_identity e2 - ) in + let acc = acc @ !local_vars in + let e2 = Texpr.duplicate_tvars e_identity e2 in + unroll (e2 :: acc) (i + 1) + end in + let el = unroll [] 0 in mk (TBlock el) t_void p | IteratorIntConst(a,b,ascending) -> check_loop_var_modification [v] e2; @@ -407,7 +444,7 @@ module IterationKind = struct mk (TFor(v,e1,e2)) t_void p end -let is_cheap_enough ctx e2 i = +let get_unroll_params ctx e2 = let num_expr = ref 0 in let rec loop e = match fst e with | EContinue | EBreak -> @@ -419,17 +456,13 @@ let is_cheap_enough ctx e2 i = try if ctx.com.display.dms_kind <> DMNone then raise Exit; ignore(loop e2); - let cost = i * !num_expr in - let max_cost = try - int_of_string (Common.defined_value ctx.com Define.LoopUnrollMaxCost) - with Not_found -> - 250 - in - cost <= max_cost + Some { + expression_weight = !num_expr; + } with Exit -> - false + None -let is_cheap_enough_t ctx e2 i = +let get_unroll_params_t ctx e2 = let num_expr = ref 0 in let rec loop e = match e.eexpr with | TContinue | TBreak -> @@ -441,15 +474,11 @@ let is_cheap_enough_t ctx e2 i = try if ctx.com.display.dms_kind <> DMNone then raise Exit; ignore(loop e2); - let cost = i * !num_expr in - let max_cost = try - int_of_string (Common.defined_value ctx.com Define.LoopUnrollMaxCost) - with Not_found -> - 250 - in - cost <= max_cost + Some { + expression_weight = !num_expr; + } with Exit -> - false + None type iteration_ident = string * pos * display_kind option @@ -468,7 +497,7 @@ let type_for_loop ctx handle_display ik e1 e2 p = in match ik with | IKNormal(i,pi,dko) -> - let iterator = IterationKind.of_texpr ctx e1 (is_cheap_enough ctx e2) p in + let iterator = IterationKind.of_texpr ctx e1 (get_unroll_params ctx e2) p in let i = add_local_with_origin ctx TVOForVariable i iterator.it_type pi in let e2 = type_expr ctx e2 NoValue in check_display (i,pi,dko); diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 26b7087d6b9..e0e747da82e 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -9,7 +9,7 @@ open FieldCallCandidate type generic_context = { ctx : typer; - subst : (t * (t * texpr option)) list; + subst : (tclass * (t * texpr option)) list; name : string; p : pos; mutable mg : module_def option; @@ -64,7 +64,7 @@ let make_generic ctx ps pt debug p = let rec loop acc_name acc_subst ttpl tl = match ttpl,tl with | ttp :: ttpl,t :: tl -> let name,t = try process t with Exit -> raise_typing_error ("Could not determine type for parameter " ^ ttp.ttp_name) p in - loop (name :: acc_name) ((ttp.ttp_type,t) :: acc_subst) ttpl tl + loop (name :: acc_name) ((ttp.ttp_class,t) :: acc_subst) ttpl tl | [],[] -> let name = String.concat "_" (List.rev acc_name) in name,acc_subst @@ -89,9 +89,9 @@ let rec generic_substitute_type' gctx allow_expr t = let t = info.build_apply (List.map (generic_substitute_type' gctx true) tl2) in (match follow t,gctx.mg with TInst(c,_), Some m -> add_dependency m c.cl_module MDepFromTyping | _ -> ()); t - | _ -> - try - let t,eo = List.assq t gctx.subst in + | TInst ({ cl_kind = KTypeParameter _ } as c, tl2) -> + (try + let t,eo = List.assq c gctx.subst in (* Somewhat awkward: If we allow expression types, use the original KExpr one. This is so recursing into further KGeneric expands correctly. *) begin match eo with @@ -101,7 +101,9 @@ let rec generic_substitute_type' gctx allow_expr t = generic_substitute_type' gctx false t end with Not_found -> - Type.map (generic_substitute_type' gctx allow_expr) t + Type.map (generic_substitute_type' gctx allow_expr) t) + | _ -> + Type.map (generic_substitute_type' gctx allow_expr) t let generic_substitute_type gctx t = generic_substitute_type' gctx false t @@ -136,11 +138,8 @@ let generic_substitute_expr gctx e = end; | TTypeExpr (TClassDecl ({cl_kind = KTypeParameter _;} as c)) when Meta.has Meta.Const c.cl_meta -> let rec loop subst = match subst with - | (t1,(_,eo)) :: subst -> - begin match follow t1 with - | TInst(c2,_) when c == c2 -> eo - | _ -> loop subst - end + | (c2,(_,eo)) :: subst -> + if c == c2 then eo else loop subst | [] -> raise Not_found in begin try @@ -279,11 +278,8 @@ let build_generic_class ctx c p tl = let m = c.cl_module in if gctx.generic_debug then begin print_endline (Printf.sprintf "[GENERIC] Building @:generic class %s as %s with:" (s_type_path c.cl_path) name); - List.iter (fun (t1,(t2,eo)) -> - let name = match follow t1 with - | TInst(c,_) -> snd c.cl_path - | _ -> die "" __LOC__ - in + List.iter (fun (c,(t2,eo)) -> + let name = snd c.cl_path in let expr = match eo with | None -> "" | Some e -> Printf.sprintf " (expr: %s)" (s_expr_debug e) @@ -326,7 +322,7 @@ let build_generic_class ctx c p tl = let build_field cf_old = let params = List.map (fun ttp -> let ttp' = clone_type_parameter gctx mg ([cf_old.cf_name],ttp.ttp_name) ttp in - (ttp.ttp_type,ttp') + (ttp.ttp_class,ttp') ) cf_old.cf_params in let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in let gctx = {gctx with subst = param_subst @ gctx.subst} in diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index f83d5fe8921..7b5c23f3e6e 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -211,7 +211,7 @@ let make_macro_com_api com mcom p = set_js_generator = (fun gen -> com.js_gen <- Some (fun() -> Path.mkdir_from_path com.file; - let js_ctx = Genjs.alloc_ctx com (get_es_version com) in + let js_ctx = Genjs.alloc_ctx (Common.to_gctx com) (Gctx.get_es_version com.defines) in let t = macro_timer com ["jsGenerator"] in gen js_ctx; t() diff --git a/src/typing/matcher/texprConverter.ml b/src/typing/matcher/texprConverter.ml index 9536c006ffe..998b642a4da 100644 --- a/src/typing/matcher/texprConverter.ml +++ b/src/typing/matcher/texprConverter.ml @@ -349,9 +349,15 @@ let to_texpr ctx t_switch with_type dt = let e_then = loop dt_rec params dt1 in begin match e_then with | None -> - if toplevel then - loop dt_rec params dt2 - else if ignore_error ctx.com then + if toplevel then begin match loop dt_rec params dt2 with + | None -> + None + | Some e_else -> + (* In some cases like extractors, the original e expression might be significant for the + output, so let's make sure it appears there (issue #11738). *) + let e = mk (TBlock [e;e_else]) e_else.etype e_else.epos in + Some e + end else if ignore_error ctx.com then Some (mk (TConst TNull) (mk_mono()) dt2.dt_pos) else report_not_exhaustive !v_lookup e [(ConConst TNull,dt.dt_pos),dt.dt_pos] diff --git a/src/typing/operators.ml b/src/typing/operators.ml index 13751dc78db..07a4f477d08 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -333,12 +333,17 @@ let make_binop ctx op e1 e2 is_assign_op p = with Error { err_message = Unify _ } -> e1,AbstractCast.cast_or_unify ctx e1.etype e2 p in - if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with + begin match e1.eexpr, e2.eexpr with | TConst TNull , _ | _ , TConst TNull -> () | _ -> match follow e1.etype, follow e2.etype with - | TFun _ , _ | _, TFun _ -> warning ctx WClosureCompare "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p - | _ -> () + | TFun _ , _ | _, TFun _ when not ctx.com.config.pf_supports_function_equality -> + warning ctx WClosureCompare "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p + | TEnum(en,_), _ | _, TEnum(en,_) -> + if not (Meta.has Meta.FlatEnum en.e_meta) then + warning ctx WUnsafeEnumEquality "Equality operations on this enum might lead to unexpected results because some constructors have arguments" p + | _ -> + () end; mk_op e1 e2 ctx.t.tbool | OpGt diff --git a/src/typing/strictMeta.ml b/src/typing/strictMeta.ml index a06b6bcafde..71a0ef20423 100644 --- a/src/typing/strictMeta.ml +++ b/src/typing/strictMeta.ml @@ -79,7 +79,7 @@ let rec kind_of_type_against ctx t_want e_have = unify ctx e.etype t_want e.epos end; e - | TInst({cl_path = (["java"],"NativeArray")},[t1]) -> + | TInst({cl_path = (["jvm"],"NativeArray")},[t1]) -> begin match fst e_have with | EArrayDecl el -> let el = List.map (kind_of_type_against ctx t1) el in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 1d1f3bc8da6..b2fb546a2ba 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -137,7 +137,7 @@ let find_in_wildcard_imports ctx mname p f = with Error { err_message = Module_not_found mpath } when mpath = path -> raise Not_found in - let r = f m ~resume:true in + let r = f m in ImportHandling.mark_import_position ctx ppack; r with Not_found -> @@ -146,48 +146,36 @@ let find_in_wildcard_imports ctx mname p f = in loop (ctx.m.import_resolution#extract_wildcard_packages) -(* TODO: move these generic find functions into a separate module *) -let find_in_modules_starting_from_current_package ~resume ctx mname p f = +let find_in_modules_starting_from_current_package ctx mname p f = let rec loop l = let path = (List.rev l,mname) in + try + ctx.g.do_load_module ctx path p + with Error { err_message = Module_not_found mpath } when mpath = path -> match l with - | [] -> - let m = - try - ctx.g.do_load_module ctx path p - with Error { err_message = Module_not_found mpath } when resume && mpath = path -> - raise Not_found - in - f m ~resume:resume - | _ :: sl -> - try - let m = - try - ctx.g.do_load_module ctx path p - with Error { err_message = Module_not_found mpath } when mpath = path -> - raise Not_found - in - f m ~resume:true; - with Not_found -> + | [] -> + raise Not_found + | _ :: sl -> loop sl in let pack = fst ctx.m.curmod.m_path in - loop (List.rev pack) + let m = loop (List.rev pack) in + f m -let find_in_unqualified_modules ctx name p f ~resume = +let find_in_unqualified_modules ctx name p f = try find_in_wildcard_imports ctx name p f with Not_found -> - find_in_modules_starting_from_current_package ctx name p f ~resume:resume + find_in_modules_starting_from_current_package ctx name p f let load_unqualified_type_def ctx mname tname p = - let find_type m ~resume = - if resume then - find_type_in_module m tname - else - find_type_in_module_raise ctx m tname p + let find_type m = + find_type_in_module_raise ctx m tname p in - find_in_unqualified_modules ctx mname p find_type ~resume:false + try + find_in_unqualified_modules ctx mname p find_type + with Not_found -> + raise_error_msg (Module_not_found ([],mname)) p let load_module ctx path p = try @@ -644,9 +632,7 @@ and load_complex_type ctx allow_display mode (t,pn) = if Diagnostics.error_in_diagnostics_run ctx.com err.err_pos then begin delay ctx.g PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true); t_dynamic - end else if ignore_error ctx.com && not (DisplayPosition.display_position#enclosed_in pn) then - t_dynamic - else + end else raise (Error err) and init_meta_overloads ctx co cf = diff --git a/src/typing/typer.ml b/src/typing/typer.ml index a2b74023129..a07ad593245 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -605,15 +605,7 @@ and handle_efield ctx e p0 mode with_type = create safe navigation chain from the object expression *) let acc_obj = type_access ctx eobj pobj MGet WithType.value in let eobj = acc_get ctx acc_obj in - let eobj, tempvar = match (Texpr.skip eobj).eexpr with - | TLocal _ | TTypeExpr _ | TConst _ -> - eobj, None - | _ -> - let v = alloc_var VGenerated "tmp" eobj.etype eobj.epos in - let temp_var = mk (TVar(v, Some eobj)) ctx.t.tvoid v.v_pos in - let eobj = mk (TLocal v) v.v_type v.v_pos in - eobj, Some temp_var - in + let eobj, tempvar = get_safe_nav_base ctx eobj in let access = field_chain ctx ((mk_dot_path_part s p) :: dot_path_acc) (AKExpr eobj) mode with_type in AKSafeNav { sn_pos = p; @@ -637,7 +629,8 @@ and type_access ctx e p mode with_type = match e with | EConst (Ident s) -> type_ident ctx s p mode with_type - | EField (e1,"new",efk_todo) -> + | EField (e1,"new",efk) -> + if efk = EFSafe then raise_typing_error "?.new is not supported" p; let e1 = type_expr ctx e1 WithType.value in begin match e1.eexpr with | TTypeExpr (TClassDecl c) -> @@ -710,7 +703,7 @@ and type_vars ctx vl p = | Some e -> let old_in_loop = ctx.e.in_loop in if ev.ev_static then ctx.e.in_loop <- false; - let e = Std.finally (fun () -> ctx.e.in_loop <- old_in_loop) (type_expr ctx e) (WithType.with_type t) in + let e = Std.finally (fun () -> ctx.e.in_loop <- old_in_loop) (type_expr ctx e) (WithType.with_local_variable t n) in let e = AbstractCast.cast_or_unify ctx t e p in Some e ) in @@ -1738,10 +1731,10 @@ and type_call_builtin ctx e el mode with_type p = | (EField ((EConst (Ident "super"),_),_,_),_), _ -> (* no builtins can be applied to super as it can't be a value *) raise Exit - | (EField (e,"bind",efk_todo),p), args -> + | (EField (e,"bind",efk),p), args -> let e = type_expr ctx e WithType.value in (match follow e.etype with - | TFun signature -> type_bind ctx e signature args p + | TFun signature -> type_bind ctx e signature args (efk = EFSafe) p | _ -> raise Exit) | (EConst (Ident "$type"),_) , e1 :: el -> let expected = match el with @@ -1760,7 +1753,8 @@ and type_call_builtin ctx e el mode with_type p = in warning ctx WInfo s e1.epos; e1 - | (EField(e,"match",efk_todo),p), [epat] -> + | (EField(e,"match",efk),p), [epat] -> + if efk = EFSafe then raise_typing_error "?.match is not supported" p; let et = type_expr ctx e WithType.value in let rec has_enum_match t = match follow t with | TEnum _ -> true @@ -1872,7 +1866,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = | _ -> follow_null tmin in let e1_null_t = if is_nullable e1.etype then e1.etype else ctx.t.tnull e1.etype in - let e1 = vr#as_var "tmp" {e1 with etype = e1_null_t} in + let e1 = vr#as_var (Option.default "tmp" (WithType.get_expected_name with_type)) {e1 with etype = e1_null_t} in let e_null = Builder.make_null e1_null_t e1.epos in let e_cond = mk (TBinop(OpNotEq,e1,e_null)) ctx.t.tbool e1.epos in let e_if = mk (TIf(e_cond,cast e1,Some e2)) iftype p in diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index fa7bdefb8e2..1bdb1aa33b8 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -369,4 +369,14 @@ let safe_nav_branch ctx sn f_then = let eif = mk (TIf(eneq,ethen,Some eelse)) tnull sn.sn_pos in (match sn.sn_temp_var with | None -> eif - | Some evar -> { eif with eexpr = TBlock [evar; eif] }) \ No newline at end of file + | Some evar -> { eif with eexpr = TBlock [evar; eif] }) + +let get_safe_nav_base ctx eobj = + match (Texpr.skip eobj).eexpr with + | TLocal _ | TTypeExpr _ | TConst _ -> + eobj, None + | _ -> + let v = alloc_var VGenerated "tmp" eobj.etype eobj.epos in + let temp_var = mk (TVar(v, Some eobj)) ctx.t.tvoid v.v_pos in + let eobj = mk (TLocal v) v.v_type v.v_pos in + eobj, Some temp_var \ No newline at end of file diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index 1c38d20f87f..1a6e57e04ab 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -518,7 +518,7 @@ and display_expr ctx e_ast e dk mode with_type p = let fields = DisplayFields.collect ctx e_ast e dk with_type p in let item = completion_item_of_expr ctx e in let iterator = try - let it = (ForLoop.IterationKind.of_texpr ~resume:true ctx e (fun _ -> false) e.epos) in + let it = (ForLoop.IterationKind.of_texpr ~resume:true ctx e None e.epos) in match follow it.it_type with | TDynamic _ -> None | t -> Some t diff --git a/std/Std.hx b/std/Std.hx index dd826e61b82..b474a517ce3 100644 --- a/std/Std.hx +++ b/std/Std.hx @@ -97,7 +97,7 @@ extern class Std { Leading whitespaces are ignored. - `x` may optionally start with a + or - to denote a postive or negative value respectively. + `x` may optionally start with a + or - to denote a positive or negative value respectively. If the optional sign is followed 0x or 0X, hexadecimal notation is recognized where the following digits may contain 0-9 and A-F. Both the prefix and digits are case insensitive. diff --git a/std/String.hx b/std/String.hx index b4a28992bcb..c864a4d31a9 100644 --- a/std/String.hx +++ b/std/String.hx @@ -102,7 +102,7 @@ extern class String { is performed within `this` String. In either case, the returned position is relative to the beginning of `this` String. - If `startIndex` is negative, the result is unspecifed. + If `startIndex` is negative, the result is unspecified. If `str` cannot be found, -1 is returned. **/ diff --git a/std/StringTools.hx b/std/StringTools.hx index 208b2804d6b..d8efdd8b653 100644 --- a/std/StringTools.hx +++ b/std/StringTools.hx @@ -594,7 +594,7 @@ class StringTools { } #if java - private static inline function _charAt(str:String, idx:Int):java.StdTypes.Char16 + private static inline function _charAt(str:String, idx:Int):jvm.Char16 return (cast str : java.NativeString).charAt(idx); #end diff --git a/std/Sys.hx b/std/Sys.hx index def62d6bf32..d18aa6dd97b 100644 --- a/std/Sys.hx +++ b/std/Sys.hx @@ -82,7 +82,7 @@ extern class Sys { static function sleep(seconds:Float):Void; /** - Changes the current time locale, which will affect `DateTools.format` date formating. + Changes the current time locale, which will affect `DateTools.format` date formatting. Returns `true` if the locale was successfully changed. **/ static function setTimeLocale(loc:String):Bool; @@ -139,8 +139,10 @@ extern class Sys { static function time():Float; /** - Gives the most precise timestamp value available (in seconds), - but only accounts for the actual time spent running on the CPU for the current thread/process. + Returns CPU time consumed by the current process or thread, measured in seconds. + This value only includes the actual time the CPU has actively spent executing + instructions for the process/thread and excludes idle or sleep time. The precision + and behavior may vary depending on the platform and underlying implementation. **/ static function cpuTime():Float; diff --git a/std/Xml.hx b/std/Xml.hx index e9ac618f5fd..5602c593f7b 100644 --- a/std/Xml.hx +++ b/std/Xml.hx @@ -361,7 +361,7 @@ class Xml { /** Removes a child from the Document or Element. - Returns true if the child was successfuly removed. + Returns true if the child was successfully removed. **/ public function removeChild(x:Xml):Bool { ensureElementType(); diff --git a/std/cpp/cppia/HostClasses.hx b/std/cpp/cppia/HostClasses.hx index 8f40fa34d66..f7b8aff67f8 100644 --- a/std/cpp/cppia/HostClasses.hx +++ b/std/cpp/cppia/HostClasses.hx @@ -176,7 +176,7 @@ class HostClasses { externs.set("haxe._Int64.___Int64", true); externs.set("haxe._Int32.Int32_Impl_", true); externs.set("haxe._Int32.___Int32", true); - // Hidded in implementation classes + // Hidden in implementation classes // externs.set("sys.db.RecordType",true); externs.set("sys.net._Socket.SocketInput", true); externs.set("sys.net._Socket.SocketOutput", true); diff --git a/std/cpp/net/ThreadServer.hx b/std/cpp/net/ThreadServer.hx index a3f7a7455bc..30b9ac49a0f 100644 --- a/std/cpp/net/ThreadServer.hx +++ b/std/cpp/net/ThreadServer.hx @@ -347,7 +347,7 @@ class ThreadServer { } /** - Called when a message has been recieved. Message handling code should go here. + Called when a message has been received. Message handling code should go here. **/ public dynamic function clientMessage(c:Client, msg:Message) {} diff --git a/std/cpp/vm/Debugger.hx b/std/cpp/vm/Debugger.hx index 8f5f86d2bd4..f5afb3f80de 100644 --- a/std/cpp/vm/Debugger.hx +++ b/std/cpp/vm/Debugger.hx @@ -121,7 +121,7 @@ class Debugger { Sets the handler callback to be made when asynchronous events occur, specifically, when threads are created, terminated, started, or stopped. The calling thread becomes the "debugger" thread, which means - that it will be discluded from any breakpoints and will not be reported + that it will be excluded from any breakpoints and will not be reported on by any thread reporting requests. Be aware that this callback is made asynchronously and possibly by diff --git a/std/cpp/vm/tracy/TracyProfiler.hx b/std/cpp/vm/tracy/TracyProfiler.hx new file mode 100644 index 00000000000..f69f2e23861 --- /dev/null +++ b/std/cpp/vm/tracy/TracyProfiler.hx @@ -0,0 +1,119 @@ +/* + * Copyright (C)2005-2019 Haxe Foundation + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + */ + +package cpp.vm.tracy; + +// Disable this guard for now. +// #if (!HXCPP_TRACY) +// #error "This class cannot be used without -D HXCPP_TRACY" +// #end + + +enum abstract PlotFormatType(cpp.UInt8) from cpp.UInt8 to cpp.UInt8 { + var Number = 0; + var Memory = 1; + var Percentage = 2; +} + +@:include('hx/TelemetryTracy.h') +extern class Native_TracyProfiler { + /** + Mark a frame. Call this at the end of each frame loop. + **/ + @:native('::__hxcpp_tracy_framemark') + public static function frameMark():Void; + + /** + Print a message into Tracy's log. + **/ + @:native('::__hxcpp_tracy_message') + public static function message(_msg:String, ?_color:Int = 0x000000):Void; + + /** + Tracy can collect additional information about the profiled application, + which will be available in the trace description. + This can include data such as the source repository revision, + the application’s environment (dev/prod), etc. + **/ + @:native('::__hxcpp_tracy_message_app_info') + public static function messageAppInfo(_info:String):Void; + + /** + Plot a named value to tracy. This will generate a graph in the profiler for you. + **/ + @:native('::__hxcpp_tracy_plot') + public static function plot(_name:String, _val:cpp.Float32):Void; + + /** + Configure how values are plotted and displayed. + **/ + @:native('::__hxcpp_tracy_plot_config') + public static function plotConfig(_name:String, _format:PlotFormatType, ?_step:Bool=false, ?_fill:Bool=false, ?_color:Int=0x000000):Void; + + /** + Set a name for the current thread this function is called in. Supply an optional groupHint so threads become grouped in Tracy's UI. + **/ + @:native('::__hxcpp_tracy_set_thread_name_and_group') + public static function setThreadName(_name:String, ?_groupHint:Int=1):Void; + + /** + Create a custom named scoped zone in your code. + **/ + @:native('HXCPP_TRACY_ZONE') + public static function zoneScoped(_name:String):Void; +} + +#if (scriptable || cppia) + class Cppia_TracyProfiler { + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.frameMark) + public static function frameMark() + Native_TracyProfiler.frameMark(); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.message) + public static function message(_msg:String, ?_color:Int = 0x000000) + Native_TracyProfiler.message(_msg, _color); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.messageAppInfo) + public static function messageAppInfo(_info:String) + Native_TracyProfiler.messageAppInfo(_info); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.plot) + public static function plot(_name:String, _val:Float) + Native_TracyProfiler.plot(_name, _val); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.plotConfig) + public static function plotConfig(_name:String, _format:PlotFormatType, ?_step:Bool=false, ?_fill:Bool=false, ?_color:Int=0x000000) + Native_TracyProfiler.plotConfig(_name, _format, _step, _fill, _color); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.setThreadName) + public static function setThreadName(_name:String, ?_groupHint:Int=1) + Native_TracyProfiler.setThreadName(_name, _groupHint); + + @:inheritDoc(cpp.vm.tracy.Native_TracyProfiler.zoneScoped) + public static function zoneScoped(_name:String) + Native_TracyProfiler.zoneScoped(_name); + } + + typedef TracyProfiler = Cppia_TracyProfiler; +#else + typedef TracyProfiler = Native_TracyProfiler; +#end diff --git a/std/eval/luv/File.hx b/std/eval/luv/File.hx index d6233432050..4ba4c4356d1 100644 --- a/std/eval/luv/File.hx +++ b/std/eval/luv/File.hx @@ -296,17 +296,17 @@ enum abstract FileSymlinkFlag(Int) { static public function realPath(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; /** - Changes owneship of the file at the given path. + Changes ownership of the file at the given path. **/ static public function chown(loop:Loop, path:NativeString, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; /** - Changes owneship of the file at the given path. without dereferencing symlinks. + Changes ownership of the file at the given path. without dereferencing symlinks. **/ static public function lchown(loop:Loop, path:NativeString, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; /** - Changes owneship of the file. + Changes ownership of the file. **/ public function fchown(loop:Loop, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; diff --git a/std/eval/luv/FsEvent.hx b/std/eval/luv/FsEvent.hx index 5571138197f..5df6c3bf151 100644 --- a/std/eval/luv/FsEvent.hx +++ b/std/eval/luv/FsEvent.hx @@ -26,7 +26,7 @@ enum abstract FsEventFlag(Int) { /** Starts the handle and watches the given path for changes. **/ - public function start(path:NativeString, ?flags:Array, callback:(result:Result<{file:NativeString,events:Array}>)->Void):Void; + public function start(path:NativeString, ?flags:Array, callback:(result:Result<{file:Null,events:Array}>)->Void):Void; /** Stops the handle. diff --git a/std/eval/luv/Pipe.hx b/std/eval/luv/Pipe.hx index bc04e936f54..6cd266b3f6f 100644 --- a/std/eval/luv/Pipe.hx +++ b/std/eval/luv/Pipe.hx @@ -63,7 +63,7 @@ enum ReceiveHandle { calls its callback, there may be file descriptors in the pipe, in addition to the ordinary data provided to the callback. - To check, call this function `eval.luv.Pipe.recieveHandle` in a loop until + To check, call this function `eval.luv.Pipe.receiveHandle` in a loop until it returns `NONE`. Each time it returns `TCP(associate)` or `PIPE(associate)`, create an appropriate handle using either `eval.luv.TCP.init` or `eval.uv.Pipe.init`, and call `associate` to receive the file descriptor and associate it with handle. diff --git a/std/eval/luv/Resource.hx b/std/eval/luv/Resource.hx index 5457e74f6ea..de70d5d1b78 100644 --- a/std/eval/luv/Resource.hx +++ b/std/eval/luv/Resource.hx @@ -40,13 +40,15 @@ extern class Resource { /** Evaluates to the amount of free memory, in bytes. + Returns `null` when unknown. **/ - static function freeMemory():UInt64; + static function freeMemory():Null; /** Evaluates to the total amount of memory, in bytes. + Returns `null` when unknown. **/ - static function totalMemory():UInt64; + static function totalMemory():Null; /** Gets the amount of memory available to the process (in bytes) based on diff --git a/std/eval/vm/Gc.hx b/std/eval/vm/Gc.hx index b52842b1439..f3a1b93157f 100644 --- a/std/eval/vm/Gc.hx +++ b/std/eval/vm/Gc.hx @@ -123,7 +123,7 @@ typedef Control = { var major_heap_increment:Int; /** - The major GC speed is computed from this parameter. This is the memory that will be "wasted" because the GC does not immediatly collect unreachable blocks. It is expressed as a percentage of the memory used for live data. The GC will work more (use more CPU time and collect blocks more eagerly) if space_overhead is smaller. Default: 80. + The major GC speed is computed from this parameter. This is the memory that will be "wasted" because the GC does not immediately collect unreachable blocks. It is expressed as a percentage of the memory used for live data. The GC will work more (use more CPU time and collect blocks more eagerly) if space_overhead is smaller. Default: 80. **/ var space_overhead:Int; diff --git a/std/flash/AnyType.hx b/std/flash/AnyType.hx index 0e35c323cef..7b9e248c40f 100644 --- a/std/flash/AnyType.hx +++ b/std/flash/AnyType.hx @@ -2,7 +2,7 @@ package flash; /** This type represents the Flash `*` type, which is - actually the absense of type. It can be used as a + actually the absence of type. It can be used as a type parameter for `flash.Vector` to represent the native `Vector.<*>` type. **/ diff --git a/std/haxe/EnumTools.hx b/std/haxe/EnumTools.hx index 35c787eeded..3d2420b99c5 100644 --- a/std/haxe/EnumTools.hx +++ b/std/haxe/EnumTools.hx @@ -111,9 +111,9 @@ extern class EnumTools { return Type.getEnumConstructs(e); } - #if (java && jvm) + #if jvm @:noCompletion - extern static function values(en:Enum):java.NativeArray>; + extern static function values(en:Enum):jvm.NativeArray>; #end } diff --git a/std/haxe/Int64.hx b/std/haxe/Int64.hx index 06c256c406f..99e41f55ec3 100644 --- a/std/haxe/Int64.hx +++ b/std/haxe/Int64.hx @@ -165,7 +165,7 @@ abstract Int64(__Int64) from __Int64 to __Int64 { } /** - Performs signed integer divison of `dividend` by `divisor`. + Performs signed integer division of `dividend` by `divisor`. Returns `{ quotient : Int64, modulus : Int64 }`. **/ public static function divMod(dividend:Int64, divisor:Int64):{quotient:Int64, modulus:Int64} { diff --git a/std/haxe/Int64Helper.hx b/std/haxe/Int64Helper.hx index bd34c341fed..e39b992baa8 100644 --- a/std/haxe/Int64Helper.hx +++ b/std/haxe/Int64Helper.hx @@ -83,8 +83,8 @@ class Int64Helper { var noFractions = f - (f % 1); - // 2^53-1 and -2^53+1: these are parseable without loss of precision. - // In theory 2^53 and -2^53 are parseable too, but then there's no way to + // 2^53-1 and -2^53+1: these are parsable without loss of precision. + // In theory 2^53 and -2^53 are parsable too, but then there's no way to // distinguish 2^53 from 2^53+1 // (i.e. trace(9007199254740992. + 1. > 9007199254740992.); // false!) if (noFractions > 9007199254740991) { diff --git a/std/haxe/atomic/AtomicInt.hx b/std/haxe/atomic/AtomicInt.hx index 2c499322bf4..fc0f4489ff2 100644 --- a/std/haxe/atomic/AtomicInt.hx +++ b/std/haxe/atomic/AtomicInt.hx @@ -19,7 +19,7 @@ abstract AtomicInt { public function add(b:Int):Int; /** - Atomically substracts `b` from `a`. + Atomically subtracts `b` from `a`. Returns the original value of `a`. **/ public function sub(b:Int):Int; diff --git a/std/haxe/display/Display.hx b/std/haxe/display/Display.hx index 35f439950ce..8ccb6dd27f2 100644 --- a/std/haxe/display/Display.hx +++ b/std/haxe/display/Display.hx @@ -164,7 +164,7 @@ enum abstract ClassFieldOriginKind(Int) { /** The field is declared on a parent type, such as: - - a super class field that is not overriden + - a super class field that is not overridden - a forwarded abstract field **/ var Parent:ClassFieldOriginKind>; @@ -508,7 +508,7 @@ enum abstract FindReferencesKind(String) to String { var Direct = "direct"; /** - Find references to the base field and all the overidding fields in the inheritance chain. + Find references to the base field and all the overriding fields in the inheritance chain. **/ var WithBaseAndDescendants = "withBaseAndDescendants"; diff --git a/std/haxe/ds/Vector.hx b/std/haxe/ds/Vector.hx index 14b60b90ce6..91d93300d8d 100644 --- a/std/haxe/ds/Vector.hx +++ b/std/haxe/ds/Vector.hx @@ -32,7 +32,7 @@ private typedef VectorData = #elseif neko neko.NativeArray #elseif java - java.NativeArray + jvm.NativeArray #elseif lua lua.Table #elseif eval @@ -280,7 +280,7 @@ abstract Vector(VectorData) { #elseif flash10 return fromData(flash.Vector.ofArray(array)); #elseif java - return fromData(java.Lib.nativeArray(array, false)); + return fromData(jvm.NativeArray.ofArray(array)); #elseif cpp return cast array.copy(); #elseif js diff --git a/std/haxe/hxb/WriterConfig.hx b/std/haxe/hxb/WriterConfig.hx index 7796dfdf228..b7a6086cf5d 100644 --- a/std/haxe/hxb/WriterConfig.hx +++ b/std/haxe/hxb/WriterConfig.hx @@ -7,7 +7,7 @@ typedef WriterTargetConfig = { var ?generate:Null; /** - Dot paths of modules or packages to be exluded from the archive. + Dot paths of modules or packages to be excluded from the archive. **/ var ?exclude:Null>; diff --git a/std/haxe/io/BytesData.hx b/std/haxe/io/BytesData.hx index 49de7e2cd41..290c7fcd625 100644 --- a/std/haxe/io/BytesData.hx +++ b/std/haxe/io/BytesData.hx @@ -29,7 +29,7 @@ typedef BytesData = flash.utils.ByteArray; #elseif cpp typedef BytesData = Array; #elseif java -typedef BytesData = java.NativeArray; +typedef BytesData = jvm.NativeArray; #elseif python typedef BytesData = python.Bytearray; #elseif js diff --git a/std/haxe/io/Error.hx b/std/haxe/io/Error.hx index beb00995a31..fff775e58cb 100644 --- a/std/haxe/io/Error.hx +++ b/std/haxe/io/Error.hx @@ -29,7 +29,7 @@ package haxe.io; @:keep #end enum Error { - /** The IO is set into nonblocking mode and some data cannot be read or written **/ + /** The IO is set into non-blocking mode and some data cannot be read or written **/ Blocked; /** An integer value is outside its allowed range **/ diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index e391e268e93..b574d1b3362 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -266,7 +266,13 @@ class Compiler { switch (t) { case TInst(c, _): name = c.toString(); - b = c.get(); + var c = c.get(); + switch (c.kind) { + case KModuleFields(module): + name = module; + case _: + } + b = c; case TEnum(e, _): name = e.toString(); b = e.get(); @@ -397,7 +403,7 @@ class Compiler { } /** - Register a custom medatada for documentation and completion purposes + Register a custom metadata for documentation and completion purposes **/ public static function registerCustomMetadata(meta:MetadataDescription, ?source:String):Void { #if (neko || eval) diff --git a/std/haxe/macro/Context.hx b/std/haxe/macro/Context.hx index 82889fe7c72..eb2d963c04a 100644 --- a/std/haxe/macro/Context.hx +++ b/std/haxe/macro/Context.hx @@ -466,7 +466,7 @@ class Context { is done running initialization macros, when typing begins. `onAfterInitMacros` should be used to delay typer-dependant code from - your initalization macros, to properly separate configuration phase and + your initialization macros, to properly separate configuration phase and actual typing. **/ public static function onAfterInitMacros(callback:Void->Void):Void { diff --git a/std/haxe/macro/Expr.hx b/std/haxe/macro/Expr.hx index 30d7f00e3f5..7cdd0a841f4 100644 --- a/std/haxe/macro/Expr.hx +++ b/std/haxe/macro/Expr.hx @@ -342,7 +342,7 @@ typedef Var = { var ?isStatic:Bool; /** - Metadata associatied with the variable, if available. + Metadata associated with the variable, if available. **/ var ?meta:Metadata; } diff --git a/std/haxe/macro/JSGenApi.hx b/std/haxe/macro/JSGenApi.hx index 9f1fa170930..033f915bf60 100644 --- a/std/haxe/macro/JSGenApi.hx +++ b/std/haxe/macro/JSGenApi.hx @@ -61,6 +61,6 @@ typedef JSGenApi = { /** create the metadata expression for the given type **/ function buildMetaData(t:BaseType):Null; - /** select the current classe **/ + /** select the current class **/ function setCurrentClass(c:ClassType):Void; } diff --git a/std/haxe/macro/Printer.hx b/std/haxe/macro/Printer.hx index bce266f7239..1bdb637f1fa 100644 --- a/std/haxe/macro/Printer.hx +++ b/std/haxe/macro/Printer.hx @@ -30,6 +30,9 @@ using StringTools; /** This class provides some utility methods to convert elements from the macro context to a human-readable String representation. + + This is only guaranteed to work with data that corresponds to valid Haxe + syntax. */ class Printer { var tabs:String; @@ -87,7 +90,8 @@ class Printer { .replace("\t", "\\t") .replace("\r", "\\r") .replace("'", "\\'") - .replace('"', "\\\"") #if sys .replace("\x00", "\\x00") #end + delim; + .replace('"', "\\\"") + #if sys .replace("\x00", "\\x00") #end + delim; } public function printFormatString(s:String) { @@ -401,18 +405,15 @@ class Printer { } (isEnum ? "enum " : "") - + "abstract " - + t.name - + ((t.params != null && t.params.length > 0) ? "<" + t.params.map(printTypeParamDecl).join(", ") + ">" : "") - + (tthis == null ? "" : "(" + printComplexType(tthis) + ")") - + [for (f in from) " from " + printComplexType(f)].join("") - + [for (f in to) " to " + printComplexType(f)].join("") - + " {\n" - + [ - for (f in t.fields) { - tabs + printFieldWithDelimiter(f); - } - ].join("\n") + "\n}"; + + "abstract " + + t.name + + ((t.params != null && t.params.length > 0) ? "<" + t.params.map(printTypeParamDecl).join(", ") + ">" : "") + + (tthis == null ? "" : "(" + printComplexType(tthis) + ")") + + [for (f in from) " from " + printComplexType(f)].join("") + [for (f in to) " to " + printComplexType(f)].join("") + " {\n" + [ + for (f in t.fields) { + tabs + printFieldWithDelimiter(f); + } + ].join("\n") + "\n}"; case TDField(kind, access): tabs = old; (access != null && access.length > 0 ? access.map(printAccess).join(" ") + " " : "") + switch (kind) { @@ -473,7 +474,8 @@ class Printer { loopI(e1); loopI(e2); case EField(e, field, kind): - if (kind == null) kind = Normal; + if (kind == null) + kind = Normal; add('EField $field (${kind.getName()})'); loopI(e); case EParenthesis(e): diff --git a/std/haxe/macro/Type.hx b/std/haxe/macro/Type.hx index 94e220d7d4d..e81f648287e 100644 --- a/std/haxe/macro/Type.hx +++ b/std/haxe/macro/Type.hx @@ -612,7 +612,7 @@ typedef MetaAccess = { */ enum FieldKind { /** - A variable of property, depending on the `read` and `write` values. + A variable or property, depending on the `read` and `write` values. **/ FVar(read:VarAccess, write:VarAccess); diff --git a/std/haxe/rtti/Meta.hx b/std/haxe/rtti/Meta.hx index 7292e408f2d..4505e66a481 100644 --- a/std/haxe/rtti/Meta.hx +++ b/std/haxe/rtti/Meta.hx @@ -42,22 +42,13 @@ class Meta { return (meta == null || meta.obj == null) ? {} : meta.obj; } - // Could move this to Type.hx? - private static function isInterface(t:Dynamic):Bool { - #if java - return java.Lib.toNativeType(t).isInterface(); - #else - throw "Something went wrong"; - #end - } - private static function getMeta(t:Dynamic):MetaObject { #if php return php.Boot.getMeta(t.phpClassName); #elseif java var ret = Reflect.field(t, "__meta__"); if (ret == null && Std.isOfType(t, Class)) { - if (isInterface(t)) { + if (jvm.NativeTools.NativeClassTools.native(t).isInterface()) { var name = Type.getClassName(t), cls = Type.resolveClass(name + '_HxMeta'); if (cls != null) diff --git a/std/java/Boot.hx b/std/java/Boot.hx deleted file mode 100644 index 72e64d075f5..00000000000 --- a/std/java/Boot.hx +++ /dev/null @@ -1,44 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java; - -import java.Lib; -import java.Init; -import java.StdTypes; -import Reflect; -import Map; -import haxe.ds.StringMap; -import java.lang.Boolean; -import java.lang.Character; -import java.lang.Class; -import java.lang.Number; -import java.lang.Byte; -import java.lang.Double; -import java.lang.Float; -import java.lang.Integer; -import java.lang.Long; -import java.lang.Short; -import java.lang.Throwable; - -@:dox(hide) -extern class Boot {} diff --git a/std/java/Init.hx b/std/java/Init.hx deleted file mode 100644 index f54f49af740..00000000000 --- a/std/java/Init.hx +++ /dev/null @@ -1,33 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ -package java; - -@:native("haxe.java.Init") @:keep class Init { - public static function init():Void { - #if std_encoding_utf8 - try { - java.lang.System.setOut(new java.io.PrintStream(java.lang.System.out, true, "utf-8")); - java.lang.System.setErr(new java.io.PrintStream(java.lang.System.err, true, "utf-8")); - } catch (e:java.io.UnsupportedEncodingException) {} - #end - } -} diff --git a/std/java/Lib.hx b/std/java/Lib.hx deleted file mode 100644 index 88e7e2b3d21..00000000000 --- a/std/java/Lib.hx +++ /dev/null @@ -1,163 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java; - -/** - Platform-specific Java Library. Provides some platform-specific functions for the Java target, - such as conversion from Haxe types to native types and vice-versa. -**/ -// we cannot use the java package for custom classes, so we're redefining it as "haxe.java.Lib" -@:native('haxe.java.Lib') class Lib { - /** - Print the specified value on the default output. - **/ - inline public static function print(v:Dynamic):Void { - Sys.print(v); - } - - /** - Print the specified value on the default output followed by a newline character. - **/ - inline public static function println(v:Dynamic):Void { - Sys.println(v); - } - - /** - Returns a native array from the supplied Array. This native array is unsafe to be written on, - as it may or may not be linked to the actual Array implementation. - - If `equalLengthRequired` is true, the result might be a copy of an array with the correct size. - **/ - inline public static function nativeArray(arr:Array, equalLengthRequired:Bool):NativeArray { - var ret = new NativeArray(arr.length); - for (i in 0...arr.length) { - ret[i] = arr[i]; - } - return ret; - } - - /** - Gets the native `java.lang.Class` from the supplied object. Will throw an exception in case of null being passed. - [deprecated] - use `getNativeType` instead - **/ - @:deprecated('The function `nativeType` is deprecated and will be removed in later versions. Please use `getNativeType` instead') - inline public static function nativeType(obj:T):java.lang.Class { - return untyped obj.getClass(); - } - - /** - Gets the native `java.lang.Class` from the supplied object. Will throw an exception in case of null being passed. - **/ - inline public static function getNativeType(obj:T):java.lang.Class { - return untyped obj.getClass(); - } - - /** - Returns a Class<> equivalent to the native java.lang.Class type. - **/ - public static inline function fromNativeType(t:java.lang.Class):Class { - return untyped t; - } - - /** - Returns a java.lang.Class equivalent to the Haxe Class<> type. - **/ - public static inline function toNativeType(cl:Class):java.lang.Class { - return untyped cl; - } - - /** - Returns a java.lang.Class equivalent to the Haxe Enum<> type. - **/ - public static inline function toNativeEnum(cl:Enum):java.lang.Class { - return untyped cl; - } - - /** - Returns a Haxe Array of a native Array. - Unless `copy` is true, it won't copy the contents of the native array, - so unless any operation triggers an array resize, all changes made to the Haxe array will affect the native array argument. - **/ - @:generic public static function array(native:java.NativeArray):Array { - return untyped Array.ofNative(native); - } - - extern inline private static function doArray(native:java.NativeArray):Array { - var ret:NativeArray = new NativeArray(native.length); - for (i in 0...native.length) { - ret[i] = native[i]; - } - return untyped Array.ofNative(ret); - } - - public static function array_Int(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_Float(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_Bool(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_java_Int8(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_java_Int16(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_java_Char16(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_Single(native:java.NativeArray):Array { - return doArray(native); - } - - public static function array_haxe_Int64(native:java.NativeArray):Array { - return doArray(native); - } - - /** - Allocates a new Haxe Array with a predetermined size - **/ - public static function arrayAlloc(size:Int):Array { - return untyped Array.alloc(size); - } - - /** - Ensures that one thread does not enter a critical section of code while another thread - is in the critical section. If another thread attempts to enter a locked code, it - will wait, block, until the object is released. - This is the equivalent to "synchronized" in java code. - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function lock(obj:Dynamic, block:T):Void { - untyped __lock__(obj, block); - } -} diff --git a/std/java/NativeArray.hx b/std/java/NativeArray.hx index 685da747739..9bd9ef54109 100644 --- a/std/java/NativeArray.hx +++ b/std/java/NativeArray.hx @@ -1,50 +1,3 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - package java; -import haxe.extern.Rest; - -/** - Represents a java fixed-size Array (`T[]`) -**/ -@:nativeGen extern class NativeArray implements ArrayAccess { - /** - Creates a new array with the specified elements. - - Usage: - ```haxe - var elements = NativeArray.make(1,2,3,4,5,6); - ``` - **/ - static function make(elements:Rest):NativeArray; - - /** - The length of the array - **/ - var length(default, null):Int; - - /** - Allocates a new array with size `len` - **/ - function new(len:Int):Void; -} +typedef NativeArray = jvm.NativeArray; \ No newline at end of file diff --git a/std/java/NativeString.hx b/std/java/NativeString.hx index 3cf50a5e6ce..e9ef3191958 100644 --- a/std/java/NativeString.hx +++ b/std/java/NativeString.hx @@ -1,99 +1,3 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - package java; -import haxe.Int64; -import haxe.extern.Rest; -import java.StdTypes.Int8; -import java.StdTypes.Char16; -import java.lang.CharSequence; -import java.util.Locale; - -@:native("java.lang.String") -extern class NativeString { - function charAt(index:Int):Char16; - function codePointAt(index:Int):Int; - function codePointBefore(index:Int):Int; - function codePointCount(beginIndex:Int, endIndex:Int):Int; - function compareTo(anotherString:String):Int; - function compareToIgnoreCase(str:String):Int; - function concat(str:String):String; - function contains(s:CharSequence):Bool; - @:overload function contentEquals(cs:CharSequence):Bool; - @:overload function contentEquals(sb:java.lang.StringBuffer):Bool; - @:overload static function copyValueOf(data:NativeArray):String; - @:overload static function copyValueOf(data:NativeArray, offset:Int, count:Int):String; - function endsWith(suffix:String):Bool; - function equals(anObject:Dynamic):Bool; - function equalsIgnoreCase(anotherString:String):Bool; - @:overload static function format(l:Locale, format:String, args:Rest):String; - @:overload static function format(format:String, args:Rest):String; - @:overload function getBytes():NativeArray; - @:overload function getBytes(charset:java.nio.charset.Charset):NativeArray; - @:deprecated @:overload function getBytes(srcBegin:Int, srcEnd:Int, dst:NativeArray, dstBegin:Int):Void; - @:overload function getBytes(charsetName:String):NativeArray; - function getChars(srcBegin:Int, srcEnd:Int, dst:NativeArray, dstBegin:Int):Void; - function hashCode():Int; - @:overload function indexOf(ch:Int):Int; - @:overload function indexOf(ch:Int, fromIndex:Int):Int; - @:overload function indexOf(str:String):Int; - @:overload function indexOf(str:String, fromIndex:Int):Int; - function intern():String; - function isEmpty():Bool; - @:overload function lastIndexOf(ch:Int):Int; - @:overload function lastIndexOf(ch:Int, fromIndex:Int):Int; - @:overload function lastIndexOf(str:String):Int; - @:overload function lastIndexOf(str:String, fromIndex:Int):Int; - function length():Int; - function matches(regex:String):Bool; - function offsetByCodePoints(index:Int, codePointOffset:Int):Int; - @:overload function regionMatches(ignoreCase:Bool, toffset:Int, other:String, ooffset:Int, len:Int):Bool; - @:overload function regionMatches(toffset:Int, other:String, ooffset:Int, len:Int):Bool; - @:overload function replace(oldChar:Char16, newChar:Char16):String; - @:overload function replace(target:CharSequence, replacement:CharSequence):String; - function replaceAll(regex:String, replacement:String):String; - function replaceFirst(regex:String, replacement:String):String; - @:overload function split(regex:String):NativeArray; - @:overload function split(regex:String, limit:Int):NativeArray; - @:overload function startsWith(prefix:String):Bool; - @:overload function startsWith(prefix:String, toffset:Int):Bool; - function subSequence(beginIndex:Int, endIndex:Int):CharSequence; - @:overload function substring(beginIndex:Int):String; - @:overload function substring(beginIndex:Int, endIndex:Int):String; - function toCharArray():NativeArray; - @:overload function toLowerCase():String; - @:overload function toLowerCase(locale:Locale):String; - function toString():String; - @:overload function toUpperCase():String; - @:overload function toUpperCase(locale:Locale):String; - function trim():String; - @:overload static function valueOf(b:Bool):String; - @:overload static function valueOf(c:Char16):String; - @:overload static function valueOf(data:NativeArray):String; - @:overload static function valueOf(data:NativeArray, offset:Int, count:Int):String; - @:overload static function valueOf(d:Float):String; - @:overload static function valueOf(f:String):String; - @:overload static function valueOf(i:Int):String; - @:overload static function valueOf(l:haxe.Int64):String; - @:overload static function valueOf(obj:java.lang.Object):String; -} +typedef NativeString = jvm.NativeString; \ No newline at end of file diff --git a/std/java/_std/haxe/ds/IntMap.hx b/std/java/_std/haxe/ds/IntMap.hx deleted file mode 100644 index a5427aa78ee..00000000000 --- a/std/java/_std/haxe/ds/IntMap.hx +++ /dev/null @@ -1,523 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package haxe.ds; - -import java.NativeArray; - -/* - * This IntMap implementation is based on khash (https://github.com/attractivechaos/klib/blob/master/khash.h) - * Copyright goes to Attractive Chaos and his contributors - * - * Thanks also to Jonas Malaco Filho for his Haxe-written IntMap code inspired by Python tables. - * (https://jonasmalaco.com/fossil/test/jonas-haxe/artifact/887b53126e237d6c68951111d594033403889304) - */ -@:coreApi class IntMap implements haxe.Constraints.IMap { - private static inline var HASH_UPPER = 0.7; - - private var flags:NativeArray; - private var _keys:NativeArray; - private var vals:NativeArray; - - private var nBuckets:Int; - private var size:Int; - private var nOccupied:Int; - private var upperBound:Int; - - #if !no_map_cache - private var cachedKey:Int; - private var cachedIndex:Int; - #end - - public function new():Void { - #if !no_map_cache - cachedIndex = -1; - #end - } - - public function set(key:Int, value:T):Void { - var targetIndex:Int; - if (nOccupied >= upperBound) { - if (nBuckets > (size << 1)) { - resize(nBuckets - 1); // clear "deleted" elements - } else { - resize(nBuckets + 1); - } - } - - var flags = flags, _keys = _keys; - { - var mask = nBuckets - 1, - hashedKey = hash(key), - curIndex = hashedKey & mask; - - var delKey = -1, curFlag = 0; - // to speed things up, don't loop if the first bucket is already free - if (isEmpty(getFlag(flags, curIndex))) { - targetIndex = curIndex; - } else { - var inc = getInc(hashedKey, mask), last = curIndex; - while (!(_keys[curIndex] == key || isEmpty(curFlag = getFlag(flags, curIndex)))) { - if (delKey == -1 && isDel(curFlag)) { - delKey = curIndex; - } - curIndex = (curIndex + inc) & mask; - #if debug - assert(curIndex != last); - #end - } - - if (delKey != -1 && isEmpty(getFlag(flags, curIndex))) { - targetIndex = delKey; - } else { - targetIndex = curIndex; - } - } - } - - var flag = getFlag(flags, targetIndex); - if (isEmpty(flag)) { - _keys[targetIndex] = key; - vals[targetIndex] = value; - setIsBothFalse(flags, targetIndex); - size++; - nOccupied++; - } else if (isDel(flag)) { - _keys[targetIndex] = key; - vals[targetIndex] = value; - setIsBothFalse(flags, targetIndex); - size++; - } else { - #if debug - assert(_keys[targetIndex] == key); - #end - vals[targetIndex] = value; - } - } - - private final function lookup(key:Int):Int { - if (nBuckets != 0) { - var flags = flags, _keys = _keys; - - var mask = nBuckets - 1, - k = hash(key), - index = k & mask, - curFlag = -1, - inc = getInc(k, mask), /* inc == 1 for linear probing */ - last = index; - do { - if (_keys[index] == key) { - if (isEmpty(curFlag = getFlag(flags, index))) { - index = (index + inc) & mask; - continue; - } else if (isDel(curFlag)) { - return -1; - } else { - return index; - } - } else { - index = (index + inc) & mask; - } - } while (index != last); - } - - return -1; - } - - public function get(key:Int):Null { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return null; - } - - private function getDefault(key:Int, def:T):T { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return def; - } - - public function exists(key:Int):Bool { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return true; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return true; - } - - return false; - } - - public function remove(key:Int):Bool { - var idx = -1; - #if !no_map_cache - if (!(cachedKey == key && ((idx = cachedIndex) != -1))) - #end - { - idx = lookup(key); - } - - if (idx == -1) { - return false; - } else { - #if !no_map_cache - if (cachedKey == key) { - cachedIndex = -1; - } - #end - if (!isEither(getFlag(flags, idx))) { - setIsDelTrue(flags, idx); - --size; - - vals[idx] = null; - // we do NOT reset the keys here, as unlike StringMap, we check for keys equality - // and stop if we find a key that is equal to the one we're looking for - // setting this to 0 will allow the hash to contain duplicate `0` keys - // (see #6457) - // _keys[idx] = 0; - } - - return true; - } - } - - private final function resize(newNBuckets:Int):Void { - // This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. - var newFlags = null; - var j = 1; - { - newNBuckets = roundUp(newNBuckets); - if (newNBuckets < 4) - newNBuckets = 4; - if (size >= (newNBuckets * HASH_UPPER + 0.5)) - /* requested size is too small */ { - j = 0; - } else { /* hash table size to be changed (shrink or expand); rehash */ - var nfSize = flagsSize(newNBuckets); - newFlags = new NativeArray(nfSize); - for (i in 0...nfSize) { - newFlags[i] = 0xaaaaaaaa; // isEmpty = true; isDel = false - } - if (nBuckets < newNBuckets) // expand - { - var k = new NativeArray(newNBuckets); - if (_keys != null) { - arrayCopy(_keys, 0, k, 0, nBuckets); - } - _keys = k; - - var v = new NativeArray(newNBuckets); - if (vals != null) { - arrayCopy(vals, 0, v, 0, nBuckets); - } - vals = v; - } // otherwise shrink - } - } - - if (j != 0) { // rehashing is required - #if !no_map_cache - // resetting cache - cachedKey = 0; - cachedIndex = -1; - #end - - j = -1; - var nBuckets = nBuckets, _keys = _keys, vals = vals, flags = flags; - - var newMask = newNBuckets - 1; - while (++j < nBuckets) { - if (!isEither(getFlag(flags, j))) { - var key = _keys[j]; - var val = vals[j]; - - // do not set keys as 0 - see comment about #6457 - // _keys[j] = 0; - vals[j] = cast null; - setIsDelTrue(flags, j); - while (true) - /* kick-out process; sort of like in Cuckoo hashing */ { - var k = hash(key); - var inc = getInc(k, newMask); - var i = k & newMask; - while (!isEmpty(getFlag(newFlags, i))) { - i = (i + inc) & newMask; - } - setIsEmptyFalse(newFlags, i); - - if (i < nBuckets && !isEither(getFlag(flags, i))) - /* kick out the existing element */ { - { - var tmp = _keys[i]; - _keys[i] = key; - key = tmp; - } { - var tmp = vals[i]; - vals[i] = val; - val = tmp; - } - - setIsDelTrue(flags, i); /* mark it as deleted in the old hash table */ - } else { /* write the element and jump out of the loop */ - _keys[i] = key; - vals[i] = val; - break; - } - } - } - } - - if (nBuckets > newNBuckets) - /* shrink the hash table */ { - { - var k = new NativeArray(newNBuckets); - arrayCopy(_keys, 0, k, 0, newNBuckets); - this._keys = k; - } { - var v = new NativeArray(newNBuckets); - arrayCopy(vals, 0, v, 0, newNBuckets); - this.vals = v; - } - } - - this.flags = newFlags; - this.nBuckets = newNBuckets; - this.nOccupied = size; - this.upperBound = Std.int(newNBuckets * HASH_UPPER + .5); - } - } - - public inline function keys():Iterator { - return new IntMapKeyIterator(this); - } - - public inline function iterator():Iterator { - return new IntMapValueIterator(this); - } - - @:runtime public inline function keyValueIterator():KeyValueIterator { - return new haxe.iterators.MapKeyValueIterator(this); - } - - public function copy():IntMap { - var copied = new IntMap(); - for (key in keys()) - copied.set(key, get(key)); - return copied; - } - - public function toString():String { - var s = new StringBuf(); - s.add("["); - var it = keys(); - for (i in it) { - s.add(i); - s.add(" => "); - s.add(Std.string(get(i))); - if (it.hasNext()) - s.add(", "); - } - s.add("]"); - return s.toString(); - } - - public function clear():Void { - flags = null; - _keys = null; - vals = null; - nBuckets = 0; - size = 0; - nOccupied = 0; - upperBound = 0; - #if !no_map_cache - cachedKey = 0; - cachedIndex = -1; - #end - } - - private static inline function assert(x:Bool):Void { - #if debug - if (!x) - throw "assert failed"; - #end - } - - private static inline function defaultK():Int - return 0; - - private static inline function arrayCopy(sourceArray:Dynamic, sourceIndex:Int, destinationArray:Dynamic, destinationIndex:Int, length:Int):Void - java.lang.System.arraycopy(sourceArray, sourceIndex, destinationArray, destinationIndex, length); - - private static inline function getInc(k:Int, mask:Int):Int - return (((k) >> 3 ^ (k) << 3) | 1) & (mask); - - private static inline function hash(i:Int):Int - return i; - - // flags represents a bit array with 2 significant bits for each index - // one bit for deleted (1), one for empty (2) - // so what this function does is: - // * gets the integer with (flags / 16) - // * shifts those bits to the right ((flags % 16) * 2) places - // * masks it with 0b11 - private static inline function getFlag(flags:NativeArray, i:Int):Int { - return ((flags[i >> 4] >>> ((i & 0xf) << 1)) & 3); - } - - private static inline function isDel(flag:Int):Bool { - return (flag & 1) != 0; - } - - private static inline function isEmpty(flag:Int):Bool { - return (flag & 2) != 0; - } - - private static inline function isEither(flag:Int):Bool { - return flag != 0; - } - - private static inline function setIsDelFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(1 << ((i & 0xf) << 1)); - } - - private static inline function setIsEmptyFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(2 << ((i & 0xf) << 1)); - } - - private static inline function setIsBothFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(3 << ((i & 0xf) << 1)); - } - - private static inline function setIsDelTrue(flags:NativeArray, i:Int):Void { - flags[i >> 4] |= 1 << ((i & 0xf) << 1); - } - - private static inline function roundUp(x:Int):Int { - --x; - x |= (x) >>> 1; - x |= (x) >>> 2; - x |= (x) >>> 4; - x |= (x) >>> 8; - x |= (x) >>> 16; - return ++x; - } - - private static inline function flagsSize(m:Int):Int - return ((m) < 16 ? 1 : (m) >> 4); -} - -@:access(haxe.ds.IntMap) -private final class IntMapKeyIterator { - var m:IntMap; - var i:Int; - var len:Int; - - public function new(m:IntMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!IntMap.isEither(IntMap.getFlag(m.flags, j))) { - i = j; - return true; - } - } - return false; - } - - public function next():Int { - var ret = m._keys[i]; - #if !no_map_cache - m.cachedIndex = i; - m.cachedKey = ret; - #end - i++; - return ret; - } -} - -@:access(haxe.ds.IntMap) -private final class IntMapValueIterator { - var m:IntMap; - var i:Int; - var len:Int; - - public function new(m:IntMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!IntMap.isEither(IntMap.getFlag(m.flags, j))) { - i = j; - return true; - } - } - return false; - } - - public inline function next():T { - return m.vals[i++]; - } -} diff --git a/std/java/lang/Byte.hx b/std/java/lang/Byte.hx index cd673ba280a..1f5f7803879 100644 --- a/std/java/lang/Byte.hx +++ b/std/java/lang/Byte.hx @@ -26,31 +26,31 @@ package java.lang; @:transitive @:forwardStatics @:forward abstract Byte(ByteClass) from ByteClass to ByteClass { - @:to extern inline public function toByte():java.types.Int8 + @:to extern inline public function toByte():jvm.Int8 return this.byteValue(); - @:from extern inline public static function fromByte(b:java.types.Int8):Byte + @:from extern inline public static function fromByte(b:jvm.Int8):Byte return ByteClass.valueOf(b); } @:native("java.lang.Byte") extern class ByteClass extends Number implements Comparable { - @:overload function new(param1:java.types.Int8):Void; + @:overload function new(param1:jvm.Int8):Void; @:overload @:throws("java.lang.NumberFormatException") function new(param1:String):Void; @:overload function compareTo(param1:Byte):Int; @:overload function compareTo(param1:Dynamic):Int; @:overload function equals(param1:Dynamic):Bool; @:overload function hashCode():Int; @:overload function toString():String; - static final MAX_VALUE:java.types.Int8; - static final MIN_VALUE:java.types.Int8; + static final MAX_VALUE:jvm.Int8; + static final MIN_VALUE:jvm.Int8; static final SIZE:Int; static final TYPE:Class; - @:overload static function compare(param1:java.types.Int8, param2:java.types.Int8):Int; + @:overload static function compare(param1:jvm.Int8, param2:jvm.Int8):Int; @:overload @:throws("java.lang.NumberFormatException") static function decode(param1:String):Byte; - @:overload @:throws("java.lang.NumberFormatException") static function parseByte(param1:String, param2:Int):java.types.Int8; - @:overload @:throws("java.lang.NumberFormatException") static function parseByte(param1:String):java.types.Int8; - @:native("toString") @:overload static function _toString(param1:java.types.Int8):String; - @:overload static function valueOf(param1:java.types.Int8):Byte; + @:overload @:throws("java.lang.NumberFormatException") static function parseByte(param1:String, param2:Int):jvm.Int8; + @:overload @:throws("java.lang.NumberFormatException") static function parseByte(param1:String):jvm.Int8; + @:native("toString") @:overload static function _toString(param1:jvm.Int8):String; + @:overload static function valueOf(param1:jvm.Int8):Byte; @:overload @:throws("java.lang.NumberFormatException") static function valueOf(param1:String):Byte; @:overload @:throws("java.lang.NumberFormatException") static function valueOf(param1:String, param2:Int):Byte; diff --git a/std/java/lang/Character.hx b/std/java/lang/Character.hx index d95ca2f94cd..a4233ea6660 100644 --- a/std/java/lang/Character.hx +++ b/std/java/lang/Character.hx @@ -26,166 +26,166 @@ package java.lang; @:transitive @:forwardStatics @:forward abstract Character(CharacterClass) from CharacterClass to CharacterClass { - @:to extern inline public function toCharacter():java.types.Char16 + @:to extern inline public function toCharacter():jvm.Char16 return this.charValue(); - @:from extern inline public static function fromCharacter(b:java.types.Char16):Character + @:from extern inline public static function fromCharacter(b:jvm.Char16):Character return CharacterClass.valueOf(b); } @:native("java.lang.Character") extern class CharacterClass implements Comparable { - @:overload function new(param1:java.types.Char16):Void; - @:overload function charValue():java.types.Char16; + @:overload function new(param1:jvm.Char16):Void; + @:overload function charValue():jvm.Char16; @:overload function compareTo(param1:Character):Int; @:overload function compareTo(param1:Dynamic):Int; @:overload function equals(param1:Dynamic):Bool; @:overload function hashCode():Int; @:overload function toString():String; - static final COMBINING_SPACING_MARK:java.types.Char16; - static final CONNECTOR_PUNCTUATION:java.types.Char16; - static final CONTROL:java.types.Char16; - static final CURRENCY_SYMBOL:java.types.Char16; - static final DASH_PUNCTUATION:java.types.Char16; - static final DECIMAL_DIGIT_NUMBER:java.types.Char16; - static final DIRECTIONALITY_ARABIC_NUMBER:java.types.Char16; - static final DIRECTIONALITY_BOUNDARY_NEUTRAL:java.types.Char16; - static final DIRECTIONALITY_COMMON_NUMBER_SEPARATOR:java.types.Char16; - static final DIRECTIONALITY_EUROPEAN_NUMBER:java.types.Char16; - static final DIRECTIONALITY_EUROPEAN_NUMBER_SEPARATOR:java.types.Char16; - static final DIRECTIONALITY_EUROPEAN_NUMBER_TERMINATOR:java.types.Char16; - static final DIRECTIONALITY_LEFT_TO_RIGHT:java.types.Char16; - static final DIRECTIONALITY_LEFT_TO_RIGHT_EMBEDDING:java.types.Char16; - static final DIRECTIONALITY_LEFT_TO_RIGHT_OVERRIDE:java.types.Char16; - static final DIRECTIONALITY_NONSPACING_MARK:java.types.Char16; - static final DIRECTIONALITY_OTHER_NEUTRALS:java.types.Char16; - static final DIRECTIONALITY_PARAGRAPH_SEPARATOR:java.types.Char16; - static final DIRECTIONALITY_POP_DIRECTIONAL_FORMAT:java.types.Char16; - static final DIRECTIONALITY_RIGHT_TO_LEFT:java.types.Char16; - static final DIRECTIONALITY_RIGHT_TO_LEFT_ARABIC:java.types.Char16; - static final DIRECTIONALITY_RIGHT_TO_LEFT_EMBEDDING:java.types.Char16; - static final DIRECTIONALITY_RIGHT_TO_LEFT_OVERRIDE:java.types.Char16; - static final DIRECTIONALITY_SEGMENT_SEPARATOR:java.types.Char16; - static final DIRECTIONALITY_UNDEFINED:java.types.Char16; - static final DIRECTIONALITY_WHITESPACE:java.types.Char16; - static final ENCLOSING_MARK:java.types.Char16; - static final END_PUNCTUATION:java.types.Char16; - static final FINAL_QUOTE_PUNCTUATION:java.types.Char16; - static final FORMAT:java.types.Char16; - static final INITIAL_QUOTE_PUNCTUATION:java.types.Char16; - static final LETTER_NUMBER:java.types.Char16; - static final LINE_SEPARATOR:java.types.Char16; - static final LOWERCASE_LETTER:java.types.Char16; - static final MATH_SYMBOL:java.types.Char16; + static final COMBINING_SPACING_MARK:jvm.Char16; + static final CONNECTOR_PUNCTUATION:jvm.Char16; + static final CONTROL:jvm.Char16; + static final CURRENCY_SYMBOL:jvm.Char16; + static final DASH_PUNCTUATION:jvm.Char16; + static final DECIMAL_DIGIT_NUMBER:jvm.Char16; + static final DIRECTIONALITY_ARABIC_NUMBER:jvm.Char16; + static final DIRECTIONALITY_BOUNDARY_NEUTRAL:jvm.Char16; + static final DIRECTIONALITY_COMMON_NUMBER_SEPARATOR:jvm.Char16; + static final DIRECTIONALITY_EUROPEAN_NUMBER:jvm.Char16; + static final DIRECTIONALITY_EUROPEAN_NUMBER_SEPARATOR:jvm.Char16; + static final DIRECTIONALITY_EUROPEAN_NUMBER_TERMINATOR:jvm.Char16; + static final DIRECTIONALITY_LEFT_TO_RIGHT:jvm.Char16; + static final DIRECTIONALITY_LEFT_TO_RIGHT_EMBEDDING:jvm.Char16; + static final DIRECTIONALITY_LEFT_TO_RIGHT_OVERRIDE:jvm.Char16; + static final DIRECTIONALITY_NONSPACING_MARK:jvm.Char16; + static final DIRECTIONALITY_OTHER_NEUTRALS:jvm.Char16; + static final DIRECTIONALITY_PARAGRAPH_SEPARATOR:jvm.Char16; + static final DIRECTIONALITY_POP_DIRECTIONAL_FORMAT:jvm.Char16; + static final DIRECTIONALITY_RIGHT_TO_LEFT:jvm.Char16; + static final DIRECTIONALITY_RIGHT_TO_LEFT_ARABIC:jvm.Char16; + static final DIRECTIONALITY_RIGHT_TO_LEFT_EMBEDDING:jvm.Char16; + static final DIRECTIONALITY_RIGHT_TO_LEFT_OVERRIDE:jvm.Char16; + static final DIRECTIONALITY_SEGMENT_SEPARATOR:jvm.Char16; + static final DIRECTIONALITY_UNDEFINED:jvm.Char16; + static final DIRECTIONALITY_WHITESPACE:jvm.Char16; + static final ENCLOSING_MARK:jvm.Char16; + static final END_PUNCTUATION:jvm.Char16; + static final FINAL_QUOTE_PUNCTUATION:jvm.Char16; + static final FORMAT:jvm.Char16; + static final INITIAL_QUOTE_PUNCTUATION:jvm.Char16; + static final LETTER_NUMBER:jvm.Char16; + static final LINE_SEPARATOR:jvm.Char16; + static final LOWERCASE_LETTER:jvm.Char16; + static final MATH_SYMBOL:jvm.Char16; static final MAX_CODE_POINT:Int; - static final MAX_HIGH_SURROGATE:java.types.Char16; - static final MAX_LOW_SURROGATE:java.types.Char16; + static final MAX_HIGH_SURROGATE:jvm.Char16; + static final MAX_LOW_SURROGATE:jvm.Char16; static final MAX_RADIX:Int; - static final MAX_SURROGATE:java.types.Char16; - static final MAX_VALUE:java.types.Char16; + static final MAX_SURROGATE:jvm.Char16; + static final MAX_VALUE:jvm.Char16; static final MIN_CODE_POINT:Int; - static final MIN_HIGH_SURROGATE:java.types.Char16; - static final MIN_LOW_SURROGATE:java.types.Char16; + static final MIN_HIGH_SURROGATE:jvm.Char16; + static final MIN_LOW_SURROGATE:jvm.Char16; static final MIN_RADIX:Int; static final MIN_SUPPLEMENTARY_CODE_POINT:Int; - static final MIN_SURROGATE:java.types.Char16; - static final MIN_VALUE:java.types.Char16; - static final MODIFIER_LETTER:java.types.Char16; - static final MODIFIER_SYMBOL:java.types.Char16; - static final NON_SPACING_MARK:java.types.Char16; - static final OTHER_LETTER:java.types.Char16; - static final OTHER_NUMBER:java.types.Char16; - static final OTHER_PUNCTUATION:java.types.Char16; - static final OTHER_SYMBOL:java.types.Char16; - static final PARAGRAPH_SEPARATOR:java.types.Char16; - static final PRIVATE_USE:java.types.Char16; + static final MIN_SURROGATE:jvm.Char16; + static final MIN_VALUE:jvm.Char16; + static final MODIFIER_LETTER:jvm.Char16; + static final MODIFIER_SYMBOL:jvm.Char16; + static final NON_SPACING_MARK:jvm.Char16; + static final OTHER_LETTER:jvm.Char16; + static final OTHER_NUMBER:jvm.Char16; + static final OTHER_PUNCTUATION:jvm.Char16; + static final OTHER_SYMBOL:jvm.Char16; + static final PARAGRAPH_SEPARATOR:jvm.Char16; + static final PRIVATE_USE:jvm.Char16; static final SIZE:Int; - static final SPACE_SEPARATOR:java.types.Char16; - static final START_PUNCTUATION:java.types.Char16; - static final SURROGATE:java.types.Char16; - static final TITLECASE_LETTER:java.types.Char16; + static final SPACE_SEPARATOR:jvm.Char16; + static final START_PUNCTUATION:jvm.Char16; + static final SURROGATE:jvm.Char16; + static final TITLECASE_LETTER:jvm.Char16; static final TYPE:Class; - static final UNASSIGNED:java.types.Char16; - static final UPPERCASE_LETTER:java.types.Char16; + static final UNASSIGNED:jvm.Char16; + static final UPPERCASE_LETTER:jvm.Char16; @:overload static function charCount(param1:Int):Int; @:overload static function codePointAt(param1:CharSequence, param2:Int):Int; - @:overload static function codePointAt(param1:java.NativeArray, param2:Int, param3:Int):Int; - @:overload static function codePointAt(param1:java.NativeArray, param2:Int):Int; + @:overload static function codePointAt(param1:java.NativeArray, param2:Int, param3:Int):Int; + @:overload static function codePointAt(param1:java.NativeArray, param2:Int):Int; @:overload static function codePointBefore(param1:CharSequence, param2:Int):Int; - @:overload static function codePointBefore(param1:java.NativeArray, param2:Int, param3:Int):Int; - @:overload static function codePointBefore(param1:java.NativeArray, param2:Int):Int; + @:overload static function codePointBefore(param1:java.NativeArray, param2:Int, param3:Int):Int; + @:overload static function codePointBefore(param1:java.NativeArray, param2:Int):Int; @:overload static function codePointCount(param1:CharSequence, param2:Int, param3:Int):Int; - @:overload static function codePointCount(param1:java.NativeArray, param2:Int, param3:Int):Int; - @:overload static function compare(param1:java.types.Char16, param2:java.types.Char16):Int; - @:overload static function digit(param1:java.types.Char16, param2:Int):Int; + @:overload static function codePointCount(param1:java.NativeArray, param2:Int, param3:Int):Int; + @:overload static function compare(param1:jvm.Char16, param2:jvm.Char16):Int; + @:overload static function digit(param1:jvm.Char16, param2:Int):Int; @:overload static function digit(param1:Int, param2:Int):Int; - @:overload static function forDigit(param1:Int, param2:Int):java.types.Char16; - @:overload static function getDirectionality(param1:java.types.Char16):java.types.Char16; - @:overload static function getDirectionality(param1:Int):java.types.Char16; + @:overload static function forDigit(param1:Int, param2:Int):jvm.Char16; + @:overload static function getDirectionality(param1:jvm.Char16):jvm.Char16; + @:overload static function getDirectionality(param1:Int):jvm.Char16; @:overload static function getName(param1:Int):String; - @:overload static function getNumericValue(param1:java.types.Char16):Int; + @:overload static function getNumericValue(param1:jvm.Char16):Int; @:overload static function getNumericValue(param1:Int):Int; - @:overload static function getType(param1:java.types.Char16):Int; + @:overload static function getType(param1:jvm.Char16):Int; @:overload static function getType(param1:Int):Int; - @:overload static function highSurrogate(param1:Int):java.types.Char16; + @:overload static function highSurrogate(param1:Int):jvm.Char16; @:overload static function isAlphabetic(param1:Int):Bool; @:overload static function isBmpCodePoint(param1:Int):Bool; - @:overload static function isDefined(param1:java.types.Char16):Bool; + @:overload static function isDefined(param1:jvm.Char16):Bool; @:overload static function isDefined(param1:Int):Bool; - @:overload static function isDigit(param1:java.types.Char16):Bool; + @:overload static function isDigit(param1:jvm.Char16):Bool; @:overload static function isDigit(param1:Int):Bool; - @:overload static function isHighSurrogate(param1:java.types.Char16):Bool; - @:overload static function isISOControl(param1:java.types.Char16):Bool; + @:overload static function isHighSurrogate(param1:jvm.Char16):Bool; + @:overload static function isISOControl(param1:jvm.Char16):Bool; @:overload static function isISOControl(param1:Int):Bool; - @:overload static function isIdentifierIgnorable(param1:java.types.Char16):Bool; + @:overload static function isIdentifierIgnorable(param1:jvm.Char16):Bool; @:overload static function isIdentifierIgnorable(param1:Int):Bool; @:overload static function isIdeographic(param1:Int):Bool; - @:overload static function isJavaIdentifierPart(param1:java.types.Char16):Bool; + @:overload static function isJavaIdentifierPart(param1:jvm.Char16):Bool; @:overload static function isJavaIdentifierPart(param1:Int):Bool; - @:overload static function isJavaIdentifierStart(param1:java.types.Char16):Bool; + @:overload static function isJavaIdentifierStart(param1:jvm.Char16):Bool; @:overload static function isJavaIdentifierStart(param1:Int):Bool; - @:overload @:deprecated static function isJavaLetter(param1:java.types.Char16):Bool; - @:overload @:deprecated static function isJavaLetterOrDigit(param1:java.types.Char16):Bool; - @:overload static function isLetter(param1:java.types.Char16):Bool; + @:overload @:deprecated static function isJavaLetter(param1:jvm.Char16):Bool; + @:overload @:deprecated static function isJavaLetterOrDigit(param1:jvm.Char16):Bool; + @:overload static function isLetter(param1:jvm.Char16):Bool; @:overload static function isLetter(param1:Int):Bool; - @:overload static function isLetterOrDigit(param1:java.types.Char16):Bool; + @:overload static function isLetterOrDigit(param1:jvm.Char16):Bool; @:overload static function isLetterOrDigit(param1:Int):Bool; - @:overload static function isLowSurrogate(param1:java.types.Char16):Bool; - @:overload static function isLowerCase(param1:java.types.Char16):Bool; + @:overload static function isLowSurrogate(param1:jvm.Char16):Bool; + @:overload static function isLowerCase(param1:jvm.Char16):Bool; @:overload static function isLowerCase(param1:Int):Bool; - @:overload static function isMirrored(param1:java.types.Char16):Bool; + @:overload static function isMirrored(param1:jvm.Char16):Bool; @:overload static function isMirrored(param1:Int):Bool; - @:overload @:deprecated static function isSpace(param1:java.types.Char16):Bool; - @:overload static function isSpaceChar(param1:java.types.Char16):Bool; + @:overload @:deprecated static function isSpace(param1:jvm.Char16):Bool; + @:overload static function isSpaceChar(param1:jvm.Char16):Bool; @:overload static function isSpaceChar(param1:Int):Bool; @:overload static function isSupplementaryCodePoint(param1:Int):Bool; - @:overload static function isSurrogate(param1:java.types.Char16):Bool; - @:overload static function isSurrogatePair(param1:java.types.Char16, param2:java.types.Char16):Bool; - @:overload static function isTitleCase(param1:java.types.Char16):Bool; + @:overload static function isSurrogate(param1:jvm.Char16):Bool; + @:overload static function isSurrogatePair(param1:jvm.Char16, param2:jvm.Char16):Bool; + @:overload static function isTitleCase(param1:jvm.Char16):Bool; @:overload static function isTitleCase(param1:Int):Bool; - @:overload static function isUnicodeIdentifierPart(param1:java.types.Char16):Bool; + @:overload static function isUnicodeIdentifierPart(param1:jvm.Char16):Bool; @:overload static function isUnicodeIdentifierPart(param1:Int):Bool; - @:overload static function isUnicodeIdentifierStart(param1:java.types.Char16):Bool; + @:overload static function isUnicodeIdentifierStart(param1:jvm.Char16):Bool; @:overload static function isUnicodeIdentifierStart(param1:Int):Bool; - @:overload static function isUpperCase(param1:java.types.Char16):Bool; + @:overload static function isUpperCase(param1:jvm.Char16):Bool; @:overload static function isUpperCase(param1:Int):Bool; @:overload static function isValidCodePoint(param1:Int):Bool; - @:overload static function isWhitespace(param1:java.types.Char16):Bool; + @:overload static function isWhitespace(param1:jvm.Char16):Bool; @:overload static function isWhitespace(param1:Int):Bool; - @:overload static function lowSurrogate(param1:Int):java.types.Char16; + @:overload static function lowSurrogate(param1:Int):jvm.Char16; @:overload static function offsetByCodePoints(param1:CharSequence, param2:Int, param3:Int):Int; - @:overload static function offsetByCodePoints(param1:java.NativeArray, param2:Int, param3:Int, param4:Int, param5:Int):Int; - @:overload static function reverseBytes(param1:java.types.Char16):java.types.Char16; - @:overload static function toChars(param1:Int, param2:java.NativeArray, param3:Int):Int; - @:overload static function toChars(param1:Int):java.NativeArray; - @:overload static function toCodePoint(param1:java.types.Char16, param2:java.types.Char16):Int; - @:overload static function toLowerCase(param1:java.types.Char16):java.types.Char16; + @:overload static function offsetByCodePoints(param1:java.NativeArray, param2:Int, param3:Int, param4:Int, param5:Int):Int; + @:overload static function reverseBytes(param1:jvm.Char16):jvm.Char16; + @:overload static function toChars(param1:Int, param2:java.NativeArray, param3:Int):Int; + @:overload static function toChars(param1:Int):java.NativeArray; + @:overload static function toCodePoint(param1:jvm.Char16, param2:jvm.Char16):Int; + @:overload static function toLowerCase(param1:jvm.Char16):jvm.Char16; @:overload static function toLowerCase(param1:Int):Int; - @:native("toString") @:overload static function _toString(param1:java.types.Char16):String; - @:overload static function toTitleCase(param1:java.types.Char16):java.types.Char16; + @:native("toString") @:overload static function _toString(param1:jvm.Char16):String; + @:overload static function toTitleCase(param1:jvm.Char16):jvm.Char16; @:overload static function toTitleCase(param1:Int):Int; - @:overload static function toUpperCase(param1:java.types.Char16):java.types.Char16; + @:overload static function toUpperCase(param1:jvm.Char16):jvm.Char16; @:overload static function toUpperCase(param1:Int):Int; - @:overload static function valueOf(param1:java.types.Char16):Character; + @:overload static function valueOf(param1:jvm.Char16):Character; } @:realPath("java.lang.Character_CharacterCache") @:javaNative @:native("java.lang.Character$CharacterCache") @:javaCanonical("java.lang", @@ -411,7 +411,7 @@ package java.lang; static final YI_RADICALS:Character_UnicodeBlock; static final YI_SYLLABLES:Character_UnicodeBlock; @:overload final static function forName(param1:String):Character_UnicodeBlock; - @:overload static function of(param1:java.types.Char16):Character_UnicodeBlock; + @:overload static function of(param1:jvm.Char16):Character_UnicodeBlock; @:overload static function of(param1:Int):Character_UnicodeBlock; } diff --git a/std/java/lang/Short.hx b/std/java/lang/Short.hx index f36bf959787..c40f3f31fdc 100644 --- a/std/java/lang/Short.hx +++ b/std/java/lang/Short.hx @@ -26,32 +26,32 @@ package java.lang; @:transitive @:forwardStatics @:forward abstract Short(ShortClass) from ShortClass to ShortClass { - @:to extern inline public function toShort():java.types.Int16 + @:to extern inline public function toShort():jvm.Int16 return this.shortValue(); - @:from extern inline public static function fromShort(b:java.types.Int16):Short + @:from extern inline public static function fromShort(b:jvm.Int16):Short return ShortClass.valueOf(b); } @:native("java.lang.Short") extern class ShortClass extends Number implements Comparable { - @:overload function new(param1:java.types.Int16):Void; + @:overload function new(param1:jvm.Int16):Void; @:overload @:throws("java.lang.NumberFormatException") function new(param1:String):Void; @:overload function compareTo(param1:Short):Int; @:overload function compareTo(param1:Dynamic):Int; @:overload function equals(param1:Dynamic):Bool; @:overload function hashCode():Int; @:overload function toString():String; - static final MAX_VALUE:java.types.Int16; - static final MIN_VALUE:java.types.Int16; + static final MAX_VALUE:jvm.Int16; + static final MIN_VALUE:jvm.Int16; static final SIZE:Int; static final TYPE:Class; - @:overload static function compare(param1:java.types.Int16, param2:java.types.Int16):Int; + @:overload static function compare(param1:jvm.Int16, param2:jvm.Int16):Int; @:overload @:throws("java.lang.NumberFormatException") static function decode(param1:String):Short; - @:overload @:throws("java.lang.NumberFormatException") static function parseShort(param1:String, param2:Int):java.types.Int16; - @:overload @:throws("java.lang.NumberFormatException") static function parseShort(param1:String):java.types.Int16; - @:overload static function reverseBytes(param1:java.types.Int16):java.types.Int16; - @:native("toString") @:overload static function _toString(param1:java.types.Int16):String; - @:overload static function valueOf(param1:java.types.Int16):Short; + @:overload @:throws("java.lang.NumberFormatException") static function parseShort(param1:String, param2:Int):jvm.Int16; + @:overload @:throws("java.lang.NumberFormatException") static function parseShort(param1:String):jvm.Int16; + @:overload static function reverseBytes(param1:jvm.Int16):jvm.Int16; + @:native("toString") @:overload static function _toString(param1:jvm.Int16):String; + @:overload static function valueOf(param1:jvm.Int16):Short; @:overload @:throws("java.lang.NumberFormatException") static function valueOf(param1:String, param2:Int):Short; @:overload @:throws("java.lang.NumberFormatException") static function valueOf(param1:String):Short; diff --git a/std/java/types/Char16.hx b/std/java/types/Char16.hx deleted file mode 100644 index 3f0f9eb9ed0..00000000000 --- a/std/java/types/Char16.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.types; - -typedef Char16 = java.StdTypes.Char16; diff --git a/std/java/types/Int16.hx b/std/java/types/Int16.hx deleted file mode 100644 index 1f264aa6d2d..00000000000 --- a/std/java/types/Int16.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.types; - -typedef Int16 = java.StdTypes.Int16; diff --git a/std/java/types/Int8.hx b/std/java/types/Int8.hx deleted file mode 100644 index baccb6c9629..00000000000 --- a/std/java/types/Int8.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.types; - -typedef Int8 = java.StdTypes.Int8; diff --git a/std/java/vm/AtomicList.hx b/std/java/vm/AtomicList.hx deleted file mode 100644 index f61dc279338..00000000000 --- a/std/java/vm/AtomicList.hx +++ /dev/null @@ -1,83 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -import java.util.concurrent.atomic.AtomicReference; - -/** - A lock-free queue implementation -**/ -@:native('haxe.java.vm.AtomicList') -@:nativeGen class AtomicList { - @:volatile @:private var head:AtomicNode; - @:volatile @:private var tail:AtomicReference>; - - public function new() { - this.head = new AtomicNode(null); - this.head.set(new AtomicNode(null)); - this.tail = new AtomicReference(head); - } - - public function add(v:T) { - var n = new AtomicNode(v), tail = this.tail; - var p = null; - while (!((p = tail.get()).compareAndSet(null, n))) { - tail.compareAndSet(p, p.get()); - } - tail.compareAndSet(p, n); - } - - public function pop():Null { - var p = null, pget = null, head = head; - do { - p = head.get(); - if ((pget = p.get()) == null) - return null; // empty - } while (!head.compareAndSet(p, pget)); - - var ret = pget.value; - pget.value = null; - return ret; - } - - public function peek() { - var ret = head.get(); - if (ret == null) - return null; // empty - return ret.value; - } - - public function peekLast() { - return tail.get().value; - } -} - -@:native('haxe.java.vm.AtomicNode') -@:nativeGen class AtomicNode extends AtomicReference> { - public var value:T; - - public function new(value) { - super(); - this.value = value; - } -} diff --git a/std/java/vm/Deque.hx b/std/java/vm/Deque.hx deleted file mode 100644 index 004c27e5b45..00000000000 --- a/std/java/vm/Deque.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -@:deprecated typedef Deque = sys.thread.Deque; diff --git a/std/java/vm/Lock.hx b/std/java/vm/Lock.hx deleted file mode 100644 index 65286ff7a72..00000000000 --- a/std/java/vm/Lock.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -@:deprecated typedef Lock = sys.thread.Lock; diff --git a/std/java/vm/Mutex.hx b/std/java/vm/Mutex.hx deleted file mode 100644 index ae0900cff3c..00000000000 --- a/std/java/vm/Mutex.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -@:deprecated typedef Mutex = sys.thread.Mutex; diff --git a/std/java/vm/Thread.hx b/std/java/vm/Thread.hx deleted file mode 100644 index e1a1dcc9543..00000000000 --- a/std/java/vm/Thread.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -@:deprecated typedef Thread = sys.thread.Thread; diff --git a/std/java/vm/Tls.hx b/std/java/vm/Tls.hx deleted file mode 100644 index 2bb6f1bc004..00000000000 --- a/std/java/vm/Tls.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java.vm; - -@:deprecated typedef Tls = sys.thread.Tls; diff --git a/std/js/Syntax.hx b/std/js/Syntax.hx index efa6d6c2651..42d6386aefe 100644 --- a/std/js/Syntax.hx +++ b/std/js/Syntax.hx @@ -71,12 +71,12 @@ extern class Syntax { @:pure static function typeof(o:Dynamic):String; /** - Genearte `a === b` expression. + Generate `a === b` expression. **/ @:pure static function strictEq(a:Dynamic, b:Dynamic):Bool; /** - Genearte `a !== b` expression. + Generate `a !== b` expression. **/ @:pure static function strictNeq(a:Dynamic, b:Dynamic):Bool; diff --git a/std/js/html/URL.hx b/std/js/html/URL.hx index a1dcd8e4519..19b686ecd1b 100644 --- a/std/js/html/URL.hx +++ b/std/js/html/URL.hx @@ -24,6 +24,8 @@ package js.html; +import haxe.extern.EitherType; + /** The URL interface represents an object providing static methods used for creating object URLs. @@ -36,9 +38,20 @@ extern class URL { /** @throws DOMError */ @:overload( function( blob : Blob ) : String {} ) static function createObjectURL( source : MediaSource ) : String; + /** @throws DOMError */ static function revokeObjectURL( url : String ) : Void; - + + /** + Returns a boolean indicating whether or not an absolute URL, or a relative URL combined with a base URL, are parsable and valid. + **/ + static function canParse( url : String, ?base : EitherType ) : Bool; + + /** + Returns a newly created `URL` object representing the URL defined by the parameters. + **/ + static function parse( url : String, ?base : EitherType ): Null; + /** Is a `DOMString` containing the whole URL. **/ @@ -100,6 +113,15 @@ extern class URL { var hash : String; /** @throws DOMError */ - function new( url : String, ?base : String ) : Void; + function new( url : String, ?base : EitherType ); + + /** + Returns a JSON representation of this URL. + **/ function toJSON() : String; -} \ No newline at end of file + + /** + Returns a string representation of this URL. + **/ + function toString() : String; +} diff --git a/std/js/lib/intl/PluralRules.hx b/std/js/lib/intl/PluralRules.hx index 6c0292d1f8d..6b13bae1bfe 100644 --- a/std/js/lib/intl/PluralRules.hx +++ b/std/js/lib/intl/PluralRules.hx @@ -39,7 +39,7 @@ extern class PluralRules { @:pure function resolvedOptions():PluralRulesResolvedOptions; /** - Returns a String indicating which plurar rule to use for locale-aware formatting. + Returns a String indicating which plural rule to use for locale-aware formatting. **/ @:pure function select(number:Int):String; @@ -105,12 +105,12 @@ typedef PluralRulesResolvedOptions = { enum abstract PluralRulesType(String) { /** - For cardinal numbers (refering to the quantity of things). + For cardinal numbers (referring to the quantity of things). */ var Cardinal = "cardinal"; /** - For ordinal number (refering to the ordering or ranking of things, e.g. "1st", "2nd", "3rd" in English). + For ordinal number (referring to the ordering or ranking of things, e.g. "1st", "2nd", "3rd" in English). */ var Ordinal = "ordinal"; } diff --git a/std/jvm/Char16.hx b/std/jvm/Char16.hx new file mode 100644 index 00000000000..03055f9dc61 --- /dev/null +++ b/std/jvm/Char16.hx @@ -0,0 +1,3 @@ +package jvm; + +@:notNull @:runtimeValue @:coreType extern abstract Char16 from Int {} \ No newline at end of file diff --git a/std/jvm/Function.hx b/std/jvm/Function.hx index 24a8762efc2..bfd85ecb0b5 100644 --- a/std/jvm/Function.hx +++ b/std/jvm/Function.hx @@ -1,6 +1,6 @@ package jvm; -import java.NativeArray; +import jvm.NativeArray; @:native("haxe.jvm.Function") @:nativeGen diff --git a/std/jvm/Int16.hx b/std/jvm/Int16.hx new file mode 100644 index 00000000000..7c4cbd1ae1c --- /dev/null +++ b/std/jvm/Int16.hx @@ -0,0 +1,3 @@ +package jvm; + +@:notNull @:runtimeValue @:coreType extern abstract Int16 from Int {} \ No newline at end of file diff --git a/std/java/StdTypes.hx b/std/jvm/Int64.hx similarity index 62% rename from std/java/StdTypes.hx rename to std/jvm/Int64.hx index 060571b9de0..7e5d37e2465 100644 --- a/std/java/StdTypes.hx +++ b/std/jvm/Int64.hx @@ -1,30 +1,4 @@ -/* - * Copyright (C)2005-2019 Haxe Foundation - * - * Permission is hereby granted, free of charge, to any person obtaining a - * copy of this software and associated documentation files (the "Software"), - * to deal in the Software without restriction, including without limitation - * the rights to use, copy, modify, merge, publish, distribute, sublicense, - * and/or sell copies of the Software, and to permit persons to whom the - * Software is furnished to do so, subject to the following conditions: - * - * The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER - * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING - * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER - * DEALINGS IN THE SOFTWARE. - */ - -package java; - -@:notNull @:runtimeValue @:coreType extern abstract Int8 from Int {} -@:notNull @:runtimeValue @:coreType extern abstract Int16 from Int {} -@:notNull @:runtimeValue @:coreType extern abstract Char16 from Int {} +package jvm; @:notNull @:runtimeValue @:coreType extern abstract Int64 from Int from Float { @:op(A + B) public static function addI(lhs:Int64, rhs:Int):Int64; diff --git a/std/jvm/Int8.hx b/std/jvm/Int8.hx new file mode 100644 index 00000000000..2a9c51819f9 --- /dev/null +++ b/std/jvm/Int8.hx @@ -0,0 +1,3 @@ +package jvm; + +@:notNull @:runtimeValue @:coreType extern abstract Int8 from Int {} \ No newline at end of file diff --git a/std/jvm/Jvm.hx b/std/jvm/Jvm.hx index c643587d6aa..dc2a484aac3 100644 --- a/std/jvm/Jvm.hx +++ b/std/jvm/Jvm.hx @@ -27,11 +27,10 @@ import haxe.Constraints; import haxe.ds.Option; import haxe.ds.Vector; import haxe.extern.Rest; -import java.Init; -import java.NativeArray; import java.lang.NullPointerException; import jvm.DynamicObject; import jvm.EmptyConstructor; +import jvm.NativeArray; import jvm.Object; import jvm.annotation.ClassReflectionInformation; import jvm.annotation.EnumReflectionInformation; @@ -40,6 +39,20 @@ import jvm.annotation.EnumValueReflectionInformation; @:keep @:native('haxe.jvm.Jvm') class Jvm { + public static function init():Void { + #if std_encoding_utf8 + try { + java.lang.System.setOut(new java.io.PrintStream(java.lang.System.out, true, "utf-8")); + java.lang.System.setErr(new java.io.PrintStream(java.lang.System.err, true, "utf-8")); + } catch (e:java.io.UnsupportedEncodingException) {} + #end + } + + static public function getNativeType(obj:T):java.lang.Class { + var obj:java.lang.Object = (cast obj : java.lang.Object); + return cast obj.getClass(); + } + extern static public function instanceof(obj:S, type:T):Bool; extern static public function referenceEquals(v1:T, v2:T):Bool; @@ -137,7 +150,7 @@ class Jvm { } continue; }; - var argType = (argValue : java.lang.Object).getClass(); + var argType = getNativeType(argValue); var arg = getWrapperClass(paramType); if (arg.isAssignableFrom(argType)) { callArgs[i] = args[i]; @@ -290,7 +303,7 @@ class Jvm { } static public function readFieldClosure(obj:Dynamic, name:String, parameterTypes:NativeArray>):Dynamic { - var cl = (obj : java.lang.Object).getClass(); + var cl = getNativeType(obj); var method = cl.getMethod(name, ...parameterTypes); if (method.isBridge()) { /* This is probably not what we want... go through all methods and see if we find one that @@ -323,7 +336,7 @@ class Jvm { } static public function readFieldNoObject(obj:Dynamic, name:String):Dynamic { - var cl = (obj : java.lang.Object).getClass(); + var cl = getNativeType(obj); try { var field = cl.getField(name); field.setAccessible(true); @@ -388,7 +401,7 @@ class Jvm { static public function writeFieldNoObject(obj:Dynamic, name:String, value:T) { try { - var cl = (obj : java.lang.Object).getClass(); + var cl = getNativeType(obj); var field = cl.getField(name); field.setAccessible(true); try { @@ -614,4 +627,8 @@ class Jvm { } throw "Invalid operation"; } + + extern public static inline function lock(obj:Dynamic, block:T):Void { + untyped __lock__(obj, block); + } } diff --git a/std/java/vm/Gc.hx b/std/jvm/NativeArray.hx similarity index 59% rename from std/java/vm/Gc.hx rename to std/jvm/NativeArray.hx index 11423660f8c..a8c1fe0dfc0 100644 --- a/std/java/vm/Gc.hx +++ b/std/jvm/NativeArray.hx @@ -20,15 +20,47 @@ * DEALINGS IN THE SOFTWARE. */ -package java.vm; +package jvm; -@:native('haxe.java.vm.Gc') class Gc { - public static function run(major:Bool) { - java.lang.System.gc(); +import haxe.extern.Rest; + +/** + Represents a java fixed-size Array (`T[]`) +**/ +@:nativeGen extern class NativeArray implements ArrayAccess { + /** + Creates a new array with the specified elements. + + Usage: + ```haxe + var elements = NativeArray.make(1,2,3,4,5,6); + ``` + **/ + static function make(elements:Rest):NativeArray; + + static inline function ofArray(arr:Array) { + var ret = new NativeArray(arr.length); + for (i in 0...arr.length) { + ret[i] = arr[i]; + } + return ret; } - public static function stats():{heap:Int, free:Int} { - var r = java.lang.Runtime.getRuntime(); - return {heap: cast r.totalMemory(), free: cast r.freeMemory()}; + inline function toArray() { + var a = []; + for (i in 0...length) { + a[i] = this[i]; + } + return a; } + + /** + The length of the array + **/ + var length(default, null):Int; + + /** + Allocates a new array with size `len` + **/ + function new(len:Int):Void; } diff --git a/std/jvm/NativeString.hx b/std/jvm/NativeString.hx new file mode 100644 index 00000000000..dbd1d508e95 --- /dev/null +++ b/std/jvm/NativeString.hx @@ -0,0 +1,99 @@ +/* + * Copyright (C)2005-2019 Haxe Foundation + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + */ + +package jvm; + +import haxe.Int64; +import haxe.extern.Rest; +import java.lang.CharSequence; +import java.util.Locale; +import jvm.Char16; +import jvm.Int8; + +@:native("java.lang.String") +extern class NativeString { + function charAt(index:Int):Char16; + function codePointAt(index:Int):Int; + function codePointBefore(index:Int):Int; + function codePointCount(beginIndex:Int, endIndex:Int):Int; + function compareTo(anotherString:String):Int; + function compareToIgnoreCase(str:String):Int; + function concat(str:String):String; + function contains(s:CharSequence):Bool; + @:overload function contentEquals(cs:CharSequence):Bool; + @:overload function contentEquals(sb:java.lang.StringBuffer):Bool; + @:overload static function copyValueOf(data:NativeArray):String; + @:overload static function copyValueOf(data:NativeArray, offset:Int, count:Int):String; + function endsWith(suffix:String):Bool; + function equals(anObject:Dynamic):Bool; + function equalsIgnoreCase(anotherString:String):Bool; + @:overload static function format(l:Locale, format:String, args:Rest):String; + @:overload static function format(format:String, args:Rest):String; + @:overload function getBytes():NativeArray; + @:overload function getBytes(charset:java.nio.charset.Charset):NativeArray; + @:deprecated @:overload function getBytes(srcBegin:Int, srcEnd:Int, dst:NativeArray, dstBegin:Int):Void; + @:overload function getBytes(charsetName:String):NativeArray; + function getChars(srcBegin:Int, srcEnd:Int, dst:NativeArray, dstBegin:Int):Void; + function hashCode():Int; + @:overload function indexOf(ch:Int):Int; + @:overload function indexOf(ch:Int, fromIndex:Int):Int; + @:overload function indexOf(str:String):Int; + @:overload function indexOf(str:String, fromIndex:Int):Int; + function intern():String; + function isEmpty():Bool; + @:overload function lastIndexOf(ch:Int):Int; + @:overload function lastIndexOf(ch:Int, fromIndex:Int):Int; + @:overload function lastIndexOf(str:String):Int; + @:overload function lastIndexOf(str:String, fromIndex:Int):Int; + function length():Int; + function matches(regex:String):Bool; + function offsetByCodePoints(index:Int, codePointOffset:Int):Int; + @:overload function regionMatches(ignoreCase:Bool, toffset:Int, other:String, ooffset:Int, len:Int):Bool; + @:overload function regionMatches(toffset:Int, other:String, ooffset:Int, len:Int):Bool; + @:overload function replace(oldChar:Char16, newChar:Char16):String; + @:overload function replace(target:CharSequence, replacement:CharSequence):String; + function replaceAll(regex:String, replacement:String):String; + function replaceFirst(regex:String, replacement:String):String; + @:overload function split(regex:String):NativeArray; + @:overload function split(regex:String, limit:Int):NativeArray; + @:overload function startsWith(prefix:String):Bool; + @:overload function startsWith(prefix:String, toffset:Int):Bool; + function subSequence(beginIndex:Int, endIndex:Int):CharSequence; + @:overload function substring(beginIndex:Int):String; + @:overload function substring(beginIndex:Int, endIndex:Int):String; + function toCharArray():NativeArray; + @:overload function toLowerCase():String; + @:overload function toLowerCase(locale:Locale):String; + function toString():String; + @:overload function toUpperCase():String; + @:overload function toUpperCase(locale:Locale):String; + function trim():String; + @:overload static function valueOf(b:Bool):String; + @:overload static function valueOf(c:Char16):String; + @:overload static function valueOf(data:NativeArray):String; + @:overload static function valueOf(data:NativeArray, offset:Int, count:Int):String; + @:overload static function valueOf(d:Float):String; + @:overload static function valueOf(f:String):String; + @:overload static function valueOf(i:Int):String; + @:overload static function valueOf(l:haxe.Int64):String; + @:overload static function valueOf(obj:java.lang.Object):String; +} diff --git a/std/java/_std/Array.hx b/std/jvm/_std/Array.hx similarity index 94% rename from std/java/_std/Array.hx rename to std/jvm/_std/Array.hx index 463d55d6384..cb2ab891999 100644 --- a/std/java/_std/Array.hx +++ b/std/jvm/_std/Array.hx @@ -20,17 +20,10 @@ * DEALINGS IN THE SOFTWARE. */ -import java.lang.System; -import java.NativeArray; import haxe.iterators.ArrayKeyValueIterator; +import java.NativeArray; +import java.lang.System; -@:classCode(' - public Array(T[] _native) - { - this.__a = _native; - this.length = _native.length; - } -') @:coreApi final class Array implements ArrayAccess { public var length(default, null):Int; @@ -39,9 +32,6 @@ import haxe.iterators.ArrayKeyValueIterator; @:skipReflection static var __hx_toString_depth = 0; @:skipReflection static inline final __hx_defaultCapacity = 4; - @:functionCode(' - return new Array(_native); - ') private static function ofNative(native:NativeArray):Array { var a = new Array(); a.length = native.length; @@ -49,9 +39,6 @@ import haxe.iterators.ArrayKeyValueIterator; return a; } - @:functionCode(' - return new Array((Y[]) ((java.lang.Object)new java.lang.Object[size])); - ') private static function alloc(size:Int):Array { var a = new Array(); a.length = size; @@ -59,13 +46,11 @@ import haxe.iterators.ArrayKeyValueIterator; return a; } - #if jvm function getNative():NativeArray { var a = new NativeArray(length); System.arraycopy(__a, 0, a, 0, length); return a; } - #end public function new():Void { this.length = 0; @@ -386,7 +371,7 @@ import haxe.iterators.ArrayKeyValueIterator; } return false; } - + public function indexOf(x:T, ?fromIndex:Int):Int { var len = length, a = __a, i:Int = (fromIndex == null) ? 0 : fromIndex; if (i < 0) { @@ -403,9 +388,7 @@ import haxe.iterators.ArrayKeyValueIterator; } public function lastIndexOf(x:T, ?fromIndex:Int):Int { - var len = length, - a = __a, - i:Int = (fromIndex == null) ? len - 1 : fromIndex; + var len = length, a = __a, i:Int = (fromIndex == null) ? len - 1 : fromIndex; if (i >= len) i = len - 1; else if (i < 0) @@ -430,7 +413,7 @@ import haxe.iterators.ArrayKeyValueIterator; return new haxe.iterators.ArrayIterator(this); } - public inline function keyValueIterator() : ArrayKeyValueIterator { + public inline function keyValueIterator():ArrayKeyValueIterator { return new ArrayKeyValueIterator(this); } @@ -473,8 +456,7 @@ import haxe.iterators.ArrayKeyValueIterator; return __a[idx]; } - private function __set(idx:Int, v:T):#if jvm Void #else T #end - { + private function __set(idx:Int, v:T):Void { var __a = __a; if (idx >= __a.length) { var newl = idx + 1; @@ -489,7 +471,7 @@ import haxe.iterators.ArrayKeyValueIterator; if (idx >= length) this.length = idx + 1; - #if !jvm return #end __a[idx] = v; + __a[idx] = v; } private inline function __unsafe_get(idx:Int):T { @@ -499,4 +481,4 @@ import haxe.iterators.ArrayKeyValueIterator; private inline function __unsafe_set(idx:Int, val:T):T { return __a[idx] = val; } -} \ No newline at end of file +} diff --git a/std/java/_std/Date.hx b/std/jvm/_std/Date.hx similarity index 100% rename from std/java/_std/Date.hx rename to std/jvm/_std/Date.hx diff --git a/std/java/_std/Math.hx b/std/jvm/_std/Math.hx similarity index 100% rename from std/java/_std/Math.hx rename to std/jvm/_std/Math.hx diff --git a/std/jvm/_std/String.hx b/std/jvm/_std/String.hx index 05ec6dddf68..5ad40632939 100644 --- a/std/jvm/_std/String.hx +++ b/std/jvm/_std/String.hx @@ -26,8 +26,8 @@ extern class String implements java.lang.CharSequence { @:overload(function(b:haxe.io.BytesData, offset:Int, length:Int, charsetName:String):Void {}) @:overload(function(b:haxe.io.BytesData, offset:Int, length:Int):Void {}) - @:overload(function(b:java.NativeArray):Void {}) - @:overload(function(b:java.NativeArray, offset:Int, count:Int):Void {}) + @:overload(function(b:jvm.NativeArray):Void {}) + @:overload(function(b:jvm.NativeArray, offset:Int, count:Int):Void {}) function new(string:String):Void; function toUpperCase():String; diff --git a/std/jvm/_std/StringBuf.hx b/std/jvm/_std/StringBuf.hx index 95140ace703..b19c117fe96 100644 --- a/std/jvm/_std/StringBuf.hx +++ b/std/jvm/_std/StringBuf.hx @@ -51,7 +51,7 @@ class StringBuf { @:overload @:native("add") @:ifFeature("StringBuf.add") - function addOpt(v:java.types.Char16):Void { + function addOpt(v:jvm.Char16):Void { b.append(v); } diff --git a/std/java/_std/Sys.hx b/std/jvm/_std/Sys.hx similarity index 94% rename from std/java/_std/Sys.hx rename to std/jvm/_std/Sys.hx index d4f0bb58657..bce88cd1022 100644 --- a/std/java/_std/Sys.hx +++ b/std/jvm/_std/Sys.hx @@ -26,6 +26,7 @@ import java.nio.file.Paths; import sys.io.Process; using haxe.Int64; +using jvm.NativeTools; @:coreApi class Sys { private static var _args:java.NativeArray; @@ -43,7 +44,7 @@ using haxe.Int64; public static function args():Array { if (_args == null) return []; - return java.Lib.array(_args); + return @:privateAccess Array.ofNative(_args); } public static function getEnv(s:String):String { @@ -142,7 +143,7 @@ using haxe.Int64; } public static function programPath():String { - final uri:URI = java.Lib.toNativeType(Sys).getProtectionDomain().getCodeSource().getLocation().toURI(); + final uri:URI = Sys.native().getProtectionDomain().getCodeSource().getLocation().toURI(); return Std.string(Paths.get(uri)); } @@ -153,14 +154,14 @@ using haxe.Int64; public static function stdin():haxe.io.Input { var _in:java.io.InputStream = Reflect.field(System, "in"); - return new java.io.NativeInput(_in); + return new jvm.io.NativeInput(_in); } public static function stdout():haxe.io.Output { - return new java.io.NativeOutput(System.out); + return new jvm.io.NativeOutput(System.out); } public static function stderr():haxe.io.Output { - return new java.io.NativeOutput(System.err); + return new jvm.io.NativeOutput(System.err); } } diff --git a/std/java/_std/haxe/Exception.hx b/std/jvm/_std/haxe/Exception.hx similarity index 100% rename from std/java/_std/haxe/Exception.hx rename to std/jvm/_std/haxe/Exception.hx diff --git a/std/java/_std/haxe/Int64.hx b/std/jvm/_std/haxe/Int64.hx similarity index 98% rename from std/java/_std/haxe/Int64.hx rename to std/jvm/_std/haxe/Int64.hx index 9078fc4c52b..c9d2154945e 100644 --- a/std/java/_std/haxe/Int64.hx +++ b/std/jvm/_std/haxe/Int64.hx @@ -22,11 +22,11 @@ package haxe; -using haxe.Int64; - import haxe.Int64Helper; -private typedef __Int64 = java.StdTypes.Int64; +using haxe.Int64; + +private typedef __Int64 = jvm.Int64; @:coreApi @:transitive @@ -129,14 +129,16 @@ abstract Int64(__Int64) from __Int64 to __Int64 { return ++this; @:op(A++) private inline function postIncrement():Int64 - return this++; + return this + ++; @:op(--A) private inline function preDecrement():Int64 return --this; @:op(A--) private inline function postDecrement():Int64 - return this--; + return this + --; @:op(A + B) public static inline function add(a:Int64, b:Int64):Int64 return a.val + b.val; diff --git a/std/java/_std/haxe/NativeStackTrace.hx b/std/jvm/_std/haxe/NativeStackTrace.hx similarity index 100% rename from std/java/_std/haxe/NativeStackTrace.hx rename to std/jvm/_std/haxe/NativeStackTrace.hx diff --git a/std/java/_std/haxe/Resource.hx b/std/jvm/_std/haxe/Resource.hx similarity index 95% rename from std/java/_std/haxe/Resource.hx rename to std/jvm/_std/haxe/Resource.hx index 525e84aaea9..1b965c6e0ba 100644 --- a/std/java/_std/haxe/Resource.hx +++ b/std/jvm/_std/haxe/Resource.hx @@ -35,7 +35,7 @@ package haxe; var stream = cast(Resource, java.lang.Class).getResourceAsStream("/" + name); if (stream == null) return null; - var stream = new java.io.NativeInput(stream); + var stream = new jvm.io.NativeInput(stream); return stream.readAll().toString(); } @@ -45,7 +45,7 @@ package haxe; var stream = cast(Resource, java.lang.Class).getResourceAsStream("/" + name); if (stream == null) return null; - var stream = new java.io.NativeInput(stream); + var stream = new jvm.io.NativeInput(stream); return stream.readAll(); } } diff --git a/std/jvm/_std/haxe/Rest.hx b/std/jvm/_std/haxe/Rest.hx index f0d6788a933..60dd2f73421 100644 --- a/std/jvm/_std/haxe/Rest.hx +++ b/std/jvm/_std/haxe/Rest.hx @@ -28,7 +28,7 @@ abstract Rest(NativeRest) { } @:noDoc - @:from extern inline static function fromNative(a:java.NativeArray):Rest { + @:from extern inline static function fromNative(a:jvm.NativeArray):Rest { return new Rest(Vector.fromData(a)); } diff --git a/std/java/_std/haxe/atomic/AtomicBool.hx b/std/jvm/_std/haxe/atomic/AtomicBool.hx similarity index 100% rename from std/java/_std/haxe/atomic/AtomicBool.hx rename to std/jvm/_std/haxe/atomic/AtomicBool.hx diff --git a/std/java/_std/haxe/atomic/AtomicInt.hx b/std/jvm/_std/haxe/atomic/AtomicInt.hx similarity index 100% rename from std/java/_std/haxe/atomic/AtomicInt.hx rename to std/jvm/_std/haxe/atomic/AtomicInt.hx diff --git a/std/java/_std/haxe/atomic/AtomicObject.hx b/std/jvm/_std/haxe/atomic/AtomicObject.hx similarity index 100% rename from std/java/_std/haxe/atomic/AtomicObject.hx rename to std/jvm/_std/haxe/atomic/AtomicObject.hx diff --git a/std/java/_std/haxe/crypto/Md5.hx b/std/jvm/_std/haxe/crypto/Md5.hx similarity index 100% rename from std/java/_std/haxe/crypto/Md5.hx rename to std/jvm/_std/haxe/crypto/Md5.hx diff --git a/std/java/_std/haxe/crypto/Sha1.hx b/std/jvm/_std/haxe/crypto/Sha1.hx similarity index 100% rename from std/java/_std/haxe/crypto/Sha1.hx rename to std/jvm/_std/haxe/crypto/Sha1.hx diff --git a/std/java/_std/haxe/crypto/Sha256.hx b/std/jvm/_std/haxe/crypto/Sha256.hx similarity index 100% rename from std/java/_std/haxe/crypto/Sha256.hx rename to std/jvm/_std/haxe/crypto/Sha256.hx diff --git a/std/java/_std/haxe/ds/ObjectMap.hx b/std/jvm/_std/haxe/ds/ObjectMap.hx similarity index 100% rename from std/java/_std/haxe/ds/ObjectMap.hx rename to std/jvm/_std/haxe/ds/ObjectMap.hx diff --git a/std/java/_std/haxe/ds/WeakMap.hx b/std/jvm/_std/haxe/ds/WeakMap.hx similarity index 100% rename from std/java/_std/haxe/ds/WeakMap.hx rename to std/jvm/_std/haxe/ds/WeakMap.hx diff --git a/std/java/_std/haxe/zip/Compress.hx b/std/jvm/_std/haxe/zip/Compress.hx similarity index 100% rename from std/java/_std/haxe/zip/Compress.hx rename to std/jvm/_std/haxe/zip/Compress.hx diff --git a/std/java/_std/haxe/zip/Uncompress.hx b/std/jvm/_std/haxe/zip/Uncompress.hx similarity index 100% rename from std/java/_std/haxe/zip/Uncompress.hx rename to std/jvm/_std/haxe/zip/Uncompress.hx diff --git a/std/java/_std/sys/FileSystem.hx b/std/jvm/_std/sys/FileSystem.hx similarity index 98% rename from std/java/_std/sys/FileSystem.hx rename to std/jvm/_std/sys/FileSystem.hx index 2635b4411a3..2811e52d44d 100644 --- a/std/java/_std/sys/FileSystem.hx +++ b/std/jvm/_std/sys/FileSystem.hx @@ -23,7 +23,6 @@ package sys; import java.io.File; -import java.Lib; @:coreApi class FileSystem { @@ -59,9 +58,7 @@ class FileSystem { size: cast(attributes.get("size"), Int), uid: attributes.get("uid"), }; - } - - catch (e) { + } catch (e) { return { gid: 0, // java doesn't let you get this info uid: 0, // same @@ -119,6 +116,6 @@ class FileSystem { var f = new File(path); if (!f.exists()) throw "Path " + path + " doesn't exist"; - return Lib.array(f.list()); + return @:privateAccess Array.ofNative(f.list()); } } diff --git a/std/java/_std/sys/io/File.hx b/std/jvm/_std/sys/io/File.hx similarity index 100% rename from std/java/_std/sys/io/File.hx rename to std/jvm/_std/sys/io/File.hx diff --git a/std/java/_std/sys/io/FileInput.hx b/std/jvm/_std/sys/io/FileInput.hx similarity index 100% rename from std/java/_std/sys/io/FileInput.hx rename to std/jvm/_std/sys/io/FileInput.hx diff --git a/std/java/_std/sys/io/FileOutput.hx b/std/jvm/_std/sys/io/FileOutput.hx similarity index 100% rename from std/java/_std/sys/io/FileOutput.hx rename to std/jvm/_std/sys/io/FileOutput.hx diff --git a/std/java/_std/sys/io/Process.hx b/std/jvm/_std/sys/io/Process.hx similarity index 97% rename from std/java/_std/sys/io/Process.hx rename to std/jvm/_std/sys/io/Process.hx index aa2584253c3..98da22c0cf4 100644 --- a/std/java/_std/sys/io/Process.hx +++ b/std/jvm/_std/sys/io/Process.hx @@ -26,9 +26,9 @@ import haxe.SysTools; import haxe.io.Bytes; import haxe.io.BytesInput; import haxe.io.Eof; -import java.io.IOException; -import java.io.EOFException; import java.NativeArray; +import java.io.EOFException; +import java.io.IOException; @:coreApi class Process { @@ -84,7 +84,7 @@ class Process { var p = proc = createProcessBuilder(cmd, args).start(); stderr = new ProcessInput(p.getErrorStream()); stdout = new ProcessInput(p.getInputStream()); - stdin = new java.io.NativeOutput(p.getOutputStream()); + stdin = new jvm.io.NativeOutput(p.getOutputStream()); } public function getPid():Int { @@ -121,7 +121,7 @@ class Process { } } -private class ProcessInput extends java.io.NativeInput { +private class ProcessInput extends jvm.io.NativeInput { private var chained:BytesInput; public function bufferContents():Void { @@ -153,7 +153,6 @@ private class ProcessInput extends java.io.NativeInput { try { ret = stream.read(s.getData(), pos, len); } catch (e:EOFException) { - throw new Eof(); } catch (e:IOException) { throw haxe.io.Error.Custom(e); diff --git a/std/java/_std/sys/net/Host.hx b/std/jvm/_std/sys/net/Host.hx similarity index 100% rename from std/java/_std/sys/net/Host.hx rename to std/jvm/_std/sys/net/Host.hx diff --git a/std/java/_std/sys/net/Socket.hx b/std/jvm/_std/sys/net/Socket.hx similarity index 94% rename from std/java/_std/sys/net/Socket.hx rename to std/jvm/_std/sys/net/Socket.hx index 90b9d77021e..23e2a2f89d1 100644 --- a/std/java/_std/sys/net/Socket.hx +++ b/std/jvm/_std/sys/net/Socket.hx @@ -68,8 +68,8 @@ class Socket { public function connect(host:Host, port:Int):Void { try { sock.connect(new InetSocketAddress(host.wrapped, port)); - this.output = new java.io.NativeOutput(sock.getOutputStream()); - this.input = new java.io.NativeInput(sock.getInputStream()); + this.output = new jvm.io.NativeOutput(sock.getOutputStream()); + this.input = new jvm.io.NativeInput(sock.getInputStream()); } catch (e:Dynamic) throw e; } @@ -106,8 +106,8 @@ class Socket { var s = new Socket(); s.sock = ret; - s.output = new java.io.NativeOutput(ret.getOutputStream()); - s.input = new java.io.NativeInput(ret.getInputStream()); + s.output = new jvm.io.NativeOutput(ret.getOutputStream()); + s.input = new jvm.io.NativeInput(ret.getInputStream()); return s; } diff --git a/std/java/_std/sys/thread/Condition.hx b/std/jvm/_std/sys/thread/Condition.hx similarity index 100% rename from std/java/_std/sys/thread/Condition.hx rename to std/jvm/_std/sys/thread/Condition.hx diff --git a/std/java/_std/sys/thread/Deque.hx b/std/jvm/_std/sys/thread/Deque.hx similarity index 98% rename from std/java/_std/sys/thread/Deque.hx rename to std/jvm/_std/sys/thread/Deque.hx index dc7b0fdbefe..ab5254cd54a 100644 --- a/std/java/_std/sys/thread/Deque.hx +++ b/std/jvm/_std/sys/thread/Deque.hx @@ -22,8 +22,6 @@ package sys.thread; -import java.Lib; - @:coreApi @:native('haxe.java.vm.Deque') @:nativeGen class Deque { diff --git a/std/java/_std/sys/thread/Mutex.hx b/std/jvm/_std/sys/thread/Mutex.hx similarity index 100% rename from std/java/_std/sys/thread/Mutex.hx rename to std/jvm/_std/sys/thread/Mutex.hx diff --git a/std/java/_std/sys/thread/Semaphore.hx b/std/jvm/_std/sys/thread/Semaphore.hx similarity index 100% rename from std/java/_std/sys/thread/Semaphore.hx rename to std/jvm/_std/sys/thread/Semaphore.hx diff --git a/std/java/_std/sys/thread/Thread.hx b/std/jvm/_std/sys/thread/Thread.hx similarity index 76% rename from std/java/_std/sys/thread/Thread.hx rename to std/jvm/_std/sys/thread/Thread.hx index e76717b6045..3412dd79805 100644 --- a/std/java/_std/sys/thread/Thread.hx +++ b/std/jvm/_std/sys/thread/Thread.hx @@ -22,26 +22,25 @@ package sys.thread; -import java.Lib; import java.lang.Runnable; -import java.util.WeakHashMap; -import java.util.Collections; -import java.lang.Thread as JavaThread; import java.lang.System; -import java.StdTypes.Int64 as Long; -import java.util.concurrent.atomic.AtomicInteger; +import java.lang.Thread as JavaThread; +import java.util.Collections; +import java.util.WeakHashMap; import java.util.concurrent.LinkedBlockingDeque; +import java.util.concurrent.atomic.AtomicInteger; +import jvm.Int64 as Long; private typedef ThreadImpl = HaxeThread; abstract Thread(ThreadImpl) from ThreadImpl { - public var events(get,never):EventLoop; + public var events(get, never):EventLoop; inline function new(t:HaxeThread) { this = t; } - public static inline function create(job:()->Void):Thread { + public static inline function create(job:() -> Void):Thread { return HaxeThread.create(job, false); } @@ -49,11 +48,11 @@ abstract Thread(ThreadImpl) from ThreadImpl { return HaxeThread.get(JavaThread.currentThread()); } - public static inline function runWithEventLoop(job:()->Void):Void { + public static inline function runWithEventLoop(job:() -> Void):Void { HaxeThread.runWithEventLoop(job); } - public static inline function createWithEventLoop(job:()->Void):Thread { + public static inline function createWithEventLoop(job:() -> Void):Thread { return HaxeThread.create(job, true); } @@ -70,24 +69,24 @@ abstract Thread(ThreadImpl) from ThreadImpl { } function get_events():EventLoop { - if(this.events == null) + if (this.events == null) throw new NoEventLoopException(); return this.events; } - @:keep //TODO: keep only if events are actually used + @:keep // TODO: keep only if events are actually used static function processEvents():Void { current().getHandle().events.loop(); } } private class HaxeThread { - static var nativeThreads:java.util.Map; + static var nativeThreads:java.util.Map; static var mainJavaThread:JavaThread; static var mainHaxeThread:HaxeThread; static function __init__() { - nativeThreads = Collections.synchronizedMap(new WeakHashMap()); + nativeThreads = Collections.synchronizedMap(new WeakHashMap()); mainJavaThread = JavaThread.currentThread(); mainHaxeThread = new HaxeThread(); mainHaxeThread.events = new EventLoop(); @@ -95,11 +94,11 @@ private class HaxeThread { public final messages = new LinkedBlockingDeque(); - public var events(default,null):Null; + public var events(default, null):Null; - public static function create(job:()->Void, withEventLoop:Bool):HaxeThread { + public static function create(job:() -> Void, withEventLoop:Bool):HaxeThread { var hx = new HaxeThread(); - if(withEventLoop) + if (withEventLoop) hx.events = new EventLoop(); var thread = new NativeHaxeThread(hx, job, withEventLoop); thread.setDaemon(true); @@ -108,10 +107,10 @@ private class HaxeThread { } public static function get(javaThread:JavaThread):HaxeThread { - if(javaThread == mainJavaThread) { + if (javaThread == mainJavaThread) { return mainHaxeThread; - } else if(javaThread is NativeHaxeThread) { - return (cast javaThread:NativeHaxeThread).haxeThread; + } else if (javaThread is NativeHaxeThread) { + return (cast javaThread : NativeHaxeThread).haxeThread; } else { switch nativeThreads.get(javaThread) { case null: @@ -124,15 +123,15 @@ private class HaxeThread { } } - public static function runWithEventLoop(job:()->Void):Void { + public static function runWithEventLoop(job:() -> Void):Void { var thread = get(JavaThread.currentThread()); - if(thread.events == null) { + if (thread.events == null) { thread.events = new EventLoop(); try { job(); thread.events.loop(); thread.events = null; - } catch(e) { + } catch (e) { thread.events = null; throw e; } @@ -154,9 +153,10 @@ private class HaxeThread { private class NativeHaxeThread extends java.lang.Thread { public final haxeThread:HaxeThread; + final withEventLoop:Bool; - public function new(haxeThread:HaxeThread, job:()->Void, withEventLoop:Bool) { + public function new(haxeThread:HaxeThread, job:() -> Void, withEventLoop:Bool) { super(new Job(job)); this.haxeThread = haxeThread; this.withEventLoop = withEventLoop; @@ -164,27 +164,13 @@ private class NativeHaxeThread extends java.lang.Thread { override overload public function run() { super.run(); - if(withEventLoop) + if (withEventLoop) haxeThread.events.loop(); } } -#if jvm private abstract Job(Runnable) from Runnable to Runnable { - public inline function new(job:()->Void) { + public inline function new(job:() -> Void) { this = cast job; } } -#else -private class Job implements Runnable { - final job:()->Void; - - public function new(job:()->Void) { - this.job = job; - } - - public function run() { - job(); - } -} -#end \ No newline at end of file diff --git a/std/java/_std/sys/thread/Tls.hx b/std/jvm/_std/sys/thread/Tls.hx similarity index 100% rename from std/java/_std/sys/thread/Tls.hx rename to std/jvm/_std/sys/thread/Tls.hx diff --git a/std/jvm/annotation/EnumReflectionInformation.hx b/std/jvm/annotation/EnumReflectionInformation.hx index 8e830ef567a..b27db4dfec9 100644 --- a/std/jvm/annotation/EnumReflectionInformation.hx +++ b/std/jvm/annotation/EnumReflectionInformation.hx @@ -26,5 +26,5 @@ package jvm.annotation; @:native("haxe.jvm.annotation.EnumReflectionInformation") @:keep interface EnumReflectionInformation extends java.lang.annotation.Annotation { - function constructorNames():java.NativeArray; + function constructorNames():jvm.NativeArray; } diff --git a/std/jvm/annotation/EnumValueReflectionInformation.hx b/std/jvm/annotation/EnumValueReflectionInformation.hx index ba97a4b7992..df7e41f0984 100644 --- a/std/jvm/annotation/EnumValueReflectionInformation.hx +++ b/std/jvm/annotation/EnumValueReflectionInformation.hx @@ -26,5 +26,5 @@ package jvm.annotation; @:native("haxe.jvm.annotation.EnumValueReflectionInformation") @:keep interface EnumValueReflectionInformation extends java.lang.annotation.Annotation { - function argumentNames():java.NativeArray; + function argumentNames():jvm.NativeArray; } diff --git a/std/java/io/NativeInput.hx b/std/jvm/io/NativeInput.hx similarity index 99% rename from std/java/io/NativeInput.hx rename to std/jvm/io/NativeInput.hx index d6f34c3ecfa..5a5f8746045 100644 --- a/std/java/io/NativeInput.hx +++ b/std/jvm/io/NativeInput.hx @@ -20,14 +20,14 @@ * DEALINGS IN THE SOFTWARE. */ -package java.io; +package jvm.io; import haxe.Int64; import haxe.io.Bytes; import haxe.io.Eof; import haxe.io.Input; -import java.io.IOException; import java.io.EOFException; +import java.io.IOException; @:native('haxe.java.io.NativeInput') class NativeInput extends Input { var stream:java.io.InputStream; @@ -53,7 +53,6 @@ import java.io.EOFException; try { ret = stream.read(s.getData(), pos, len); } catch (e:EOFException) { - throw new Eof(); } catch (e:IOException) { throw haxe.io.Error.Custom(e); diff --git a/std/java/io/NativeOutput.hx b/std/jvm/io/NativeOutput.hx similarity index 99% rename from std/java/io/NativeOutput.hx rename to std/jvm/io/NativeOutput.hx index cdf693c8e3f..9057c305c28 100644 --- a/std/java/io/NativeOutput.hx +++ b/std/jvm/io/NativeOutput.hx @@ -20,14 +20,14 @@ * DEALINGS IN THE SOFTWARE. */ -package java.io; +package jvm.io; import haxe.Int64; import haxe.io.Bytes; import haxe.io.Eof; import haxe.io.Output; -import java.io.IOException; import java.io.EOFException; +import java.io.IOException; @:native('haxe.java.io.NativeOutput') class NativeOutput extends Output { var stream:java.io.OutputStream; @@ -40,7 +40,6 @@ import java.io.EOFException; try { stream.write(c); } catch (e:EOFException) { - throw new Eof(); } catch (e:IOException) { throw haxe.io.Error.Custom(e); diff --git a/std/java/net/SslSocket.hx b/std/jvm/net/SslSocket.hx similarity index 98% rename from std/java/net/SslSocket.hx rename to std/jvm/net/SslSocket.hx index f2116afc2e7..255f921c094 100644 --- a/std/java/net/SslSocket.hx +++ b/std/jvm/net/SslSocket.hx @@ -20,7 +20,7 @@ * DEALINGS IN THE SOFTWARE. */ -package java.net; +package jvm.net; @:native('haxe.java.net.SslSocket') class SslSocket extends sys.net.Socket { override private function create():Void { diff --git a/std/lua/_std/String.hx b/std/lua/_std/String.hx index 1442f144a9d..517d1c783ee 100644 --- a/std/lua/_std/String.hx +++ b/std/lua/_std/String.hx @@ -155,7 +155,7 @@ class String { } public inline function charCodeAt(index:Int):Null { - return BaseString.byte(this, index + 1); + return (BaseString.byte(this, index + 1) : Null); } public function substr(pos:Int, ?len:Int):String { diff --git a/std/neko/vm/Module.hx b/std/neko/vm/Module.hx index fc2f9f42076..e338e47d817 100644 --- a/std/neko/vm/Module.hx +++ b/std/neko/vm/Module.hx @@ -103,7 +103,7 @@ class Module { } /** - Each Module has an export table which can be useful to transfert + Each Module has an export table which can be useful to transfer values between modules. **/ public function getExports():Map { @@ -157,7 +157,7 @@ class Module { } /** - Reads a module from a name and using the specified seach path and loader. + Reads a module from a name and using the specified search path and loader. The module is initialized but has not yet been executed. **/ public static function readPath(name:String, path:Array, loader:Loader) { diff --git a/std/php/ErrorException.hx b/std/php/ErrorException.hx index fb4fa798507..9cbf42ef1be 100644 --- a/std/php/ErrorException.hx +++ b/std/php/ErrorException.hx @@ -27,7 +27,7 @@ package php; **/ @:native('ErrorException') extern class ErrorException implements Throwable { - function new(?message:String, ?code:Int, ?severety:Int, ?filename:String, ?lineno:Int, ?previous:Throwable):Void; + function new(?message:String, ?code:Int, ?severity:Int, ?filename:String, ?lineno:Int, ?previous:Throwable):Void; final function getSeverity():Int; final function getPrevious():Throwable; // Returns previous Throwable diff --git a/std/php/Global.hx b/std/php/Global.hx index 005ecb77fa4..ab4b89c2573 100644 --- a/std/php/Global.hx +++ b/std/php/Global.hx @@ -2158,4 +2158,29 @@ extern class Global { @see http://php.net/manual/en/function.php-strip-whitespace.php **/ static function php_strip_whitespace(filename: String): String; + + /** + @see http://php.net/manual/en/function.posix-getgid.php + **/ + static function posix_getgid(): Int; + + /** + @see http://php.net/manual/en/function.posix-getpid.php + **/ + static function posix_getpid(): Int; + + /** + @see http://php.net/manual/en/function.posix-getuid.php + **/ + static function posix_getuid(): Int; + + /** + @see http://php.net/manual/en/function.posix-setgid.php + **/ + static function posix_setgid(group_id: Int): Bool; + + /** + @see http://php.net/manual/en/function.posix-setuid.php + **/ + static function posix_setuid(user_id: Int): Bool; } diff --git a/std/php/Syntax.hx b/std/php/Syntax.hx index de3e6f2238f..2e8516fbdb8 100644 --- a/std/php/Syntax.hx +++ b/std/php/Syntax.hx @@ -293,7 +293,7 @@ extern class Syntax { /** ```haxe - Syntax.assocDecl({field1:'first', field2:2}}); + Syntax.assocDecl({field1:'first', field2:2}); ``` Generates native associative array declaration: ```haxe diff --git a/std/python/lib/Os.hx b/std/python/lib/Os.hx index bf8a9839d64..328d8cb42fb 100644 --- a/std/python/lib/Os.hx +++ b/std/python/lib/Os.hx @@ -92,7 +92,7 @@ extern class Os { static var sep(default, null):String; static var pathsep(default, null):String; - static function makedirs(path:String, mode:Int = 511 /* Oktal 777 */, exist_ok:Bool = false):Void; + static function makedirs(path:String, mode:Int = 511 /* Octal 777 */, exist_ok:Bool = false):Void; - static function mkdir(path:String, mode:Int = 511 /* Oktal 777 */):Void; + static function mkdir(path:String, mode:Int = 511 /* Octal 777 */):Void; } diff --git a/std/python/lib/net/Address.hx b/std/python/lib/net/Address.hx index 09980e39d42..1f1c383505b 100644 --- a/std/python/lib/net/Address.hx +++ b/std/python/lib/net/Address.hx @@ -22,5 +22,5 @@ package python.lib.net; -@:deprecated("Use python.lib.socket.Adress instead") +@:deprecated("Use python.lib.socket.Address instead") typedef Address = python.lib.socket.Address; diff --git a/std/sys/Http.hx b/std/sys/Http.hx index d610b479c58..0037540b39f 100644 --- a/std/sys/Http.hx +++ b/std/sys/Http.hx @@ -103,7 +103,7 @@ class Http extends haxe.http.HttpBase { #if php sock = new php.net.SslSocket(); #elseif java - sock = new java.net.SslSocket(); + sock = new jvm.net.SslSocket(); #elseif python sock = new python.net.SslSocket(); #elseif (!no_ssl && (hxssl || hl || cpp || (neko && !(macro || interp) || eval) || (lua && !lua_vanilla))) diff --git a/std/sys/ssl/Socket.hx b/std/sys/ssl/Socket.hx index c540ac9be4d..89d4170831b 100644 --- a/std/sys/ssl/Socket.hx +++ b/std/sys/ssl/Socket.hx @@ -58,7 +58,7 @@ extern class Socket extends sys.net.Socket { function setCertificate(cert:Certificate, key:Key):Void; /** - Configure additionals certificates and private keys for Server Name Indication extension. + Configure additional certificates and private keys for Server Name Indication extension. The callback may be called during handshake to determine the certificate to use. **/ function addSNICertificate(cbServernameMatch:String->Bool, cert:Certificate, key:Key):Void; diff --git a/std/sys/thread/ElasticThreadPool.hx b/std/sys/thread/ElasticThreadPool.hx index 299c5811d93..2ffec97f0b7 100644 --- a/std/sys/thread/ElasticThreadPool.hx +++ b/std/sys/thread/ElasticThreadPool.hx @@ -103,7 +103,7 @@ class ElasticThreadPool implements IThreadPool { /** Initiates a shutdown. - All previousely submitted tasks will be executed, but no new tasks will + All previously submitted tasks will be executed, but no new tasks will be accepted. Multiple calls to this method have no effect. diff --git a/std/sys/thread/FixedThreadPool.hx b/std/sys/thread/FixedThreadPool.hx index 1f542f23961..a4ce31ed79a 100644 --- a/std/sys/thread/FixedThreadPool.hx +++ b/std/sys/thread/FixedThreadPool.hx @@ -72,7 +72,7 @@ class FixedThreadPool implements IThreadPool { /** Initiates a shutdown. - All previousely submitted tasks will be executed, but no new tasks will + All previously submitted tasks will be executed, but no new tasks will be accepted. Multiple calls to this method have no effect. diff --git a/std/sys/thread/IThreadPool.hx b/std/sys/thread/IThreadPool.hx index 214cb243c8f..52838c4173b 100644 --- a/std/sys/thread/IThreadPool.hx +++ b/std/sys/thread/IThreadPool.hx @@ -42,7 +42,7 @@ interface IThreadPool { /** Initiates a shutdown. - All previousely submitted tasks will be executed, but no new tasks will + All previously submitted tasks will be executed, but no new tasks will be accepted. Multiple calls to this method have no effect. diff --git a/std/sys/thread/Semaphore.hx b/std/sys/thread/Semaphore.hx index 6d0f474d711..0c696c266fb 100644 --- a/std/sys/thread/Semaphore.hx +++ b/std/sys/thread/Semaphore.hx @@ -20,7 +20,7 @@ package sys.thread; Try to lock the semaphore. If the value of the semaphore is zero, `false` is returned, else the value is increased. - If `timeout` is specified, this function will block until the thread is able to acquire the semaphore, or the timout expires. + If `timeout` is specified, this function will block until the thread is able to acquire the semaphore, or the timeout expires. `timeout` is in seconds. **/ public function tryAcquire(?timeout:Float):Bool; diff --git a/tests/display/src/cases/InMacro.hx b/tests/display/src/cases/InMacro.hx index 85dbe0b1076..774bf16c18d 100644 --- a/tests/display/src/cases/InMacro.hx +++ b/tests/display/src/cases/InMacro.hx @@ -4,6 +4,7 @@ class InMacro extends DisplayTestCase { /** import haxe.macro.Context; + import haxe.macro.Expr; class Main { diff --git a/tests/display/src/cases/Issue6399.hx b/tests/display/src/cases/Issue6399.hx index a1652b5d889..f0a449f6e8e 100644 --- a/tests/display/src/cases/Issue6399.hx +++ b/tests/display/src/cases/Issue6399.hx @@ -5,7 +5,7 @@ class Issue6399 extends DisplayTestCase { class Main { public static function main() {} - macro function foo({-1-}name{-2-}:String, {-3-}struct{-4-}:Expr, {-5-}defaults{-6-}:Expr) { + macro function foo({-1-}name{-2-}:String, {-3-}struct{-4-}:haxe.macro.Expr, {-5-}defaults{-6-}:haxe.macro.Expr) { return macro { if ($str{-7-}uct.$n{-8-}ame == null) $str{-9-}uct.$n{-10-}ame = $defa{-11-}ults.$n{-12-}ame; } @@ -20,10 +20,10 @@ class Issue6399 extends DisplayTestCase { for (i in [7, 9]) { eq(range(3, 4), position(pos(i))); - eq("Dynamic", type(pos(i))); + eq("haxe.macro.Expr", type(pos(i))); } eq(range(5, 6), position(pos(11))); - eq("Dynamic", type(pos(11))); + eq("haxe.macro.Expr", type(pos(11))); } } diff --git a/tests/display/src/cases/Issue6417.hx b/tests/display/src/cases/Issue6417.hx index e14cd21b8d8..56f9fda8cd4 100644 --- a/tests/display/src/cases/Issue6417.hx +++ b/tests/display/src/cases/Issue6417.hx @@ -5,13 +5,13 @@ class Issue6417 extends DisplayTestCase { class Main { static function main() {} - macro function foo({-1-}body{-2-}:Expr) { + macro function foo({-1-}body{-2-}:haxe.macro.Expr) { macro function() $bo{-3-}dy; } } **/ function test() { eq(range(1, 2), position(pos(3))); - eq("Dynamic", type(pos(3))); + eq("haxe.macro.Expr", type(pos(3))); } } diff --git a/tests/misc/projects/Issue10623/compile-fail.hxml.stderr b/tests/misc/projects/Issue10623/compile-fail.hxml.stderr index 9d78f61833a..5c7fea41a10 100644 --- a/tests/misc/projects/Issue10623/compile-fail.hxml.stderr +++ b/tests/misc/projects/Issue10623/compile-fail.hxml.stderr @@ -1,2 +1 @@ -Uncaught exception Invalid string -Main.hx:5: characters 3-18 : Called from here \ No newline at end of file +Main.hx:5: characters 3-18 : Uncaught exception Invalid string \ No newline at end of file diff --git a/tests/misc/projects/Issue10623/indent-fail.hxml.stderr b/tests/misc/projects/Issue10623/indent-fail.hxml.stderr index 0e5c4ba4c84..5c7fea41a10 100644 --- a/tests/misc/projects/Issue10623/indent-fail.hxml.stderr +++ b/tests/misc/projects/Issue10623/indent-fail.hxml.stderr @@ -1,2 +1 @@ -Uncaught exception Invalid string - Main.hx:5: characters 3-18 : Called from here +Main.hx:5: characters 3-18 : Uncaught exception Invalid string \ No newline at end of file diff --git a/tests/misc/projects/Issue10623/pretty-fail.hxml.stderr b/tests/misc/projects/Issue10623/pretty-fail.hxml.stderr index f8ec7351f05..9b10f1e5512 100644 --- a/tests/misc/projects/Issue10623/pretty-fail.hxml.stderr +++ b/tests/misc/projects/Issue10623/pretty-fail.hxml.stderr @@ -1,10 +1,5 @@ -[ERROR] (unknown position) - - | Uncaught exception Invalid string - - -> Main.hx:5: characters 3-18 - - 5 | data.toString().substr(0); - | ^^^^^^^^^^^^^^^ - | Called from here +[ERROR] Main.hx:5: characters 3-18 + 5 | data.toString().substr(0); + | ^^^^^^^^^^^^^^^ + | Uncaught exception Invalid string \ No newline at end of file diff --git a/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr index 71888302865..7da58d1f7cb 100644 --- a/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr +++ b/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr @@ -1,3 +1,2 @@ -(unknown) : Uncaught exception Could not read file define.jsno -$$normPath(::std::)/haxe/macro/Compiler.hx:401: characters 11-39 : Called from here +$$normPath(::std::)/haxe/macro/Compiler.hx:401: characters 11-39 : Uncaught exception Could not read file define.jsno (unknown) : Called from here diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr index 9f77e04b2fb..d4f6b78b7ee 100644 --- a/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr +++ b/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr @@ -1,3 +1,2 @@ -(unknown) : Uncaught exception Could not read file meta.jsno -$$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Called from here +$$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Uncaught exception Could not read file meta.jsno (unknown) : Called from here diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr index 5a81672cb2a..0703acfda4a 100644 --- a/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr +++ b/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr @@ -1,3 +1,2 @@ -(unknown) : Uncaught exception Could not read file meta.jsno - $$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Called from here +$$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Uncaught exception Could not read file meta.jsno (unknown) : Called from here diff --git a/tests/misc/projects/Issue11392/compile.hxml.stderr b/tests/misc/projects/Issue11392/compile.hxml.stderr index e323223fb82..6442c665f70 100644 --- a/tests/misc/projects/Issue11392/compile.hxml.stderr +++ b/tests/misc/projects/Issue11392/compile.hxml.stderr @@ -1,2 +1,2 @@ -Main.hx:4: characters 8-9 : Warning : Int (expected: Value) +Main.hx:4: characters 8-9 : Warning : Int (expected: Value(None)) Main.hx:4: characters 22-23 : Warning : Int (expected: WithType(Int, None)) \ No newline at end of file diff --git a/tests/misc/projects/Issue11571/MainMatch.hx b/tests/misc/projects/Issue11571/MainMatch.hx new file mode 100644 index 00000000000..521ea0c0b24 --- /dev/null +++ b/tests/misc/projects/Issue11571/MainMatch.hx @@ -0,0 +1,3 @@ +function main() { + (macro 1).expr?.match(1); +} diff --git a/tests/misc/projects/Issue11571/MainNew.hx b/tests/misc/projects/Issue11571/MainNew.hx new file mode 100644 index 00000000000..cf5a89b2eaf --- /dev/null +++ b/tests/misc/projects/Issue11571/MainNew.hx @@ -0,0 +1,3 @@ +function main() { + String?.new; +} diff --git a/tests/misc/projects/Issue11571/compile-match-fail.hxml b/tests/misc/projects/Issue11571/compile-match-fail.hxml new file mode 100644 index 00000000000..7dddd28503f --- /dev/null +++ b/tests/misc/projects/Issue11571/compile-match-fail.hxml @@ -0,0 +1,2 @@ +--main MainMatch +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11571/compile-match-fail.hxml.stderr b/tests/misc/projects/Issue11571/compile-match-fail.hxml.stderr new file mode 100644 index 00000000000..995e1ef226d --- /dev/null +++ b/tests/misc/projects/Issue11571/compile-match-fail.hxml.stderr @@ -0,0 +1 @@ +MainMatch.hx:2: characters 2-23 : ?.match is not supported \ No newline at end of file diff --git a/tests/misc/projects/Issue11571/compile-new-fail.hxml b/tests/misc/projects/Issue11571/compile-new-fail.hxml new file mode 100644 index 00000000000..7b2c421d7b0 --- /dev/null +++ b/tests/misc/projects/Issue11571/compile-new-fail.hxml @@ -0,0 +1,2 @@ +--main MainNew +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11571/compile-new-fail.hxml.stderr b/tests/misc/projects/Issue11571/compile-new-fail.hxml.stderr new file mode 100644 index 00000000000..58da28c4cfc --- /dev/null +++ b/tests/misc/projects/Issue11571/compile-new-fail.hxml.stderr @@ -0,0 +1 @@ +MainNew.hx:2: characters 2-13 : ?.new is not supported \ No newline at end of file diff --git a/tests/misc/projects/Issue11580/compile-fail.hxml b/tests/misc/projects/Issue11580/compile-fail.hxml new file mode 100644 index 00000000000..7f95b00f9f0 --- /dev/null +++ b/tests/misc/projects/Issue11580/compile-fail.hxml @@ -0,0 +1 @@ +compile-fail.hxml \ No newline at end of file diff --git a/tests/misc/projects/Issue11580/compile-mutual-1-fail.hxml b/tests/misc/projects/Issue11580/compile-mutual-1-fail.hxml new file mode 100644 index 00000000000..453f3bfc841 --- /dev/null +++ b/tests/misc/projects/Issue11580/compile-mutual-1-fail.hxml @@ -0,0 +1 @@ +compile-mutual-2-fail.hxml \ No newline at end of file diff --git a/tests/misc/projects/Issue11580/compile-mutual-2-fail.hxml b/tests/misc/projects/Issue11580/compile-mutual-2-fail.hxml new file mode 100644 index 00000000000..3d36a93283f --- /dev/null +++ b/tests/misc/projects/Issue11580/compile-mutual-2-fail.hxml @@ -0,0 +1 @@ +compile-mutual-1-fail.hxml \ No newline at end of file diff --git a/tests/misc/projects/Issue11688/Foo.hx b/tests/misc/projects/Issue11688/Foo.hx new file mode 100644 index 00000000000..ba0c4ff6366 --- /dev/null +++ b/tests/misc/projects/Issue11688/Foo.hx @@ -0,0 +1,3 @@ +function foo() { + trace("hello foo"); +} \ No newline at end of file diff --git a/tests/misc/projects/Issue11688/Main.hx b/tests/misc/projects/Issue11688/Main.hx new file mode 100644 index 00000000000..fcc85a15cdf --- /dev/null +++ b/tests/misc/projects/Issue11688/Main.hx @@ -0,0 +1,3 @@ +function main() { + Foo.foo(); +} diff --git a/tests/misc/projects/Issue11688/compile-fail.hxml b/tests/misc/projects/Issue11688/compile-fail.hxml new file mode 100644 index 00000000000..e048c63e991 --- /dev/null +++ b/tests/misc/projects/Issue11688/compile-fail.hxml @@ -0,0 +1,3 @@ +--main Main +--macro exclude('Foo') +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11688/compile-fail.hxml.stderr b/tests/misc/projects/Issue11688/compile-fail.hxml.stderr new file mode 100644 index 00000000000..04e451ef6dd --- /dev/null +++ b/tests/misc/projects/Issue11688/compile-fail.hxml.stderr @@ -0,0 +1 @@ +Field index for foo not found on prototype _Foo.Foo_Fields_ \ No newline at end of file diff --git a/tests/misc/projects/Issue11776/Main.hx b/tests/misc/projects/Issue11776/Main.hx new file mode 100644 index 00000000000..ce8957136a3 --- /dev/null +++ b/tests/misc/projects/Issue11776/Main.hx @@ -0,0 +1,10 @@ +class Main { + static function main() { + breakEverything(); + } + + static macro function breakEverything() { + eval.vm.Context.callMacroApi("oh no"); + return macro null; + } +} \ No newline at end of file diff --git a/tests/misc/projects/Issue11776/compile-fail.hxml b/tests/misc/projects/Issue11776/compile-fail.hxml new file mode 100644 index 00000000000..b30a755894b --- /dev/null +++ b/tests/misc/projects/Issue11776/compile-fail.hxml @@ -0,0 +1,2 @@ +--main Main +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11776/compile-fail.hxml.stderr b/tests/misc/projects/Issue11776/compile-fail.hxml.stderr new file mode 100644 index 00000000000..d0be6277cf5 --- /dev/null +++ b/tests/misc/projects/Issue11776/compile-fail.hxml.stderr @@ -0,0 +1,2 @@ +Main.hx:7: characters 3-40 : Uncaught exception Could not find macro function "oh no" +Main.hx:3: characters 3-20 : Called from here \ No newline at end of file diff --git a/tests/misc/projects/Issue11813/Main.hx b/tests/misc/projects/Issue11813/Main.hx new file mode 100644 index 00000000000..51d32cd2baf --- /dev/null +++ b/tests/misc/projects/Issue11813/Main.hx @@ -0,0 +1,21 @@ +enum FlatEnum { + A; + B; +} + +enum ThickEnum { + C; + DD(i:Int); +} + +function main() { + var flat1 = A; + var flat2 = B; + if (flat1 == flat2) {} + if (flat1 != flat2) {} + + var thick1 = C; + var thick2 = DD(1); + if (thick1 == thick2) {} + if (thick1 != thick2) {} +} \ No newline at end of file diff --git a/tests/misc/projects/Issue11813/compile-without.hxml b/tests/misc/projects/Issue11813/compile-without.hxml new file mode 100644 index 00000000000..5f82c470c12 --- /dev/null +++ b/tests/misc/projects/Issue11813/compile-without.hxml @@ -0,0 +1,2 @@ +-m Main +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11813/compile-without.hxml.stderr b/tests/misc/projects/Issue11813/compile-without.hxml.stderr new file mode 100644 index 00000000000..e69de29bb2d diff --git a/tests/misc/projects/Issue11813/compile.hxml b/tests/misc/projects/Issue11813/compile.hxml new file mode 100644 index 00000000000..e7b490e55d8 --- /dev/null +++ b/tests/misc/projects/Issue11813/compile.hxml @@ -0,0 +1,3 @@ +-m Main +-w +WUnsafeEnumEquality +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11813/compile.hxml.stderr b/tests/misc/projects/Issue11813/compile.hxml.stderr new file mode 100644 index 00000000000..cd4cde70667 --- /dev/null +++ b/tests/misc/projects/Issue11813/compile.hxml.stderr @@ -0,0 +1,2 @@ +Main.hx:19: characters 6-22 : Warning : (WUnsafeEnumEquality) Equality operations on this enum might lead to unexpected results because some constructors have arguments +Main.hx:20: characters 6-22 : Warning : (WUnsafeEnumEquality) Equality operations on this enum might lead to unexpected results because some constructors have arguments \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/Main.hx b/tests/misc/projects/Issue11832/Main.hx new file mode 100644 index 00000000000..59c277a7e78 --- /dev/null +++ b/tests/misc/projects/Issue11832/Main.hx @@ -0,0 +1,5 @@ +import a.b.D; + +function main() { + +} diff --git a/tests/misc/projects/Issue11832/a/C.hx b/tests/misc/projects/Issue11832/a/C.hx new file mode 100644 index 00000000000..dc063e03f49 --- /dev/null +++ b/tests/misc/projects/Issue11832/a/C.hx @@ -0,0 +1,3 @@ +package a; + +class E {} diff --git a/tests/misc/projects/Issue11832/a/b/C.hx b/tests/misc/projects/Issue11832/a/b/C.hx new file mode 100644 index 00000000000..0fe80976a40 --- /dev/null +++ b/tests/misc/projects/Issue11832/a/b/C.hx @@ -0,0 +1 @@ +package a.b; \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/a/b/D.hx b/tests/misc/projects/Issue11832/a/b/D.hx new file mode 100644 index 00000000000..cda945393aa --- /dev/null +++ b/tests/misc/projects/Issue11832/a/b/D.hx @@ -0,0 +1,3 @@ +package a.b; + +typedef D = C.E; diff --git a/tests/misc/projects/Issue11832/a/b/E.hx b/tests/misc/projects/Issue11832/a/b/E.hx new file mode 100644 index 00000000000..98f2904886a --- /dev/null +++ b/tests/misc/projects/Issue11832/a/b/E.hx @@ -0,0 +1,5 @@ +package a.b; + +function main() { + C.E; +} \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/a/b/F.hx b/tests/misc/projects/Issue11832/a/b/F.hx new file mode 100644 index 00000000000..5dab64201b5 --- /dev/null +++ b/tests/misc/projects/Issue11832/a/b/F.hx @@ -0,0 +1,5 @@ +package a.b; + +import C.E; + +function main() {} \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile-fail.hxml b/tests/misc/projects/Issue11832/compile-fail.hxml new file mode 100644 index 00000000000..fab0aeecc3d --- /dev/null +++ b/tests/misc/projects/Issue11832/compile-fail.hxml @@ -0,0 +1 @@ +--main Main \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile-fail.hxml.stderr b/tests/misc/projects/Issue11832/compile-fail.hxml.stderr new file mode 100644 index 00000000000..2b906287ff3 --- /dev/null +++ b/tests/misc/projects/Issue11832/compile-fail.hxml.stderr @@ -0,0 +1 @@ +a/b/D.hx:3: characters 13-16 : Module a.b.C does not define type E \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile2-fail.hxml b/tests/misc/projects/Issue11832/compile2-fail.hxml new file mode 100644 index 00000000000..d8725f758d7 --- /dev/null +++ b/tests/misc/projects/Issue11832/compile2-fail.hxml @@ -0,0 +1 @@ +--main a.b.E \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile2-fail.hxml.stderr b/tests/misc/projects/Issue11832/compile2-fail.hxml.stderr new file mode 100644 index 00000000000..e68a2914f93 --- /dev/null +++ b/tests/misc/projects/Issue11832/compile2-fail.hxml.stderr @@ -0,0 +1 @@ +a/b/E.hx:4: characters 2-3 : Module a.b.C does not define type C \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile3-fail.hxml b/tests/misc/projects/Issue11832/compile3-fail.hxml new file mode 100644 index 00000000000..88e934164e9 --- /dev/null +++ b/tests/misc/projects/Issue11832/compile3-fail.hxml @@ -0,0 +1 @@ +--main a.b.F \ No newline at end of file diff --git a/tests/misc/projects/Issue11832/compile3-fail.hxml.stderr b/tests/misc/projects/Issue11832/compile3-fail.hxml.stderr new file mode 100644 index 00000000000..9e9f32d010a --- /dev/null +++ b/tests/misc/projects/Issue11832/compile3-fail.hxml.stderr @@ -0,0 +1 @@ +a/b/F.hx:3: characters 8-9 : Type not found : C \ No newline at end of file diff --git a/tests/misc/projects/Issue4781/compile-fail.hxml b/tests/misc/projects/Issue4781/compile-fail.hxml new file mode 100644 index 00000000000..7968b6fc2e8 --- /dev/null +++ b/tests/misc/projects/Issue4781/compile-fail.hxml @@ -0,0 +1,2 @@ +--main p.A +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue4781/compile-fail.hxml.stderr b/tests/misc/projects/Issue4781/compile-fail.hxml.stderr new file mode 100644 index 00000000000..a3ba0747256 --- /dev/null +++ b/tests/misc/projects/Issue4781/compile-fail.hxml.stderr @@ -0,0 +1 @@ +p/A.hx:2: characters 17-20 : Module p.B does not define type T \ No newline at end of file diff --git a/tests/misc/projects/Issue4781/p/A.hx b/tests/misc/projects/Issue4781/p/A.hx new file mode 100644 index 00000000000..aabb7813488 --- /dev/null +++ b/tests/misc/projects/Issue4781/p/A.hx @@ -0,0 +1,3 @@ +package p; +class A extends B.T { +} \ No newline at end of file diff --git a/tests/misc/projects/Issue4781/p/B.hx b/tests/misc/projects/Issue4781/p/B.hx new file mode 100644 index 00000000000..5abc650804f --- /dev/null +++ b/tests/misc/projects/Issue4781/p/B.hx @@ -0,0 +1,3 @@ +package p; +class B { +} \ No newline at end of file diff --git a/tests/misc/projects/Issue8303/compile-fail.hxml.stderr b/tests/misc/projects/Issue8303/compile-fail.hxml.stderr index 00dd0661cfb..bbf2aa04132 100644 --- a/tests/misc/projects/Issue8303/compile-fail.hxml.stderr +++ b/tests/misc/projects/Issue8303/compile-fail.hxml.stderr @@ -1,5 +1,4 @@ -Uncaught exception Stack overflow -Main.hx:1: character 1 : Called from here +Main.hx:1: character 1 : Uncaught exception Stack overflow Main.hx:8: characters 4-9 : Called from here Main.hx:8: characters 4-9 : Called from here Main.hx:8: characters 4-9 : Called from here diff --git a/tests/misc/projects/Issue8303/indent-fail.hxml.stderr b/tests/misc/projects/Issue8303/indent-fail.hxml.stderr index 85bcacbd35d..e90cbbf56ec 100644 --- a/tests/misc/projects/Issue8303/indent-fail.hxml.stderr +++ b/tests/misc/projects/Issue8303/indent-fail.hxml.stderr @@ -1,5 +1,4 @@ -Uncaught exception Stack overflow - Main.hx:1: character 1 : Called from here +Main.hx:1: character 1 : Uncaught exception Stack overflow Main.hx:8: characters 4-9 : Called from here Main.hx:8: characters 4-9 : Called from here Main.hx:8: characters 4-9 : Called from here diff --git a/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr b/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr index 2cd268477fb..54ca16e1343 100644 --- a/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr +++ b/tests/misc/projects/Issue8303/pretty-fail.hxml.stderr @@ -1,11 +1,7 @@ -[ERROR] (unknown position) +[ERROR] Main.hx | Uncaught exception Stack overflow - -> Main.hx - - | Called from here - 8 | log(); | ^^^^^ | Called from here diff --git a/tests/optimization/src/issues/Issue11464.hx b/tests/optimization/src/issues/Issue11464.hx new file mode 100644 index 00000000000..d8a84c8b09a --- /dev/null +++ b/tests/optimization/src/issues/Issue11464.hx @@ -0,0 +1,19 @@ +package issues; + +class Issue11464 { + @:js(' + var name = issues_Issue11464.call(); + issues_Issue11464.use(name != null ? name : "default"); + ') + static function test() { + final name = call() ?? "default"; + use(name); + } + + static function call() { + return ""; + } + + @:pure(false) + static function use(v:String) {} +} \ No newline at end of file diff --git a/tests/optimization/src/issues/Issue11800.hx b/tests/optimization/src/issues/Issue11800.hx new file mode 100644 index 00000000000..c17177da5af --- /dev/null +++ b/tests/optimization/src/issues/Issue11800.hx @@ -0,0 +1,25 @@ +package issues; + +class Issue11800 { + @:js(' + ++issues_Issue11800.test_a; + ++issues_Issue11800.test_b; + ++issues_Issue11800.test_a; + ++issues_Issue11800.test_b; + ') + static function test() { + static var a = 0; + + for (i in 0...3) { + switch i { + case n if (n < 2): + use(++a); + static var b = 0; + use(++b); + case _: + } + } + } + + static function use(v:Int) {} +} \ No newline at end of file diff --git a/tests/runci/System.hx b/tests/runci/System.hx index 0db5c6b95fe..01a405ae91e 100644 --- a/tests/runci/System.hx +++ b/tests/runci/System.hx @@ -134,11 +134,13 @@ class System { } static public function addToLIBPATH(path:String):Void { - infoMsg('Prepending $path to LD_LIBRARY_PATH.'); + infoMsg('Prepending $path to loader path.'); switch (systemName) { case "Windows": // pass - case "Mac", "Linux": + case "Linux": Sys.putEnv("LD_LIBRARY_PATH", path + ":" + Sys.getEnv("LD_LIBRARY_PATH")); + case "Mac": + Sys.putEnv("DYLD_LIBRARY_PATH", path + ":" + Sys.getEnv("DYLD_LIBRARY_PATH")); } } diff --git a/tests/runci/targets/Hl.hx b/tests/runci/targets/Hl.hx index 07ff7999687..75f7238c3ad 100644 --- a/tests/runci/targets/Hl.hx +++ b/tests/runci/targets/Hl.hx @@ -10,13 +10,15 @@ using StringTools; class Hl { static final hlSrc = Path.join([getDownloadPath(), "hashlink"]); - static final hlBuild = Path.join([getInstallPath(), "hashlink_build"]); + static final hlBuild = Path.join([getDownloadPath(), "hashlink_build"]); - static final hlBuildBinDir = Path.join([getInstallPath(), "hashlink_build", "bin"]); + static final hlInstallDir = Path.join([getInstallPath(), "hashlink"]); + static final hlInstallBinDir = if (systemName == "Windows") hlInstallDir else Path.join([hlInstallDir, "bin"]); + static final hlInstallLibDir = if (systemName == "Windows") hlInstallDir else Path.join([hlInstallDir, "lib"]); static final hlBinary = if (isCi() || !commandSucceed("hl", ["--version"])){ - Path.join([hlBuildBinDir, "hl"]) + ((systemName == "Windows") ? ".exe" : ""); + Path.join([hlInstallBinDir, "hl"]) + ((systemName == "Windows") ? ".exe" : ""); } else { commandResult(if(systemName == "Windows") "where" else "which", ["hl"]).stdout.trim(); }; @@ -56,16 +58,18 @@ class Hl { "-DWITH_UI=OFF", "-DWITH_UV=OFF", "-DWITH_VIDEO=OFF", + "-DCMAKE_INSTALL_PREFIX=" + hlInstallDir, "-B" + hlBuild, "-H" + hlSrc ])); runCommand("cmake", [ "--build", hlBuild ]); + runCommand("cmake", ["--build", hlBuild, "--target", "install"]); + addToPATH(hlInstallBinDir); + addToLIBPATH(hlInstallLibDir); runCommand(hlBinary, ["--version"]); - addToPATH(hlBuildBinDir); - addToLIBPATH(hlBuildBinDir); haxelibDev("hashlink", '$hlSrc/other/haxelib/'); } @@ -73,24 +77,26 @@ class Hl { static function buildAndRunHlc(dir:String, filename:String, ?run) { if (run == null) run = runCommand; - switch (systemName) { - case "Linux" if (isCi()): - runCommand("gcc", [ - "-o", '$dir/$filename.exe', - '$dir/$filename.c', - '-I$dir', - '-I$hlSrc/src', - '$hlBuildBinDir/fmt.hdll', - '$hlBuildBinDir/ssl.hdll', - '$hlBuildBinDir/sqlite.hdll', - "-lm", - '-L$hlBuildBinDir', "-lhl" - ]); - - run('$dir/$filename.exe', []); - - case _: // TODO hl/c for mac/windows - } + if (!isCi()) + return; + + final compiler = if (systemName == "Mac") "clang" else "gcc"; + final extraCompilerFlags = if (systemName == "Windows") ["-ldbghelp", "-municode"] else []; + + runCommand(compiler, [ + "-o", '$dir/$filename.exe', + '$dir/$filename.c', + '-I$dir', + '-I$hlInstallDir/include', + '-L$hlInstallLibDir', + '$hlInstallLibDir/fmt.hdll', + '$hlInstallLibDir/ssl.hdll', + '$hlInstallLibDir/sqlite.hdll', + "-lm", + "-lhl" + ].concat(extraCompilerFlags)); + + run('$dir/$filename.exe', []); } static function buildAndRun(hxml:String, target:String, ?args:Array) { diff --git a/tests/server/src/cases/display/issues/Issue11817.hx b/tests/server/src/cases/display/issues/Issue11817.hx new file mode 100644 index 00000000000..584ff74ec2e --- /dev/null +++ b/tests/server/src/cases/display/issues/Issue11817.hx @@ -0,0 +1,24 @@ +package cases.display.issues; + +class Issue11817 extends DisplayTestCase { + function test(_) { + vfs.putContent("Main.hx", getTemplate("issues/Issue11817/MainBefore.hx")); + vfs.putContent("Utils.hx", getTemplate("issues/Issue11817/Utils.hx")); + runHaxe(["--main", "Main"]); + var mainHx = Marker.extractMarkers(getTemplate("issues/Issue11817/MainAfter.hx")); + vfs.putContent("Main.hx", mainHx.source); + runHaxeJson([], ServerMethods.Invalidate, {file: file}); + runHaxeJson([], DisplayMethods.Completion, { + file: file, + offset: mainHx.markers[1], + wasAutoTriggered: true + }); + var result = parseCompletion().result; + Assert.equals(1, result.items.length); + Assert.equals('foo', result.items[0].args.field.name); + + vfs.putContent("Main.hx", getTemplate("issues/Issue11817/MainError.hx")); + runHaxe(["--main", "Main"]); + assertErrorMessage("This field cannot be accessed explicitly"); + } +} diff --git a/tests/server/test/templates/issues/Issue11817/MainAfter.hx b/tests/server/test/templates/issues/Issue11817/MainAfter.hx new file mode 100644 index 00000000000..13a7507b2b2 --- /dev/null +++ b/tests/server/test/templates/issues/Issue11817/MainAfter.hx @@ -0,0 +1,6 @@ +class Main { + static function main() { + Utils.foo; + Utils.{-1-} + } +} diff --git a/tests/server/test/templates/issues/Issue11817/MainBefore.hx b/tests/server/test/templates/issues/Issue11817/MainBefore.hx new file mode 100644 index 00000000000..9d0bc77028a --- /dev/null +++ b/tests/server/test/templates/issues/Issue11817/MainBefore.hx @@ -0,0 +1,5 @@ +class Main { + static function main() { + Utils.foo; + } +} diff --git a/tests/server/test/templates/issues/Issue11817/MainError.hx b/tests/server/test/templates/issues/Issue11817/MainError.hx new file mode 100644 index 00000000000..5f1d9735fbb --- /dev/null +++ b/tests/server/test/templates/issues/Issue11817/MainError.hx @@ -0,0 +1,6 @@ +class Main { + static function main() { + Utils.foo; + Utils.foo_leak; + } +} diff --git a/tests/server/test/templates/issues/Issue11817/Utils.hx b/tests/server/test/templates/issues/Issue11817/Utils.hx new file mode 100644 index 00000000000..b304d2442b4 --- /dev/null +++ b/tests/server/test/templates/issues/Issue11817/Utils.hx @@ -0,0 +1,6 @@ +class Utils { + public static function foo():Int { + static var leak = 0; + return leak; + } +} diff --git a/tests/unit/src/unit/TestJava.hx b/tests/unit/src/unit/TestJava.hx index ba03ec5238a..f20a83f3940 100644 --- a/tests/unit/src/unit/TestJava.hx +++ b/tests/unit/src/unit/TestJava.hx @@ -13,6 +13,8 @@ import haxe.test.TEnum; import java.util.EnumSet; import java.vm.*; +using jvm.NativeTools; + #if jvm @:strict(haxe.test.MyClass.MyClass_MyAnnotation({author: "John Doe", someEnum: TB})) @:strict(MyClass_ParameterLessAnnotation) @@ -84,15 +86,15 @@ class TestJava extends Test { @:strict(MyClass_MyAnnotation({author: "author", currentRevision: 2})) public function testAnnotations() { - var cl = java.Lib.toNativeType(TestJava); - var a = cl.getAnnotation(java.Lib.toNativeType(MyClass_MyAnnotation)); + var cl = TestJava.native(); + var a = cl.getAnnotation(MyClass_MyAnnotation.native()); t(a != null); eq(a.author(), "John Doe"); eq(a.someEnum(), TB); eq(a.currentRevision(), 1); - t(cl.getAnnotation(java.Lib.toNativeType(MyClass_ParameterLessAnnotation)) != null); + t(cl.getAnnotation(MyClass_ParameterLessAnnotation.native()) != null); var m = cl.getMethod("testAnnotations"); - a = m.getAnnotation(java.Lib.toNativeType(MyClass_MyAnnotation)); + a = m.getAnnotation(MyClass_MyAnnotation.native()); t(a != null); eq(a.author(), "author"); eq(a.someEnum(), TC); @@ -110,7 +112,7 @@ class TestJava extends Test { } function testEnumSet() { - var es1:EnumSet = EnumSet.noneOf(java.Lib.toNativeEnum(TEnum)); + var es1:EnumSet = EnumSet.noneOf(TEnum.native()); f(es1.contains(TA)); es1.add(TA); t(es1.contains(TA)); diff --git a/tests/unit/src/unit/TestNumericCasts.hx b/tests/unit/src/unit/TestNumericCasts.hx index d5b7134e846..2c391dad24e 100644 --- a/tests/unit/src/unit/TestNumericCasts.hx +++ b/tests/unit/src/unit/TestNumericCasts.hx @@ -1,8 +1,10 @@ // This file is auto-generated from RunCastGenerator.hx - do not edit! package unit; #if jvm -import java.StdTypes; +import jvm.Int16; +import jvm.Int8; private typedef Int32 = Int; +private typedef Int64 = haxe.Int64; private typedef Float32 = Single; private typedef Float64 = Float; #else diff --git a/tests/unit/src/unit/UnitBuilder.hx b/tests/unit/src/unit/UnitBuilder.hx index 43c6e396c75..8a7ac737819 100644 --- a/tests/unit/src/unit/UnitBuilder.hx +++ b/tests/unit/src/unit/UnitBuilder.hx @@ -174,7 +174,7 @@ class UnitBuilder { case EBinop(OpEq, e1, e2): mkEq(e1, e2, e.pos); case EBinop(OpNotEq, e1, e2): - macro t($e1 != $e2); + macro @:pos(e.pos) t($e1 != $e2); case EBinop(OpGt | OpGte | OpLt | OpLte, _, _): { expr: (macro t($e)).expr, diff --git a/tests/unit/src/unit/issues/Issue10397.hx b/tests/unit/src/unit/issues/Issue10397.hx index 640c0864ab7..d220b57d60f 100644 --- a/tests/unit/src/unit/issues/Issue10397.hx +++ b/tests/unit/src/unit/issues/Issue10397.hx @@ -8,7 +8,7 @@ private class NotMain { static public function gather() { final main = new NotMain(); - final cls = java.Lib.getNativeType(main); + final cls = jvm.Jvm.getNativeType(main); final classAnnotations = []; final methods = new Map(); diff --git a/tests/unit/src/unit/issues/Issue11571.hx b/tests/unit/src/unit/issues/Issue11571.hx new file mode 100644 index 00000000000..f9cb44eaa80 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11571.hx @@ -0,0 +1,15 @@ +package unit.issues; + +class Issue11571 extends unit.Test { + public function test() { + var fOk = () -> "ok"; + var f:Null<() -> String> = fOk; + var boundOk = f?.bind(); + f = null; + eq("ok", boundOk()); + + var boundNull = f?.bind(); + f = fOk; + eq(null, boundNull()); + } +} diff --git a/tests/unit/src/unit/issues/Issue11734.hx b/tests/unit/src/unit/issues/Issue11734.hx index 467253c8a90..13911d07ad7 100644 --- a/tests/unit/src/unit/issues/Issue11734.hx +++ b/tests/unit/src/unit/issues/Issue11734.hx @@ -5,6 +5,22 @@ import unit.Test; import hl.NativeArray; #end +private class Group { + public var grid : haxe.ds.Vector>; + public function new(size:Int) { + grid = new haxe.ds.Vector(size); + for (i in 0...size) + grid[i] = []; + } +} + +private class Foo { + public var x : Int; + public function new(x:Int) { + this.x = x; + } +} + class Issue11734 extends Test { #if hl function test() { @@ -16,4 +32,18 @@ class Issue11734 extends Test { feq(1.0, a[0]); } #end + + function testArrayInVector() { + var g = new Group(5); + for (i in 0...5) + g.grid[i].push(new Foo(10+i)); + eq(10, g.grid[0][0].x); + eq(14, g.grid[4][0].x); + + var g = new Group(5); + for (i in 0...5) + g.grid[i].push(10.0+i); + feq(10.0, g.grid[0][0]); + feq(14.0, g.grid[4][0]); + } } diff --git a/tests/unit/src/unit/issues/Issue11738.hx b/tests/unit/src/unit/issues/Issue11738.hx new file mode 100644 index 00000000000..46414ab6e7f --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11738.hx @@ -0,0 +1,21 @@ +package unit.issues; + +import unit.Test; + +class Issue11738 extends Test { + var value:String; + + function test() { + switch ("abc") { + case _.charCodeAt(0) => 'a'.code: + doSomething("1"); + case _.charCodeAt(1) => 'e'.code: + doSomething("2"); + } + eq("1", value); + } + + function doSomething(s:String) { + value = s; + } +} diff --git a/tests/unit/src/unit/issues/Issue11800.hx b/tests/unit/src/unit/issues/Issue11800.hx new file mode 100644 index 00000000000..18676811e45 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11800.hx @@ -0,0 +1,21 @@ +package unit.issues; + +class Issue11800 extends unit.Test { + public function test() { + static var a = 0; // Works. + var buf = new StringBuf(); + function append(v:Int) { + buf.add(Std.string(v)); + } + for (i in 0...3) { + switch i { + case n if (n < 2): + append(++a); + static var b = 0; // Not static. + append(++b); // Always `1`. + case _: + } + } + eq("1122", buf.toString()); + } +} diff --git a/tests/unit/src/unit/issues/Issue2049.hx b/tests/unit/src/unit/issues/Issue2049.hx index e9dfdedb4ad..5d39c9a3ddc 100644 --- a/tests/unit/src/unit/issues/Issue2049.hx +++ b/tests/unit/src/unit/issues/Issue2049.hx @@ -1,7 +1,6 @@ package unit.issues; #if jvm -import java.NativeArray; -import java.Lib; +import jvm.NativeArray; #end class Issue2049 extends unit.Test @@ -10,7 +9,7 @@ class Issue2049 extends unit.Test public function test() { var arr = [ 1., 1., 1., 0.5 ].map( function( n: Float ): Single { return n; }); - var scaleFactors:NativeArray = Lib.nativeArray( arr, true ); + var scaleFactors = haxe.ds.Vector.fromArrayCopy( arr); eq(1.,scaleFactors[0]); eq(1.,scaleFactors[1]); eq(1.,scaleFactors[2]); diff --git a/tests/unit/src/unit/issues/Issue2772.hx b/tests/unit/src/unit/issues/Issue2772.hx index d81e0e29e3c..af3f452860e 100644 --- a/tests/unit/src/unit/issues/Issue2772.hx +++ b/tests/unit/src/unit/issues/Issue2772.hx @@ -6,9 +6,9 @@ class Issue2772 extends Test public function test() { var f = false; - java.Lib.lock(Issue2772, f = true); + jvm.Jvm.lock(Issue2772, f = true); t(f); - java.Lib.lock(this, f = false); + jvm.Jvm.lock(this, f = false); this.f(f); } #end diff --git a/tests/unit/src/unit/issues/Issue2927.hx b/tests/unit/src/unit/issues/Issue2927.hx index 17c786e3f97..1f653fc9521 100644 --- a/tests/unit/src/unit/issues/Issue2927.hx +++ b/tests/unit/src/unit/issues/Issue2927.hx @@ -1,24 +1,22 @@ package unit.issues; + #if jvm -import java.Lib; -import java.NativeArray; +import jvm.NativeArray; #end class Issue2927 extends Test { -#if jvm - public function test() - { - var arr = Lib.array(new NativeArray(1)); - eq(arr.length,1); - var arr = Lib.array(new NativeArray(1)); - eq(arr.length,1); - var arr = Lib.array(new NativeArray(1)); - eq(arr.length,1); - var arr = Lib.array(new NativeArray(1)); - eq(arr.length,1); - var arr = Lib.array(new NativeArray(1)); - eq(arr.length,1); + #if jvm + public function test() { + var arr = new NativeArray(1).toArray(); + eq(arr.length, 1); + var arr = new NativeArray(1).toArray(); + eq(arr.length, 1); + var arr = new NativeArray(1).toArray(); + eq(arr.length, 1); + var arr = new NativeArray(1).toArray(); + eq(arr.length, 1); + var arr = new NativeArray(1).toArray(); + eq(arr.length, 1); } -#end + #end } - diff --git a/tests/unit/src/unit/issues/Issue9220.hx b/tests/unit/src/unit/issues/Issue9220.hx index c67c47f6a07..e8056dedd42 100644 --- a/tests/unit/src/unit/issues/Issue9220.hx +++ b/tests/unit/src/unit/issues/Issue9220.hx @@ -5,7 +5,7 @@ import unit.Test; class Issue9220 extends Test { #if jvm public function test() { - eq("12.200", java.NativeString.format(java.util.Locale.US, '%.3f', 12.2)); + eq("12.200", jvm.NativeString.format(java.util.Locale.US, '%.3f', 12.2)); } #end }